如何在Shiny中正确获取多个updatePickerInput逻辑

K，我非常感谢您的帮助。我在弄清多个shinyWidgets::updatePickerInput的逻辑时遇到麻烦。

下面的示例起作用...但是，您会注意到，您只能选择一项运动。如果您选择2项运动，然后导航至“团队”输入，则可以“重置为主要运动”，您会看到所需的团队出现。

目标是拥有一个允许用户无缝切换​​开/关运动和团队的应用程序，并附带一些警告。

1）如果您选择一项或多项主要运动，我希望所有团队先出现，然后选择一次取消选择一个。

2）如果您选择一个或多个球队，我希望能够选择一种体育项目来与该单个球队进行比较（例如，您选择了鲨鱼，并希望了解鲨鱼的外观和所有鲨鱼的外观）足球队）

长代码，但谢谢您的想法！

# load packages CHECK INSTALL 1st
library(tidyverse)
library(shiny)
library(ggrepel)
library(shinyWidgets)
# data wide
seriesDataWide <- data.frame(
date = seq.Date(from = as.Date("2019-01-01"),to = as.Date("2019-12-01"),by = "1 day"),football_bears = rnorm(335,mean = 3,sd = 0.5),football_eagles = rnorm(335,football_giants = rnorm(335,baseball_cubs = rnorm(335,baseball_sox = rnorm(335,hockey_bruins = rnorm(335,hockey_flames = rnorm(335,hockey_sharks = rnorm(335,hockey_preds = rnorm(335,stringsAsFactors = FALSE
)
# data long
seriesData <- seriesDataWide %>%
pivot_longer(-date,names_to = "sport_team",values_to = "value") %>%
separate(sport_team,into = c("sport","team"),sep = "_")
#### SHINY APP
ui <- fluidPage(
# title
titlePanel(strong("My Sport Plot")),# plot
plotOutput("plot",height = '600px'),# selectors
fluidRow(
column(1),column(5,pickerInput(
inputId = "varsOfIntMajor",label = "Select Sport",choices = unique(seriesData$sport),width = "100%",optiOns= list(
`actions-box` = TRUE,size = 5,dropdownAuto = FALSE
),choicesOpt = list(
style = rep_len("font-size: 75%; line-height: 0.8;",length(unique(seriesData$sport)))
),multiple = TRUE
)
),pickerInput(
inputId = "varsOfIntMinor",label = "Add or Subtract Team",choices = unique(seriesData$team),optiOns= pickerOptions(
actiOnsBox= TRUE,deselectAllText = "Reset to Major Sport",size = 5
),length(unique(seriesData$team)))
),column(1)
),sliderInput("daterange","Date Range:",min = as.Date("2019-01-01","%Y-%m-%d"),max = as.Date(Sys.Date(),value = c(as.Date("2016-01-01"),Sys.Date()),timeFormat = "%Y-%m-%d",width = '80%')
)
# Define a server for the Shiny app
server <- function(input,output,session) {
# plot
output$plot <- renderPlot({
# filter date range
dat <- seriesData[seriesData$date >= input$daterange[1] & seriesData$date <= input$daterange[2],]
# first check minor vals
if(is.null(input$varsOfIntMinor)) {
if(is.null(input$varsOfIntMajor)) {
seriesData <- dat
} else {
seriesData <- dat %>%
filter(sport %in% input$varsOfIntMajor)
## TURNING THIS OFF ALLOWS MULTIPLE SELECTIONS FOR MAJOR,BUT DISABLES FINER GRAIN MINOR W/I MAJOR
## THIS HAPPENS BECAUSE IF YOU UPDATE MINOR SECTOR IT NO LONGER SEES IT AS NULL AND SO JUMPS TO THE
## BOTTOM OF THE LOOP
updatePickerInput(session = session,"varsOfIntMajor",selected = unique(seriesData$sport))
updatePickerInput(session = session,"varsOfIntMinor",selected = unique(seriesData$team))
}
} else {
seriesData <- dat %>%
filter(team %in% input$varsOfIntMinor)
updatePickerInput(session = session,selected = unique(seriesData$team))
}
# generate percentiles
seriesData$pctile <- ave(seriesData$value,seriesData$team,FUN = function(x) ecdf(x)(x))
# create df for last observations
lastObs <- data.frame(
date = unlist(lapply(unique(seriesData$team),function(x) max(seriesData[seriesData$team == x,"date"][[1]]))),team = unique(seriesData$team),stringsAsFactors = FALSE
)
lastObs <- merge(lastObs,seriesData)
# plot
ggplot(seriesData,aes(value,color = team)) +
stat_ecdf(lwd = 2,alpha = 0.5) +
geom_point(data = lastObs,aes(x = value,pctile,color = team),size = 4) +
geom_label_repel(data = lastObs,color = team,label = team),force = 1,nudge_x = 20,fOntface= "bold") +
scale_y_continuous(labels = scales::percent,expand = c(0,0),breaks = seq(0,1,0.1)) +
labs(x = "value",y = "Percent Rank",color = "",title = "CDF Sports") +
guides(color = "none") +
theme_minimal()
})
}
shinyApp(ui,server)