通过 R Shiny 中的先前输入限制输入的选项

Posted 2023-03-24

【中文标题】通过 R Shiny 中的先前输入限制输入的选项

【英文标题】：Limit the options of an input by a previous input in R Shiny

【发布时间】：2021-02-10 21:25:59

【问题描述】：

我正在构建一个闪亮的应用程序，并想知道如何根据第一个输入中选择的选项自动限制选择输入的选择。 该应用程序如下所示：

library(shiny)
library(shinyWidgets)
library(dslabs)
library(tidyverse)
library(plotly)


ui <- fluidPage(
    
    titlePanel("Traffic Incidents"),
    sidebarLayout(
        sidebarPanel(
            # inputs
            selectizeInput("vehicleInput", "Vehicle",
                           choices = unique(incident$vehicle),  
                           selected="448", multiple =FALSE),
            selectizeInput("groupInput", "Incident Group",
                           choices = unique(incidents$group),  
                           selected="None", multiple =FALSE)
        ),  
        
        mainPanel(
            # outputs
            plotlyOutput("plot"),
            br(), br(),
            plotlyOutput("plot2")
            
        ) 
    ) 
)   

server <- function(input, output) 
    
        d <- reactive(
            filtered <-
                incidents %>%
                filter(vehicle == input$vehicleInput,
                       group %in% input$groupInput)    
            
        ) 
         
    output$plot <- renderPlotly(
        
        box <- plot_ly(d(), x = ~month, y = ~casualties)  %>%
            layout(title = "Incident Casualties",
                   yaxis = list(title=input$dataInput))
        
    )
    
    output$plot2 <- renderPlotly(
        
        box <- plot_ly(d(), x = ~month, y = ~costs)  %>%
            layout(title = "Incident Costs",
                   yaxis = list(title=input$dataInput))
        
    )
    


shinyApp(ui=ui, server=server)

我想知道如何通过“车辆”输入中选择的选项来限制“事件组”输入中的选项，即只能选择与个别车辆相关的事件组。

我知道我应该使用 observe() 函数，但是我确实很难正确使用它。

感谢您的任何建议！

【问题讨论】：

我认为您需要更新输入“groupinput”并减少选择。在此处查看有关更新输入的更多信息shiny.rstudio.com/reference/shiny/1.3.1/updateSelectInput.html

【参考方案1】：

也许这就够了

ui <- fluidPage(
  
  titlePanel("Traffic Incidents"),
  sidebarLayout(
    sidebarPanel(
      # inputs
      uiOutput("veh"),
      uiOutput("grp")
    ),  
    
    mainPanel(
      # outputs
      plotlyOutput("plot"),
      br(), br(),
      plotlyOutput("plot2")
      
    ) 
  ) 
)   

server <- function(input, output) 
  
  output$veh <- renderUI(
    selectizeInput("vehicleInput", "Vehicle",
                   choices = unique(incident$vehicle),  
                   selected="448", multiple =FALSE)
  )
  
  d1 <- reactive(
    data <- incidents %>% filter(vehicle %in% req(input$vehicleInput))
  )
  
  output$grp <- renderUI(
    req(d1())
    selectizeInput("groupInput", "Incident Group",
                   choices = unique(d1()$group),  
                   selected="None", multiple =FALSE)
  )
  
  d <- reactive(
    req(d1(),input$groupInput)
    filtered <- d1() %>%  filter(group %in% input$groupInput)
  ) 
  
  output$plot <- renderPlotly(
    
    box <- plot_ly(d(), x = ~month, y = ~casualties)  %>%
      layout(title = "Incident Casualties",
             yaxis = list(title=input$dataInput))
    
  )
  
  output$plot2 <- renderPlotly(
    
    box <- plot_ly(d(), x = ~month, y = ~costs)  %>%
      layout(title = "Incident Costs",
             yaxis = list(title=input$dataInput))
    
  )
  


shinyApp(ui=ui, server=server)

【讨论】：

谢谢 YBS，这一切都很好！现在我明白如何做到这一点了。