updateSelectInput适用于data.frame，但不适用于dataframe的列表

Question

我想在交互式的rmarkdown闪亮文档中更新selectInput，取决于在dataframe列表中的选择，但闪亮的给我这个错误。警告：[[：尝试在get1index中选择少于一个元素的错误

示例。更改输入$ disp取决于所选的cyl。

示例1.创建一个由cyl分割的3个data.frame的列表，并按名称选择一个。

--- 
title: "Test observe" 
output: html_document 
runtime: shiny 
--- 



    ```{r echo=FALSE} 

    datos <- mtcars 
    datos <- split(datos, datos$cyl) 
    un_cyl <- unique(mtcars$cyl) 
    gears <- c(3,4,5) 
    disp_list <- unique(mtcars$disp) 


    inputPanel(
    selectInput("cyl", label = "cyl", 
        choices = un_cyl), 
     selectInput("disp", label = "disp", 
        choices = disp_list, selected = disp_list[1]) 
    ) 


    eventos_sel <- reactive({ 
     eventos <- datos[[input$cyl]] 
     eventos 
    }) 


    elegibles <- reactive({ 
     tmp <- eventos_sel() 
     tmp <- unique(tmp$disp) 
     return(tmp) 
    }) 

    # hacer un updateSelectInput 

    observe({ 
     updateSelectInput(session, inputId = "disp", choices = elegibles()) 
     }) 


    renderPrint(elegibles()) 


    ``` 

例2.与例1相同，但使用子集原始data.frame而不是创建列表。这个例子工作，但我需要在我的真实情况下的数据框列表。

--- 
title: "Test observe" 
output: html_document 
runtime: shiny 
--- 



```{r echo=FALSE} 

datos <- mtcars 
# change from example 1 
# datos <- split(datos, datos$cyl) 
un_cyl <- unique(mtcars$cyl) 
gears <- c(3,4,5) 
disp_list <- unique(mtcars$disp) 


inputPanel(
selectInput("cyl", label = "cyl", 
       choices = un_cyl), 
    selectInput("disp", label = "disp", 
       choices = disp_list, selected = disp_list[1]) 
) 


eventos_sel <- reactive({ 
    # change from example 1 
    eventos <- datos[datos$cyl == input$cyl, ] 
    eventos 
}) 


elegibles <- reactive({ 
    tmp <- eventos_sel() 
    tmp <- unique(tmp$disp) 
    return(tmp) 
}) 

# hacer un updateSelectInput 

observe({ 
    updateSelectInput(session, inputId = "disp", choices = elegibles()) 
    }) 


renderPrint(elegibles()) 


``` 

Answer 1

1. 指在列表中的特定数据帧时，你必须使用一个字符，而不是一个整数，尽管他们的名字只是一个数字
2. 你必须检查input$cyl具有有效值你使用它之前，这样你就不会得到一个错误（光泽似乎运行功能input$cyl有一个有效值之前）

工作代码...

--- 
title: "Test observe" 
output: html_document 
runtime: shiny 
--- 

```{r echo=FALSE} 
datos <- mtcars 
datos <- split(datos, datos$cyl) 
un_cyl <- unique(mtcars$cyl) 
gears <- c(3,4,5) 
disp_list <- unique(mtcars$disp) 

inputPanel(
    selectInput("cyl", label = "cyl", 
       choices = un_cyl), 
    selectInput("disp", label = "disp", 
       choices = disp_list, selected = disp_list[1]) 
) 

eventos_sel <- reactive({ 
    cylname <- as.character(input$cyl) 
    if (length(cylname) == 0) cylname <- "6" 
    eventos <- datos[[cylname]] 
}) 

elegibles <- reactive({ 
    tmp <- eventos_sel() 
    tmp <- unique(tmp$disp) 
    return(tmp) 
}) 

# hacer un updateSelectInput 
observe({ 
    updateSelectInput(session, inputId = "disp", choices = elegibles()) 
}) 

renderPrint(elegibles()) 
```