更新R Shiny中动态创建的selectInput框的选项(Updating choices for dynamically-created selectInput boxes in R Shiny)

 我正在开发一个应用程序，允许用户动态地向UI添加新的selectInput框，我希望所有这些selectInput框都将数据集的列名作为“选择”。 数据集也应该由用户选择，这就是为什么我使selectInput选项对数据集选择中的更改起反应的原因。 
 
 这听起来很简单，但我似乎无法让它正常工作。 当我第一次打开应用程序时，第一个selectInput为空; 这没关系，因为我希望用户能够上传他们自己的数据集，所以默认数据集无论如何都是NULL（这里使用预先加载的数据集进行再现，因此它略有不同）。 
 
  
 
 我从下拉选择框中选择一个（不同的）数据集'iris'，并且'iris'数据集的列名称会自动加载到selectInput框中（表1）。 这完全符合要求。 
 
  
 
 接下来，我通过单击表1中的Plus符号添加一个新的selectInput框，旁边会出现一个新的selectInput框（表2）。 
 
  
 
 问题在于：我希望新创建的子selectInput框自动使用数据集的列名，但我无法弄清楚如何执行此操作。 填充新selectInput框的唯一方法是再次更改数据集选项，这是不可取的。 
 
 以下是此示例中使用的代码： 
 
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)
 
 希望有人可以帮助解决这个问题，有很多关于selectInput在线的问题，但我没有找到任何解决方案来解决我遇到的这个问题。 

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. 

原文：https://stackoverflow.com/questions/38956270