updateSelectInput 适用于 data.frame 但不适用于数据框列表

Question

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

示例。更改 input$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 是否具有有效值，以免出现错误（shiny 似乎在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())
```