Updating choices for dynamically-created selectInput boxes in R Shiny

Question

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.

Answer 1

First of all, I added a new parameter choices to functions newNode and createSliceBox.

newNode <- function(id, parentId, choices = NULL) { 
             ... 
             createSliceBox(id, parentId, choices) 
             ...
           }

createSliceBox <- function(id, parentId, choices) { ... }

After that, within the function createSliceBox I changed a parameter of selectInput choices from c('') to choices.

createSliceBox <- function(id, parentId, choices) { 
    ... 
    selectInput(selectID, paste0("Table ", id, ", child of ", parentId, "."), choices, multiple=FALSE) # added choices
    ...
  }

Finally, within an observer down below, I added names of the actual dataset to newNode function

# Create new child
sliceBox.tree$tree[[childId]] <- newNode(childId, parentId, choices = names(d.Preview() )) # added choices

---

By the way, it is good to know that there is now a new function insertUI :)

---

Full example:

library(shiny)
library(datasets)

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

  newNode <- function(id, parentId, choices = NULL) { # new parameter
    node <- list(
      parent = parentId, 
      children = list()
    )
    # Create the UI for this node
    createSliceBox(id, parentId, choices) # new parameter 
    return(node)
  }

  createSliceBox <- function(id, parentId, choices) {
    # 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, "."), choices, multiple=FALSE) # added choices
                          )
                 ),
                 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, choices = names(d.Preview() )) # added choices

      # 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)