Access a dynamically generated input in r shiny

Question

I have an app where the user needs to assign randomly generated elements (in this case, letters) to groups, but gets to decide how many groups to use. Because the selectInput where memberships are defined is generated dynamically in response to a number specified by the user, naming the menu is done automatically (e.g., usergroup1, usergroup2, etc.). I am having trouble accessing the input values and returning them from the module to use later because I won't know in advance how many inputs there will be, and hence how many usergroups to call. Here is an example app:

UI module:

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"))
  )
}

What I tried to do here is make a list of usergroup names and return those, but the values aren't attached, and nothing comes through.

Server module:

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:

ui <- navbarPage("Fancy Title",id = "tabs",
         tabPanel("Panel1",
             sidebarPanel(
                  mod1UI("input1")
             ),
             mainPanel(verbatimTextOutput("lettersy")
             )
         )
      )

Server:

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)

Any help is greatly appreciated!

Its a little hard for me to follow, if you could provide a totatlly reproducible example I could try to help further. But yes I did get a solution to my old problem. See the question and answer here. Joe's answer might be what you need... groups.google.com/forum/#!searchin/shiny-discuss/… — Trevor Nederlof
@TrevorNederlof Joe's answer was helpful for thinking about what to put inside reactive(), but I didn't want to call the whole module over and over - in the end I kept digging around on SO with different search terms and eventually found a couple solutions to similar problems, which eventually worked. Answer should provide a fully working example. — phalteman

phalteman phalteman · Accepted Answer · 2018-08-01T17:21:04

This solution mimics a couple others found on SO, namely this one.

The key is to create a reactiveValues object and then assign the values using [[i]]. In my case it helped to use a submit button to trigger that.

Complete, working code is as follows:

UI module:

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")
  )
}

Server Module:

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:

ui <- navbarPage("Fancy Title",id = "tabs",
          tabPanel("Panel1",
              sidebarPanel(
                  mod1UI("input1")
              ),
              mainPanel(verbatimTextOutput("lettersy")
              )
          )
)

Server:

server <- function(input, output, session) {
  y <- callModule(mod1, "input1", data=y$dat)
  output$lettersy <- renderText({
    as.character(c(y$groups()))
  })
}

shinyApp(ui, server)

Access a dynamically generated input in r shiny

1 Answers