[英]R Shiny - Flush dynamically generated input functions using selectInput
[英]Access a dynamically generated input in r shiny
我有一個應用程序,用戶需要將隨機生成的元素(在這種情況下為字母)分配給組,但可以決定要使用多少個組。 因為定義成員資格的selectInput
是響應於用戶指定的數字而動態生成的,所以菜單的命名是自動完成的(例如, usergroup1
, usergroup2
等)。 我無法訪問輸入值並將其從模塊中返回以供以后使用,因為我事先不知道會有多少輸入,因此不知道要調用多少個usergroups
。 這是一個示例應用程序:
UI模塊:
library(shiny)
library(stringr)
mod1UI <- function(id) {
ns <- NS(id)
tagList(
numericInput(ns("n"), "N",value = NULL),
actionButton(ns("draw"),"Generate Letters"),
hr(),
numericInput(ns("groups"), "Enter number of groups (1-3)", value=NULL),
uiOutput(ns("groupings"))
)
}
我在這里嘗試做的是列出usergroup
名稱並返回它們,但是沒有附加值,並且沒有任何結果。
服務器模塊:
mod1 <- function(input, output, session, data) {
ns <- session$ns
x <- reactiveValues(data=NULL)
observeEvent(input$draw, {
req(input$n)
x$data <- sample(letters,input$n)
})
output$groupings <- renderUI({
req(input$groups)
ltrs <- data()
lapply(1:input$groups, function(i) {
selectizeInput(paste0(session$ns("usergroup"),i),
paste0("Select letters for Group ", i),
choices=ltrs,
options = list(placeholder = "Select letters for this group",
onInitialize = I('function() { this.setValue(""); }')), multiple=T)
})
})
gps <- reactiveValues(gps=NULL)
reactive({
gps$gps <- lapply(1:input$groups, function(i) { paste0(session$ns("usergroup"),i) })
})
return(list(dat = reactive({x$data}),
groups = reactive({gps$gps})
))
}
用戶界面:
ui <- navbarPage("Fancy Title",id = "tabs",
tabPanel("Panel1",
sidebarPanel(
mod1UI("input1")
),
mainPanel(verbatimTextOutput("lettersy")
)
)
)
服務器:
server <- function(input, output, session) {
y <- callModule(mod1, "input1", data=y$dat)
output$lettersy <- renderText({
as.character(c(y$dat(), y$groups(), "end"))
})
}
shinyApp(ui, server)
任何幫助是極大的贊賞!
此解決方案模仿在SO上找到的其他幾個,即這個 。
關鍵是創建一個reactiveValues
對象,然后使用[[i]]
分配值。 就我而言,它有助於使用提交按鈕來觸發它。
完整的工作代碼如下:
UI模塊:
library(shiny)
mod1UI <- function(id) {
ns <- NS(id)
tagList(
numericInput(ns("n"), "N",value = NULL),
actionButton(ns("draw"),"Generate Letters"),
hr(),
numericInput(ns("groups"), "Enter number of groups (1-3)", value=NULL),
uiOutput(ns("groupings")),
actionButton(ns("submit"), "Submit Groupings")
)
}
服務器模塊:
mod1 <- function(input, output, session, data) {
ns <- session$ns
x <- reactiveValues(data=NULL)
observeEvent(input$draw, {
req(input$n)
x$data <- sample(letters,input$n)
})
output$groupings <- renderUI({
req(input$groups)
ltrs <- data()
lapply(1:input$groups, function(i) {
selectizeInput(paste0(session$ns("usergroup"),i),
paste0("Select letters for Group ", i),
choices = ltrs,
options = list(placeholder = "Select letters for this group",
onInitialize = I('function() { this.setValue(""); }')), multiple=T)
})
})
gps <- reactiveValues(x=NULL)
observeEvent(input$submit, {
lapply(1:input$groups, function(i) {
gps$x[[i]] <- input[[paste0("usergroup", i)]]
})
})
test <- session$ns("test")
return(list(dat = reactive({x$data}),
groups = reactive({gps$x})
))
}
用戶界面:
ui <- navbarPage("Fancy Title",id = "tabs",
tabPanel("Panel1",
sidebarPanel(
mod1UI("input1")
),
mainPanel(verbatimTextOutput("lettersy")
)
)
)
服務器:
server <- function(input, output, session) {
y <- callModule(mod1, "input1", data=y$dat)
output$lettersy <- renderText({
as.character(c(y$groups()))
})
}
shinyApp(ui, server)
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.