CODEWITHSUNDEEP
rshiny
phalteman
phalteman

Reputation: 3542

Access a dynamically generated input in r shiny

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!

Upvotes: 2

Views: 1962

Answers (1)

phalteman
phalteman

Reputation: 3542

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)

Upvotes: 3

Related Questions