Shiny中如何调整destination的selectInput排除已选出发地

当前Shiny应用中，当在departurepto选择框（出发地）选中某个市场（例如Market1）后，destination选择框（目的地）的选项里仍会出现该市场。需要修改逻辑，让目的地仅显示当前条件下除出发地外的其他市场。

用户提供的原始代码：

library(shiny)
library(shinythemes)
library(lubridate)


df1<- structure(
  list(
    Marketname = c("Market1","Market1", "Market2","Market2", "Market3", "Market3"),
    Days = c("Sunday","Sunday","Sunday","Sunday", "Sunday","Tuesday"),
    Openinghours = c("Morning","Evening", "Morning","Evening","Evening","Evening")
  ), row.names = c(NA, 6L), class = "data.frame")


ui <- fluidPage(  
  shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                    br(),
                    tabPanel("",
                             sidebarLayout(
                               sidebarPanel(
                                 dateInput("date", "Which day shift do you choose?"),
                                 selectInput("hours", label = h5("Which work shift do you choose??"), choices = NULL, 
                                             selected = ""),
                                 selectInput("departurepto", label = h5("Departure point"), choices = NULL, 
                                             selected = ""),
                                  
                                 selectInput("destination", label = h5("Destination point"), choices = NULL, 
                                             selected = ""),
                                  
                                 ),
                               mainPanel(
                               )
                             ))
  ))

server <- function(input, output, session) {
  week_day <- reactive({
    wday(input$date, label = TRUE, abbr = FALSE)
  })
  
  observe({
    updateSelectInput(session, "hours",
                      choices = unique(df1[df1$Days == week_day(), "Openinghours"])
    )
  })
  
  observe({
    updateSelectInput(session, "departurepto",
                      choices = unique(df1[df1$Days == week_day() & df1$Openinghours %in% input$hours, "Marketname"])
    )
  })
  
  observe({
    updateSelectInput(session, "destination",
                      choices = unique(df1[df1$Days == week_day() & df1$Openinghours %in% input$hours, "Marketname"])
    )
  })
}
shinyApp(ui = ui, server = server)

解决方案 #

只需修改destination对应的observe逻辑，在筛选市场时排除已选中的departurepto值，同时确保该observe监听所有相关依赖项（日期、时段、出发地）的变化：

修改后的完整代码：

library(shiny)
library(shinythemes)
library(lubridate)


df1<- structure(
  list(
    Marketname = c("Market1","Market1", "Market2","Market2", "Market3", "Market3"),
    Days = c("Sunday","Sunday","Sunday","Sunday", "Sunday","Tuesday"),
    Openinghours = c("Morning","Evening", "Morning","Evening","Evening","Evening")
  ), row.names = c(NA, 6L), class = "data.frame")


ui <- fluidPage(  
  shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                    br(),
                    tabPanel("",
                             sidebarLayout(
                               sidebarPanel(
                                 dateInput("date", "Which day shift do you choose?"),
                                 selectInput("hours", label = h5("Which work shift do you choose??"), choices = NULL, 
                                             selected = ""),
                                 selectInput("departurepto", label = h5("Departure point"), choices = NULL, 
                                             selected = ""),
                                  
                                 selectInput("destination", label = h5("Destination point"), choices = NULL, 
                                             selected = ""),
                                  
                                 ),
                               mainPanel(
                               )
                             ))
  ))

server <- function(input, output, session) {
  week_day <- reactive({
    wday(input$date, label = TRUE, abbr = FALSE)
  })
  
  observe({
    updateSelectInput(session, "hours",
                      choices = unique(df1[df1$Days == week_day(), "Openinghours"])
    )
  })
  
  observe({
    updateSelectInput(session, "departurepto",
                      choices = unique(df1[df1$Days == week_day() & df1$Openinghours %in% input$hours, "Marketname"])
    )
  })
  
  observe({
    # 获取当前日期和时段下的所有可选市场
    available_markets <- unique(df1[df1$Days == week_day() & df1$Openinghours %in% input$hours, "Marketname"])
    # 移除已选中的出发地，得到目的地选项
    destination_choices <- available_markets[available_markets != input$departurepto]
    updateSelectInput(session, "destination",
                      choices = destination_choices
    )
  })
}
shinyApp(ui = ui, server = server)

说明 #

• 当用户选择出发地后，目的地选项会自动过滤掉该出发地，只显示其他符合日期和时段条件的市场
• 如果出发地未选择，目的地会显示所有符合条件的市场（若需调整此逻辑，可添加if(!is.null(input$departurepto))类的判断）

内容的提问来源于stack exchange，提问作者Carlo Soares