Dynamically created selectInputs not recognized in server

Question

I created a simple project where I generate select inputs from a list in one module (selector) which returns the list of inputs. I have another module (viewer) which takes the inputs returned from selector module and generates a number of textOuputs corresponding to the Count selectInput value and their texts corresponds to the Colors selectInput value. The problem is that the generated inputs are not recognized, hence, not picked by the input list to be returned. The only way I could get them recognized is if I hard-code the selectInputs which I don't want to do (I've added them in selectorUI as comments for a reference).

ui.R

library(shiny)
HOME_DIR<-getwd()
source(file.path(HOME_DIR,'subUI.R'),local=TRUE)
shinyUI(fluidPage(
    titlePanel("Sample App"),
    sidebarLayout(
       sidebarPanel(
        selectorUI("selectorModl")
    ),
    mainPanel(
        viewerUI("viewerModl")
    )
)))

server.R

library(shiny)
HOME_DIR<-getwd()
source(file.path(HOME_DIR,'subUI.R'),local=TRUE)
shinyServer(function(input, output) {
    selection <- list("count" = c(1,2,3,4,5), "colors" = c("blue", "green","red"))
    inputValues<-reactive(callModule(selector,"selectorModl", selection))
    observeEvent(inputValues(),{
        if(length(inputValues()))
            callModule(viewer, "viewerModl", inputValues())
    })
})

subUI.R

#----------selector subUI
selectorUI<-function(id){
    ns <- NS(id)
    tagList(
        htmlOutput(ns("selectorPane"))
        # selectInput(ns("count"), label = "count", choices = "", multiple = F)
        # ,selectInput(ns("colors"), label = "colors",choices = "", multiple = F)

    )
}

selector<-function(input, output, session,selection){
    output$selectorPane <- renderUI({
        lapply(1:length(selection), function(selIdx){
            selName <- names(selection)[selIdx]
            selChoices<-selection[[selName]]
            selectInput(inputId = selName, label = selName, choices = selChoices, multiple = F)
        })
    })
    observe({
        print(names(input))
        if(!is.null(input[["count"]])){
            if(input[["count"]]==""){
                lapply(1:length(selection), function(selIdx){
                    selName <- names(selection)[selIdx]
                    selChoices<-selection[[selName]]
                    updateSelectInput(session, inputId = selName, choices = selChoices)
                })
            }    
        }
    })
    return(input)
}

#----------viewer subUI
viewerUI<-function(id){
    ns <- NS(id)
    uiOutput(ns("viewerPane"))
}

viewer<-function(input, output, session, inputValues){
    output$viewerPane <- renderUI({
        if(length(inputValues) > 0)
            if(!is.null(inputValues[["count"]]) && inputValues[["count"]] != "" && !is.null(inputValues[["colors"]]))
            lapply(1:inputValues[["count"]], function(idx){
                textInput(paste("text",idx, sep = "_"), label = "", value = inputValues[["colors"]])
            })
    })
}

Here is screenshot of what I'd like to achieve. Any help would be appreciated. Thanks!

score 0 · Answer 1 · answered Apr 16 '17 at 14:15

There are a few approaches to creating dynamic UI in a shiny app. You have used renderUI. You could also try either insertUI or conditionalPanel. conditionalPanel is the simplest way to achieve what you want (I think). It means you don't have to worry about re-creating inputs, their associated observers and maintaining their currently selected value. conditionalPanel keeps the logic client side which means it has a snappier response and doesn't fade in/out. Example (without modules):

library(shiny)

choices_count <- c(1:10)

ui_conditional <- function(count_i) {
  conditionalPanel(condition = paste0("input.select_count >= ", count_i),
                   textOutput(paste0("text_", count_i))
      )
}

ui <- shinyUI(fluidPage(

  titlePanel("Sample app"),

  sidebarLayout(

    sidebarPanel(
      selectInput("select_count", "Count", choices = choices_count),
      selectInput("select_colour", "Colour", choices = c("blue", "green", "red"))
    ),

    mainPanel(
      lapply(choices_count, ui_conditional)
    )
  )

))

server <- function(input, output, session) {

  observeEvent(input$select_colour, {
    for (i in choices_count) {
      output[[paste0("text_",i)]] <- renderText(input$select_colour)
    }
  })

}

shinyApp(ui, server)

Thanks for the response. My project is more like a POC for a bigger project I'm working on which involves multiple modules. I wanted to be able generate input UI components from list in one module and have them interact with other modules. So I'm trying to avoid hard-coding the selectInputs. — Josiah, Apr 17 '17 at 14:30

score 0 · Answer 2 · answered Apr 17 '17 at 21:08

If I understand correctly, your issue is to understand how to generate on the server side dynamic UI components.

I tried to achieve something similar to what you have as UI example, using dynamic components.

library(shiny)

#------------------------------------------------------------------------------
#
# Any general purpose assignment, available for any session, should be done here or on a sourced file
countLb <- c(1,2,3,4,5)
colorLb <- c("blue", "green","red")

# dynamic elements can potentially live either in a separate file, or here, or in the Server part. 
# Of course they need to be in Server if you change them dynamically!

dynUI <- list(
   selectInput("inputID1", label = "count",  choices = countLb, multiple = F)
 , selectInput("inputID2", label = "colors", choices = colorLb, multiple = F)
)

ui <- fluidPage(
  titlePanel("Sample App"),
  sidebarLayout(
    sidebarPanel(
      uiOutput("selectorModl")
    ),
    mainPanel(
      uiOutput("viewerModl")
    )
  ))

server = function(input, output,session) {


output$selectorModl <- renderUI({
  dynUI
})

output$viewerModl <- renderUI({

   if((length(input$inputID1) == 0) | (length(input$inputID2) == 0)) return()
   isolate({
   toRender <- lapply(1:input$inputID1, function(i) {
     textInput(paste("text",i, sep = "_"), label = "", value = input[["inputID2"]])
   })
   return(toRender)
   }) # end isolate
 })
}

shinyApp(ui,server)

Please let me know if I got close to address your requirements, of if you need any further clarification on this code.

score 0 · Accepted Answer · answered Apr 18 '17 at 09:00

I've included this as a separate answer to avoid confusing the code.

This is a working version using modules and dynamic ui. note the use of ns <- session$ns within the modules. Also be careful with reactive functions. I would normally name variables rfVariableName to remind me that it is a reactive function rather than just a normal variable.

library(shiny)

# selctor Module ---------------
selectorUI <- function(id) {

  ns <- NS(id)

  uiOutput(ns("selectorPane"))

}

selector <- function(input, output, session, selection) {

  output$selectorPane <- renderUI({

    ns <- session$ns

    tagList(
      lapply(1:length(selection), function(selIdx){
        selName <- names(selection)[selIdx]
        selChoices <- selection[[selName]]
        selectInput(inputId = ns(selName), label = selName, choices = selChoices, multiple = F)
      })
    )

  })

  allInputs <- reactive({
    l <- lapply(1:length(selection), function(getid) {
      selName <- names(selection)[getid]
      input[[selName]]
    })
    names(l) <- names(selection)
    l
  })

  return(allInputs)

}

# Viewer Module ---------------
viewerUI <- function(id) {
  ns <- NS(id)

  uiOutput(ns("viewerPane"))

}

viewer <- function(input, output, session, inputValues) {

  output$viewerPane <- renderUI({

    ns <- session$ns

    if (length(inputValues()) > 0) {
      if (!is.null(inputValues()[["count"]])) {
        if (inputValues()[["count"]] > 0) {
          tagList(
            lapply(1:inputValues()[["count"]], function(idx){
              textInput(ns(paste("text",idx, sep = "_")), label = "", value = inputValues()[["colors"]])
            })
          )
        }
      }
    }

  })

}



# Main UI --------------
ui <- shinyUI(fluidPage(
  titlePanel("Sample App"),
  sidebarLayout(
    sidebarPanel(
      selectorUI("selectorModl")
    ),
    mainPanel(
      viewerUI("viewerModl")
    )
  )))


# Server 
server <- function(input, output, session) {

  selection <- list("count" = c(1,2,3,4,5), "colors" = c("blue", "green","red"))

  inputValues <- callModule(selector,"selectorModl", selection = selection)

  observeEvent(inputValues(),{

    if (length(inputValues()) > 0) {
      callModule(viewer, "viewerModl", inputValues = inputValues)
    }

  })

}

shiny::shinyApp(ui, server)

This is exactly what I needed. Excellent work! You're definitely right about naming reactive functions and variables. Thank you! — Josiah, Apr 18 '17 at 22:56

Dynamically created selectInputs not recognized in server

3 Answers3

Linked