在 r shiny 中访问动态生成的输入答案

【问题标题】：Access a dynamically generated input in r shiny在 r shiny 中访问动态生成的输入
【发布时间】：2018-08-02 01:21:04
【问题描述】：

我有一个应用程序，用户需要将随机生成的元素（在本例中为字母）分配给组，但要决定使用多少组。因为定义成员资格的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)

非常感谢任何帮助！

【问题讨论】：

这对我来说有点难以理解，如果你能提供一个完全可重现的例子，我可以尝试进一步提供帮助。但是，是的，我确实找到了解决我的老问题的方法。请参阅此处的问题和答案。乔的答案可能就是你所需要的……groups.google.com/forum/#!searchin/shiny-discuss/…
@TrevorNederlof Joe 的回答有助于思考在反应（）中放入什么，但我不想一遍又一遍地调用整个模块 - 最后我一直在挖掘 SO不同的搜索词，最终找到了一些解决类似问题的方法，最终奏效了。答案应该提供一个完整的工作示例。

标签： r shiny

【解决方案1】：

此解决方案模仿了 SO 上的其他几个解决方案，即 this one。

关键是创建一个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)

【讨论】：