在R Shiny中访问动态生成的输入

时间:2018-07-26 04:27:56

标签: r shiny

我有一个应用程序,用户需要将随机生成的元素(在这种情况下为字母)分配给组,但可以决定要使用多少个组。由于定义成员资格的selectInput是根据用户指定的数字动态生成的,因此菜单的命名是自动完成的(例如usergroup1usergroup2等)。我在访问输入值并从模块返回它们以供以后使用时遇到了麻烦,因为我事先不知道会有多少个输入,因此不知道要调用多少个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)

非常感谢您的帮助!

1 个答案:

答案 0 :(得分:0)

此解决方案模仿了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)