动态更新 selectInput，基于动态更新的 selectInput

Question

我正在尝试根据动态更新的selectInput() 值动态更新selectInput() 值。我可以让第一个值动态更新，但是当我尝试使用这些值来更新更多值时，我得到一个错误：

Warning: Error in [.data.frame: undefined columns selected
  [No stack trace available]

我正在寻找的行为是：

1. 从数据框中选择一个变量
2. 过滤数据框以从该变量中选择值
3. 从数据框中选择另一个变量
4. 过滤数据框以从该变量中选择值

一旦选择了变量，我不希望该选项在后续选择中显示为选项。我希望根据所选变量填充过滤器选项。

这是一个可重现的例子：

library('shiny')

#create sample data
df = data.frame('first.name' = c('peter', 'paul', 'patricia'), 
                  'family.name' = c('smith', 'jones', 'gibbon'), 
                  'language' = c('english', 'french', 'spanish'))
#create the UI
ui <- fluidPage(
  
  #Create first selector for variable 1, based on column names
  selectInput(inputId = 'var1', 
              label = 'Variable 1', 
              choices = colnames(df)),
  
  #create selector for filtering, populated based on the selection for variable 1
  #leave values for label and choice blank - to be populated by updateSelectInput()
  selectInput(inputId = 'var1_subselect', 
              label = '', 
              choices = ''),
  
  #create selector for variable 2, should not include variable one
  selectInput(inputId = 'var2', 
              label = 'Variable 2', 
              choices = ''),
  
  #create selector for filtering, populated based on the selection for variable 2
  selectInput(inputId = 'var2_subselect', 
              label = '', 
              choices = '')
  
)

#Create the server
server <- function(session, input, output) {
 observe({
   updateSelectInput(session, 
                     inputId = 'var1_subselect', #for var1_subselect
                     label = paste(input$var1, 'selection:'), #Get the label from the value for var1
                     choices = unique(df[input$var1])) #Get the choices based on unique values far var1
 })
  
  observe({
    updateSelectInput(session, 
                      inputId = 'var2', #for var2
                      label = 'Variable 2', #Label is standard 
                      choices = setdiff(colnames(df), input$var1)) #Get choices from the colnames for the df, excluding the choice for var1
  })
  
  #Everything works up to this point, however when i add the following effort to filter the values for var 2, i get an error
  
  observe({
    updateSelectInput(session, 
                      inputId = 'var2_subselect', #for var2_subselect
                      label = paste(input$var2, 'selection:'), #Get the label from the value for var2
                      choices = unique(df[input$var2])) #Get the choices based on the unique values of var2
  })
  
}

#call the app
shinyApp(ui, server)

当我调用第三个observe({}) 函数时，我得到一个错误。我想这是因为我试图调用一个基于反应输入的反应输入。

我尝试在我的 UI 中使用 uiOutput() 并在我的服务器中使用 renderUI({}) 来解决这个问题，但是一旦我尝试根据动态更新的内容动态更新内容时遇到了同样的问题。

Answer 1

一个小而简单的解决方法是使用[[ 而不是[ 过滤数据。这篇文章The difference between bracket [ ] and double bracket [[ ]] for accessing the elements of a list or dataframe 解释了两者之间更高级别的差异。

这里，[[ 总是返回一个向量，而 [ 返回一个数据帧，它在大多数情况下都可以正常工作，但在没有为 var2 进行选择时失败，这意味着当 var2 为空时。

[ 返回

df['']

[.data.frame(df, "") 中的错误：选择了未定义的列

这是您收到的错误消息。

而[[ 则返回NULL。

df[['']]
#NULL

被selectInput 中的choices 参数接受。

---

完整代码-

library(shiny)

#create sample data
df = data.frame('first.name' = c('peter', 'paul', 'patricia'), 
                'family.name' = c('smith', 'jones', 'gibbon'), 
                'language' = c('english', 'french', 'spanish'))
#create the UI
ui <- fluidPage(
  
  #Create first selector for variable 1, based on column names
  selectInput(inputId = 'var1', 
              label = 'Variable 1', 
              choices = colnames(df)),
  
  #create selector for filtering, populated based on the selection for variable 1
  #leave values for label and choice blank - to be populated by updateSelectInput()
  selectInput(inputId = 'var1_subselect', 
              label = '', 
              choices = ''),
  
  #create selector for variable 2, should not include variable one
  selectInput(inputId = 'var2', 
              label = 'Variable 2', 
              choices = ''),
  
  #create selector for filtering, populated based on the selection for variable 2
  selectInput(inputId = 'var2_subselect', 
              label = '', 
              choices = '')
  
)

#Create the server
server <- function(session, input, output) {
  observe({
    updateSelectInput(session, 
                      inputId = 'var1_subselect', #for var1_subselect
                      label = paste(input$var1, 'selection:'), #Get the label from the value for var1
                      choices = unique(df[[input$var1]])) #Get the choices based on unique values far var1
  })
  
  observe({
    updateSelectInput(session, 
                      inputId = 'var2', #for var2
                      label = 'Variable 2', #Label is standard 
                      choices = setdiff(colnames(df), input$var1)) #Get choices from the colnames for the df, excluding the choice for var1
  })
  
  observe({
     updateSelectInput(session, 
                       inputId = 'var2_subselect', #for var2_subselect
                       label = paste(input$var2, 'selection:'), #Get the label from the value for var2
                       choices = unique(df[[input$var2]])) #Get the choices based on the unique values of var2
   })
  
}

#call the app
shinyApp(ui, server)