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()) 
```