I'm working on an app which allows users to dynamically add new selectInput boxes to the UI, and I want all of these selectInput boxes to take the column names of a dataset as their 'choices'. The dataset should also be user-selected, which is why I made the the selectInput choices reactive to changes in the dataset choice.
It sounds simple but I can't seem to get it working correctly. When I first open the app, the first selectInput is empty; this is okay because I want the user to be able to upload a dataset of their own, so the default dataset would be NULL anyway (here using pre-loaded datasets for reproducibility so it's slightly different).
I choose a (different) dataset, 'iris' from the dropdown select box, and the column names of the 'iris' dataset are automatically loaded into the selectInput box (Table 1). This works perfectly as desired.
Next, I add a new selectInput box by clicking on the Plus symbol on Table 1, and a new selectInput box appears beside it (Table 2).
And here lies the problem: I want the newly-created child selectInput boxes to automatically use the column names of the dataset, but I can't figure out how to do this. The only way to fill the new selectInput boxes is by changing the dataset choice again, which is not desirable.
Here is the code used in this example:
library(shiny)
library(datasets)
server <- function(input, output, session) {
### FUNCTIONS ###
newNode <- function(id, parentId) {
node <- list(
parent = parentId,
children = list()
)
# Create the UI for this node
createSliceBox(id, parentId)
return(node)
}
createSliceBox <- function(id, parentId) {
# Div names
containerDivID <- paste0('container',id,'_div')
nodeDivID <- paste0('node',id,'_div')
childrenDivID <- paste0('children',id,'_div')
if (parentId == 0) { # Root node case
parentDivID <- 'allSliceBoxes'
} else {
parentDivID <- paste0('children',parentId,'_div')
}
# Input names
selectID <- paste0("sliceBoxSelect", id)
buttonID <- paste0("sliceBoxButton", id)
# Insert the UI element for the node under the parent's children_div
insertUI(
selector = paste0('#',parentDivID),
where = 'afterBegin',
ui = tagList(
tags$div(id=containerDivID, style='float:left',
tags$div(id=nodeDivID, style='float:left; margin: 5px; min-width:250px',
actionButton(buttonID, "",
icon("plus-circle fa-1x"), style="float:right; border:none; color:#00bc8c; background-color:rgba(0,0,0,0)"),
wellPanel(class="well well-sm",
selectInput(selectID, paste0("Table ", id, ", child of ", parentId, "."), c(''), multiple=FALSE)
)
),
tags$div(id=childrenDivID, style='float:left') # Container for children, starts empty
),
tags$br('')
)
)
# Observer for selectors
observe(
updateSelectInput(session, selectID, choices=names(d.Preview()) ) # Doesn't work as expected?
)
}
### CODE STARTS HERE
tags$head(tags$script(src="https://use.fontawesome.com/15c2608d79.js")) # Import FontAwesome for icons
# File upload
d.Preview <- reactive({
switch(input$dataset,
"mtcars" = mtcars,
"iris" = iris,
"esoph" = esoph)
})
# We'll store our nodes as a 1D list, so parent and child ID's are recorded as their indices in the list
sliceBox.data <- reactiveValues(display=list(), selected=list())
rootNode <- newNode(1, 0) # Page loads with NULL first node, before input is chosen
sliceBox.tree <- reactiveValues(tree=list(rootNode))
# Special case for loading data into first node, needs reactive parentData - not the case for children nodes
observeEvent(input$dataset, {
slice <- reactive({
sliceData(d.Preview(), input$sliceBoxSelect1)
})
# Creating data for the first node
sliceBox.data$display[[1]] <- reactive(slice())
sliceBox.data$selected[[1]] = reactive({
selectedRows <- input[[paste0("sliceBoxTable", 1, "_rows_selected")]]
filterData(d.Preview(), sliceBox.data$display[[1]](), selectedRows, input[[paste0("sliceBoxSelect",1)]])
})
})
# Keep a total count of all the button presses (also used loosely as the number of tables created)
v <- reactiveValues(counter = 1L)
# Every time v$counter is increased, create new handler for the new button at id=v$counter
observeEvent(v$counter, {
parentId <- v$counter
buttonID <- paste0("sliceBoxButton", parentId)
# Button handlers to create new sliceBoxes
observeEvent(input[[buttonID]], {
v$counter <- v$counter + 1L
childId <- v$counter
# Note that because the ObserveEvents are run separately on different triggers, (childId != parentId+1)
# Create new child
sliceBox.tree$tree[[childId]] <- newNode(childId, parentId)
# Append new childId to parent's list of children
numChildren <- length(sliceBox.tree$tree[[parentId]]$children)
sliceBox.tree$tree[[parentId]]$children[numChildren+1] <- childId
})
})
}
ui <- fluidPage(theme = "bootstrap.css",
# Main display body
fluidRow(style="padding:5px",
selectInput("dataset", "Choose a dataset:", choices = c("mtcars", "iris", "esoph"), selected=NULL),
tags$div(uiOutput("allSliceBoxes"), style="padding:20px")
)
)
shinyApp(ui = ui, server = server)
Hope someone can help with this, there are lots of questions regarding selectInput online but I haven't found any solutions for this particular issue I'm having.
