R Shiny - Flush dynamically generated input functions using selectInput - r

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!

Answer 1

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)