依赖于另一个 selectInput 的 selectInput

Posted 2023-03-24

【中文标题】依赖于另一个 selectInput 的 selectInput

【英文标题】：selectInput that is dependent on another selectInput

【发布时间】：2016-04-28 00:29:18

【问题描述】：

我在下面有一些数据，用于在 R Shiny 中创建一个圆环图，其中date 是一个字符。我希望能够选择要查看其分数的电子邮件，但随后在第二个下拉选择中仅查看该电子邮件具有活动的日期。

例如，如果我在第一个下拉列表中选择 email = xxxx，我只想在日期选择字段中看到“无活动”。对于电子邮件 = yyyy，我只想看到 6/17/14、6/18/14、6/19/14 作为选择。

我在 ui 中尝试了一种嵌套子集。示例：

> ui <- shinyUI(fluidPage(
+   sidebarLayout(
+     sidebarPanel(
+       selectInput('Select', 'Customer:', choices = unique(as.character(dat5$email))),
+       selectInput("User", "Date:", choices = dat5[dat5$email==input$Select,date])
+     ),
+     mainPanel(plotOutput("distPlot"))
+   )
+ ))

但这仍然显示所有可能的日期选择

数据

email   date        variable    value   ymin    ymax
xxxx    no activity e_score         0   0       0
xxxx    no activity diff            1   0       1
yyyy    6/17/14     e_score    0.7472   0       0.7472
yyyy    6/17/14     diff       0.2528   0.7472  1
yyyy    6/18/14     e_score    0.373    0       0.373
yyyy    6/18/14     diff       0.627    0.373   1
yyyy    6/19/14     e_score    0.533    0       0.533
yyyy    6/19/14     diff       0.467    0.533   1

到目前为止我的代码：

app.R

library(shiny)
library(shinydashboard)

ui <- shinyUI(fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput('Select', 'Customer:', choices = unique(as.character(dat5$email))),
      selectInput("User", "Date:", choices = unique(dat5$date) )
    ),
    mainPanel(plotOutput("distPlot"))
  )
))


server <- function(input, output) 
  output$distPlot <- renderPlot(
    ggplot(data = subset(dat5, (email %in% input$Select & date %in% input$User)), aes(fill=variable, ymax = ymax, ymin = ymin, xmax = 4, xmin = 3)) +
      geom_rect(colour = "grey30", show_guide = F) +
      coord_polar(theta = "y") +
      geom_text(aes(x = 0, y = 0,label = round(value[1]*100))) +
      xlim(c(0, 4)) +
      theme_bw() +
      theme(panel.grid=element_blank()) +
      theme(axis.text=element_blank()) +
      theme(axis.ticks=element_blank()) +
      xlab("") +
      ylab("") +
      scale_fill_manual(values=c('#33FF00','#CCCCCC')) 

  )

  shinyApp(ui = ui, server = server)

【参考方案1】：

您无法访问应用程序的 ui.R 部分中的输入，因此您需要使用 renderUi/uiOutput 来动态生成您的 selectInput。

您可以在ui.R 中添加：

uiOutput("secondSelection")

在你的server.R:

 output$secondSelection <- renderUI(
                selectInput("User", "Date:", choices = as.character(dat5[dat5$email==input$Select,"date"]))
        )

【讨论】：

做到了！出于某种原因，我不得不choices = as.character(dat5[dat5$email==input$Select,"date"]) 没有日期周围的引号。否则效果很好！

我对“您无法访问应用程序的 ui.R 部分中的输入”的回答语句感到困惑。当您使用条件面板时，您正在根据 input.panel 定义条件。这不取决于UI的输入吗？

这对我有用（除了我使用selectizeInput）只有非常小的数据集。随着更大，动态菜单字段和文本框变为灰色，然后 Shiny 变得无响应。想知道是否有人对不同的方法有任何建议，当有很多选择可供发现时？

【参考方案2】：

您也可以在不更改 ui.R 的情况下执行此操作。将此添加到server.R 具有相同的效果。

    observe(
          updateSelectInput(session, "User", choices = as.character(dat5[dat5$email==input$Select, date]))
    )

虽然它是一个有用且强大的工具，但我发现没有renderUI 也能“更干净”。它将 UI 保留在 UI 中，将服务器保留在服务器中。但这只是口味问题，我想。