Как получить правильную логику updatePickerInput в Shiny

Question

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, mean = 3, sd = 0.5),
  football_giants = rnorm(335, mean = 3, sd = 0.5),
  baseball_cubs = rnorm(335, mean = 3, sd = 0.5),
  baseball_sox = rnorm(335, mean = 3, sd = 0.5),
  hockey_bruins = rnorm(335, mean = 3, sd = 0.5),
  hockey_flames = rnorm(335, mean = 3, sd = 0.5),
  hockey_sharks = rnorm(335, mean = 3, sd = 0.5),
  hockey_preds = rnorm(335, mean = 3, sd = 0.5),
  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
           )
    ),
    column(5,
           pickerInput(
             inputId = "varsOfIntMinor", 
             label = "Add or Subtract Team",
             choices = unique(seriesData$team),
             width = "100%",
             options = pickerOptions(
               actionsBox = TRUE,
               deselectAllText = "Reset to Major Sport",
               size = 5
             ),
             choicesOpt = list(
               style = rep_len("font-size: 75%; line-height: 0.8;", length(unique(seriesData$team)))
             ),
             multiple = TRUE
           )
    ),
    column(1)

  ),
  sliderInput("daterange",
              "Date Range:",
              min = as.Date("2019-01-01","%Y-%m-%d"),
              max = as.Date(Sys.Date(), "%Y-%m-%d"),
              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,
                        "varsOfIntMinor",
                        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,
                       aes(x = value, pctile, 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)