在flexdashboard闪亮小部件中创建一个依赖于另一个输入变量的输入变量

Question

我试图在flexdashboard中创建一个依赖于另一个用户输入的用户输入。示例数据集：Alphabet_data <-read.table（         文字=“字母数字         ABC 1         防守4         ABD 5         ABC 2         ABC 3         ABD 6         ABD 7         ABD 8“，         标头= TRUE，         stringsAsFactors = FALSE）

用户在selectizeInput（例如ABD）中选择“字母”，基于此，我希望用户将“ number”的selectizeInput选项仅显示为5,6,7,8。

1. 我尝试对“字母”进行observeEvent，以创建新的依赖输入
2. 我使用NULL选项创建了从属输入“数字”，并使用了观察事件来更新select.Input。
3. 我根据字母选择创建了一个新表，然后在React中使用该表来创建“数字”输入。
4. 下面有代码可以重现该问题。

---

title：“无标题” 输出：   flexdashboard :: flex_dashboard：     方向：列     vertical_layout：填充

运行时：闪亮

library(flexdashboard)
library(tidyverse)

alphabet_data <- read.table(
        text = "Alphabet       Number
        ABC       1
        DEF       4
        ABD       5
        ABC       2
        ABC       3
        ABD       6
        ABD       7
        ABD       8",
        header = TRUE,
        stringsAsFactors = FALSE)

列{.sidebar data-width = 650}

图表A

selectizeInput(
    inputId  = "alphabet",
    label    = "Alphabet",
    choices  = unique(alphabet_data$Alphabet),
    multiple = TRUE,
    options  = list(maxItems = 2)
)

selectizeInput(
        inputId  = "number",
        label    = "Number",
        choices  = NULL,
        multiple = TRUE,
        options  = list(maxItems = 2)
)

selected_alphabet <- eventReactive(
    eventExpr = input$alphabet,

    valueExpr = {
    alphabet_data %>% 
            filter(Alphabet %in% input$alphabet)
})

reactive({
    observeEvent(
        eventExpr   = input$alphabet,
        handlerExpr = {
            updateSelectizeInput(
                inputId = "number",
                choices = selected_alphabet()$number
            )
        }
    )
})

列{data-width = 350}

图表B

output$alphabet <- renderPrint(input$alphabet)
textOutput(outputId = "alphabet")

图表C

renderPrint(selected_alphabet())

图表D

output$number <- renderPrint(input$number)
textOutput(outputId = "number")

我希望当用户选择ABD字母时，要显示的数字选项为5,6,7,8。

Answer 1

我在运行示例脚本时遇到了麻烦，所以我写了一个类似的脚本。

您有两个选择：

1. 使用renderUI()或insertUI()在服务器中生成UI组件。
2. 使用updateSelectInput()升级UI组件。

我写了一个有光泽的演示，尽管它没有使用flexdashboard，但它却做同样的事情：

library(shiny)

ui <- fluidPage(
  fluidRow(
      tags$h1("level 1"),
      column(
          width = 6,
          selectizeInput("selectizeInput1","Input 1",choices = letters,selected = "",multiple = TRUE)
      ),
      column(
          width = 6,
          textOutput("textOutput1")
      )
  ),
  fluidRow(
      tags$h1("level 2"),
      column(
          width = 6,
          selectizeInput("selectizeInput2","Input 2",choices = "",selected = "",multiple = TRUE)
      ),
      column(
          width = 6,
          textOutput("textOutput2")
      )
  ),
  fluidRow(
      tags$h1("level 3"),
      column(
          width = 6,
          selectizeInput("selectizeInput3","Input 3",choices = "",selected = "",multiple = TRUE)
      ),
      column(
          width = 6,
          textOutput("textOutput3")
      )
  )

)

server <- function(input, output, session) {
    # level 1
    output$textOutput1 <- renderText(input$selectizeInput1)

    # level 2
    observe({
        updateSelectInput(
            session = session,
            inputId = "selectizeInput2",
            choices = input$selectizeInput1,
            selected = input$selectizeInput1
        )
        output$textOutput2 <- renderText(input$selectizeInput2)

    })


    # level 3
    observe({
        updateSelectInput(
            session = session,
            inputId = "selectizeInput3",
            choices = input$selectizeInput2,
            selected = input$selectizeInput2
        )
        output$textOutput3 <- renderText(input$selectizeInput3)

    })
}

shinyApp(ui, server)

为了更好地理解，您可以阅读this article或尝试this app