CODEWITHSUNDEEP
rshinyshiny-reactivityshinyjs
theneil
theneil

Reputation: 518

R Shiny: create dynamic UI from selected input

I'm trying to create a dynamic UI that produces N amount of sections based on the number of selected variables from a selectInput() command. For each variable selected, I want to have its own section that lets you further specify other attributes for that variable (e.g. if it's numeric or character, how to impute missing values, etc.)

I have experience with insertUI() and removeUI() and was able to produce a small example of what I want it to look like. The section of my code that does this looks like this:

    insertUI(
      selector = '#ui_test',
      ui = tags$div(id = "extra_criteria",
                    h4("Covariate 1 (example)"),
                    selectInput("cov_1_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_1_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_1_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 2 (example)"),
                    selectInput("cov_2_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_2_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_2_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 3 (example)"),
                    selectInput("cov_3_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_3_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_3_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 4 (example)"),
                    selectInput("cov_4_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_4_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_4_impute_default_level", "Impute default level","0")
      )
    )

What I want to accomplish is to make the section above robust and dynamic in the sense that if the user only selects 2 variables, then I'd only want to create sections h4("Covariate 1 (example)") and h4("Covariate 2 (example)"). For example, if age and sex were selected then I'd want my section to look like:

    insertUI(
      selector = '#ui_test',
      ui = tags$div(id = "extra_criteria",
                    h4("Age"),
                    selectInput("age_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("age_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("age_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Sex"),
                    selectInput("sex_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("sex_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("sex_impute_default_level", "Impute default level","0")
                    
      )
    )

I was initially going to approach this by looping over the variables in the selected input and creating a long character string of the desired output (i.e. the chunks of h4(Covariate N)), and then passing that through eval(parse(text="...")). Something that in the end will look like this:

    insertUI(
      selector = '#ui_test',
      ui = tags$div(id = "extra_criteria",
                    eval(parse(text="..."))
      )
    )

where the "..." section are the chunks of h4("Covariate N) treated as a character string. Now, I don't know if this will work but it's the only approach I have at the moment. Is there a better way of approaching this problem, perhaps with some of the functions within shiny? Any help or advice will be greatly appreciated. My mock example can be found below:

library(shiny)
library(shinyjs)

ui <- shinyUI(fluidPage(
  shinyjs::useShinyjs(),
  navbarPage("Test",id="navbarPage",
             tabPanel("First tab", id = "first_tab",
                      sidebarLayout(
                        sidebarPanel(
                          selectInput('covariates', 'Select covariates', choices = c("age","sex","race","bmi"), multiple=TRUE, selectize=TRUE), 
                          actionButton("set.covariates","Set"),
                          tags$hr(),
                          tags$div(id = 'ui_test')
                        ),
                        mainPanel(
                          verbatimTextOutput("list")
                        )
                      )
             ))
))

# Define server logic required to draw a histogram
server <- shinyServer(function(input, output, session) {
  
  observe({
    if (is.null(input$covariates) || input$covariates == "") {
      shinyjs::disable("set.covariates")
      
    } else {
      shinyjs::enable("set.covariates")
    }
  })
  
  observeEvent(input$set.covariates, {
    shinyjs::disable("set.covariates")
  })
  
  prep.list <- eventReactive(input$set.covariates,{
    cov <- input$covariates
    timeIndep.list <- NULL
    for(L0.i in seq_along(cov)){
      timeIndep.list[[L0.i]] <- list("categorical"=FALSE,
                                     "impute"=NA,
                                     "impute_default_level"=NA)
    }
    names(timeIndep.list) <- cov
    return(timeIndep.list)
  })
  
  output$list <- renderPrint({
    prep.list()
  })
  
  observeEvent(req(input$set.covariates), {
    insertUI(
      selector = '#ui_test',
      ui = tags$div(id = "extra_criteria",
                    h4("Covariate 1 (example)"),
                    selectInput("cov_1_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_1_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_1_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 2 (example)"),
                    selectInput("cov_2_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_2_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_2_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 3 (example)"),
                    selectInput("cov_3_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_3_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_3_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 4 (example)"),
                    selectInput("cov_4_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_4_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_4_impute_default_level", "Impute default level","0")
      )
    )})
  
  observeEvent({input$covariates}, {
    removeUI(selector = '#extra_criteria')
  })
  
  
})

# Run the application
shinyApp(ui = ui, server = server)

Upvotes: 1

Views: 1067

Answers (1)

phago29
phago29

Reputation: 152

In the description page of insertUI function, it says:

Unlike renderUI(), the UI generated with insertUI() is persistent: once it's created, it stays there until removed by removeUI(). Each new call to insertUI() creates more UI objects, in addition to the ones already there (all independent from one another). To update a part of the UI (ex: an input object), you must use the appropriate render function or a customized reactive function.

So you cannot use insertUI here. Instead, use renderUI function with uiOutput to dynamically generate ui element.

Next, to generate a ui multiple times based on selection, you can use lapply. Since the number of iteration will be dependent on the number of items in the vector, which is the input$ object; the number of generated ui will be based on number of selection.

I think the code below solves your problem:

library(shiny)
library(shinyjs)

ui <- shinyUI(fluidPage(
  shinyjs::useShinyjs(),
  navbarPage("Test",id="navbarPage",
             tabPanel("First tab", id = "first_tab",
                      sidebarLayout(
                        sidebarPanel(
                          selectInput('covariates', 'Select covariates', choices = c("age","sex","race","bmi"), multiple=TRUE, selectize=TRUE), 
                          actionButton("set.covariates","Set"),
                          tags$hr(),
                          uiOutput("covariateop")
                        ),
                        mainPanel(
                          verbatimTextOutput("list")
                        )
                      )
             ))
))

# Define server logic required to draw a histogram
server <- shinyServer(function(input, output, session) {
  
  observe({
    if (is.null(input$covariates) || input$covariates == "") {
      shinyjs::disable("set.covariates")
      
    } else {
      shinyjs::enable("set.covariates")
    }
  })
  
  observeEvent(input$set.covariates, {
    shinyjs::disable("set.covariates")
  })
  
  prep.list <- eventReactive(input$set.covariates,{
    cov <- input$covariates
    timeIndep.list <- NULL
    for(L0.i in seq_along(cov)){
      timeIndep.list[[L0.i]] <- list("categorical"=FALSE,
                                     "impute"=NA,
                                     "impute_default_level"=NA)
    }
    names(timeIndep.list) <- cov
    return(timeIndep.list)
  })
  
  output$list <- renderPrint({
    prep.list()
  })
  
  observeEvent(req(input$set.covariates), {
    insertUI(
      selector = '#ui_test',
      ui = tags$div(id = "extra_criteria",
                    h4("Covariate 1 (example)"),
                    selectInput("cov_1_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_1_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_1_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 2 (example)"),
                    selectInput("cov_2_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_2_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_2_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 3 (example)"),
                    selectInput("cov_3_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_3_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_3_impute_default_level", "Impute default level","0"),
                    tags$hr(),
                    h4("Covariate 4 (example)"),
                    selectInput("cov_4_class", "Covariate class",
                                choices = c("numeric","character")),
                    selectInput("cov_4_impute", "Impute",
                                choices = c("default","mean","mode","median")),
                    textInput("cov_4_impute_default_level", "Impute default level","0")
      )
    )})
  
  observeEvent(req(input$set.covariates), {
    output$covariateop <- renderUI({  
      lapply(input$covariates, function(x){
      
        tags$div(id = paste0("extra_criteria_for_", x),
                 h4(x),
                 selectInput("cov_1_class", "Covariate class",
                             choices = c("numeric","character")),
                 selectInput("cov_1_impute", "Impute",
                             choices = c("default","mean","mode","median")),
                 textInput("cov_1_impute_default_level", "Impute default level","0"),
                 tags$hr()
        )
      })
    })
    
  })
  
  observeEvent({input$covariates}, {
    removeUI(selector = '#extra_criteria')
  })
  
  
})

# Run the application
shinyApp(ui = ui, server = server)

Upvotes: 1

Related Questions