R Shiny - Flush dynamically generated input functions using selectInput

Question

I have a Shiny app where my dynamically generated UI won't display properly once I change a selectInput value.

Here, you can choose between two data frames. When you click the button, it generates a selectInput (whose values are the column names of the data frame) and checkboxInput UI (the unique values of the column you've selected). That's good and all but once I change the data frame I want to view, the selectInput values populate "accordingly" with the column names of the new data frame. However, the checkboxInput no longer displays.

ui <- fluidPage(
  fluidRow(
    column(4, 
           uiOutput("projectSelection"),
           uiOutput("addCol")
    )
  ),
  fluidRow(
    tags$div(id="rowLabel")
  )
)

server <- function(input, output, session) {
  Project.ID <- c("Test Project 1", "Test Project 1", "Test Project 1", "Test Project 1")
  Project.ID2 <- c("Test Project 2", "Test Project 2", "Test Project 2", "Test Project 2")
  Author.ID <- c("1234", "5234", "3253", "5325")
  Fav.Color <- c("Blue", "Red", "Blue", "Green")
  Author.Name <- c("Bob", "Jenny", "Bob", "Alice")

  output$projectSelection <- renderUI(
    selectInput("projectSelection",
                "Project Name:",
                c("Project1", "Project2"),
                selectize=TRUE)
  )

  # update datatable
  project <- reactive({
    if(input$projectSelection == "Project1"){
      projectDT <- data.frame(Project.ID, Author.ID, Author.Name)
    }
    if(input$projectSelection == "Project2"){
      projectDT <- data.frame(Project.ID2, Author.Name, Fav.Color)
    }
    return(projectDT)
  })


  #Button to add comparison column
  output$addCol <- renderUI({
    input$projectSelection #re-render once projectSelection changes?
    if(is.null(input$projectSelection)) return() 
    actionButton('addCol', strong("Add UI"), icon=icon("plus", class=NULL, lib="font-awesome"))
  })

  observeEvent({input$addCol},{
    insertUI(
      selector = "#rowLabel", 
      where = "beforeEnd", 
      ui = div(              
        fluidRow( 
             column(4, 
                    uiOutput(paste0("showMeta",input$addCol)),
                    uiOutput(paste0("showVal",input$addCol)),
                    br()
          )
        )
      )
    )
  })

  #Output creations
  lapply(1:10, function(idx){
    #comparison dropdowns
    output[[paste0("showMeta",idx)]] <- renderUI({
      input$projectSelection
      selectInput(inputId =  paste0("metalab",idx),
                  label =  "Column Label:",
                  choices =  c(unique(as.vector(colnames(project())))),
                  selectize = TRUE,
                  selected = input[[paste0("metalab",idx)]]
      )
    })
    output[[paste0("showVal",idx)]] <- renderUI({
      req(input$addCol >= idx)
      input$projectSelection
      if(!is.null(input[[paste0("metalab", idx)]])){
        checkboxGroupInput(paste0("metaval",idx),
                           "Column Value:",
                           choices = unique(as.vector(unlist(project()[[input[[paste0("metalab",idx)]]]]))),
                           selected = input[[paste0("metaval",idx)]]
        )

      }
    })
  })

  # observe({input$projectSelection},
  #         {
  #           lapply(1:10, function(idx){
  #             updateSelectInput(session, paste0("metalab",idx),
  #                               label =  "Column Label:",
  #                               choices =  c(unique(as.vector(colnames(project()))))
  #             )
  #           })
  #         })
}

shinyApp(ui=ui, server = server)

I'm not sure if there's a referencing issue somewhere along the line but I'd like for the checkboxInput UI to display with the appropriate values (for the selected column). I've thought about trying to have it re-render once input$projectSelection changes but that doesn't seem to do anything. I also tried putting an observe for it so the dynamically generated UI updates when input$projectSelection changes but I haven't been successful with that either.

I'd appreciate any and all help! Thanks!

Winicius Sabino Winicius Sabino · Accepted Answer · 2018-02-06T01:45:10

Your checkbox only updated when you click the ADD button.

I've changed its code to make the dynamic checkbox according to the selectinput of the column names, I believe the functionality remains the same

ui <- fluidPage(
  fluidRow(
    column(4, 
           uiOutput("projectSelection"),
           uiOutput("addSelect"),
           uiOutput("checkbox")
    )
  ),
  fluidRow(
    tags$div(id="rowLabel")
  )
)

server <- function(input, output, session) {
  Project.ID <- c("Test Project 1", "Test Project 1", "Test Project 1", 
                  "Test Project 1")
  Project.ID2 <- c("Test Project 2", "Test Project 2", "Test Project 
                 2", "Test Project 2")
  Author.ID <- c("1234", "5234", "3253", "5325")
  Fav.Color <- c("Blue", "Red", "Blue", "Green")
  Author.Name <- c("Bob", "Jenny", "Bob", "Alice")

  output$projectSelection <- renderUI(
    tagList( 
     selectInput("projectSelection",
                  "Project Name:",
                  c("Project1", "Project2"),
                  selectize=TRUE),
      actionButton('addCol', strong("Add UI"), icon=icon("plus", 
             class=NULL, lib="font-awesome"))
   )

 )

  # update datatable
  project <- reactive({
    if(input$projectSelection == "Project1"){
      projectDT <- data.frame(Project.ID, Author.ID, Author.Name)
    }
    if(input$projectSelection == "Project2"){
      projectDT <- data.frame(Project.ID2, Author.Name, Fav.Color)
    }
    return(projectDT)
  })


  observeEvent(input$addCol,{ 
    output$addSelect <- renderUI({
      selectInput("abc","Column Names", choices = 
      c(unique(as.vector(colnames(project())))))

    })

    output$checkbox <- renderUI({
      checkboxGroupInput("cde", "Column Value", choices = project()
       [,input$abc] ) 
    })  
  })   

}

shinyApp(ui=ui, server = server)

R Shiny - Flush dynamically generated input functions using selectInput

1 Answers