Search code examples
rinputshinyshinydashboardselectinput

Shiny, observeEvent, updateSelectInput, inputs resetting

While selecting the input options everything is properly returned. However, if I change a previous filter after selecting all the filters, It resets the next input. Here is a gif as an example

After you watch the gif, the last part of it I go back to a previous input to change it, and the next one resets. That is what I don't want happening.

Here is some basic sample code I am using so you can reproduce it:

library(shinyWidgets)
library(shiny)
library(tidyverse)
teamname<-sample(c('Gig/Gog', 'Walsh/Sweat', 'Klineman/Ross', 'Lucena/Dalhausser', 'Bourne/Crabb', 'Gibb/Crabb', 'R/Python', 'Fendrick/Hughes', 'Tyler/Corley', 'David/Russ'), 50000, replace=T)
opponent<-sample(c('UKR', 'LAT', 'NOR', 'FIN', 'FRA', 'USA', 'CAN', 'RUS', 'SUI', 'GER', 'BRA', 'ARG', 'CHI', 'CHN', 'JPN', 'TAI', 'BEL'), 50000, replace = T)
name<-sample(c('CB', 'TW'), 50000, replace = T)
block<-sample(c('line', 'angle', 'peel'), 50000, replace = T)
np<-sample(c(1:5), 50000, replace = T)
fbso_rec_details<-sample(c('right', 'left', 'low', 'middle'), 50000, replace = T)
details <- sample(c('shot', 'hard', 'pokey'), 50000, replace = T)
tourn_info <- sample(c('HAG 4* Aye/Gauthier-Rat FRA vs A. Mirzaali/Raoufi R. IRI [2-0] Round 2Q',
                       'HAG 4* Bello/Bello, J. ENG vs A. Mirzaali/Raoufi R. IRI [0-2] Round 1Q',
                       'HAM WC A.Vakili/Salemi B. IRI vs Lupo/Nicolai ITA [1-2] Round of 32',
                       'HAM WC Bourne/Crabb Tr. USA vs A.Vakili/Salemi B. IRI [2-1] Pool L',
                       'HAM WC A.Vakili/Salemi B. IRI vs Kavalo/Ntagengwa RWA [2-0] Pool L',
                       'HAG 4* Juchnevic/Vasiljev LTU vs A.Vakili/Salemi B. IRI [2-0] Round 1Q',
                       'HAM WC Thole, J./Wickler GER vs A.Vakili/Salemi B. IRI [2-0] Pool L',
                       'HAG 4* Abbiati/Andreatta, T. ITA vs Sekerci/Urlu TUR [2-1] Round 2Q',
                       'JIN 4* Berntsen/Mol, H. NOR vs Abbiati/Andreatta, T. ITA [2-1] Pool D',
                       'ESP 4* Abbiati/Andreatta, T. ITA vs Durant/Schumann AUS [2-0] Pool F',
                       'VIE 5* Abbiati/Andreatta, T. ITA vs Erdmann/Winter GER [1-2] Round 1',
                       'ESP 4* Grimalt E./Grimalt M. CHI vs Abbiati/Andreatta, T. ITA [2-0] Round 1',
                       'CEV CEV Bryl/Fijalek POL vs Abbiati/Andreatta, T. ITA [2-1] Pool D',
                       'SYD 3* Doherty/Hyden USA vs Abbiati/Andreatta, T. ITA [2-1] Round 2',
                       'ROM WTF P. Gao/Y. Li CHN vs Abbiati/Andreatta, T. ITA [2-1] Round 1',
                       'CEV CEV Liamin/Myskiv RUS vs Abbiati/Andreatta, T. ITA [2-1] Pool D',
                       'SYD 3* Abbiati/Andreatta, T. ITA vs Basta/Kolaric SRB [2-0] Round 1',
                       'HAG 4* alvaro Filho/Ricardo BRA vs Abbiati/Andreatta, T. ITA [0-2] Pool F',
                       'CEV CEV Abbiati/Andreatta, T. ITA vs Giginoglu/Gogtepe V. TUR [1-2] Pool D',
                       'SYD 3* Kazdailis/Rumsevicius LTU vs Abbiati/Andreatta, T. ITA [2-1] Pool F',
                       'SYD 3* Abbiati/Andreatta, T. ITA vs J. Surin/P. Sedtawat THA [2-1] Pool F',
                       'HAG 4* Krasilnikov/Stoyanovskiy RUS vs Abbiati/Andreatta, T. ITA [2-0] Pool F',
                       'HAG 4* Abbiati/Andreatta, T. ITA vs Aye/Gauthier-Rat FRA [1-2] Round 1',
                       'JIN 4* Liamin/Myskiv RUS vs Abbiati/Andreatta, T. ITA [2-0] Pool D',
                       'GST 5* Abbiati/Andreatta, T. ITA vs Erdmann/Winter GER [0-2] Round 1',
                       'HAG 4* Abell/Thomsen DEN vs Barthelemy/Loiseau FRA [0-2] Round 1Q'), 50000, replace = T)
st <- data.frame(teamname, opponent, name, block, np, fbso_rec_details, details, tourn_info)
st$teamname <- as.character(st$teamname)
st$opponent <- as.character(st$opponent)
st$name <- as.character(st$name)
st$block <- as.character(st$block)
st$fbso_rec_details <- as.character(st$fbso_rec_details)
st$details <- as.character(st$details)
st$np <- as.integer(st$np)
st$tourn_info <- as.character(st$tourn_info)


ui <- fluidPage(
  titlePanel("Dashboard"),
  sidebarLayout(
    sidebarPanel(
      selectizeInput("Select1","Team",unique(st$teamname)),
      pickerInput("Select2","Opponent", choices=NULL, options = list('actions-box' = T, size = 12), multiple = T),
      selectizeInput("Select3","Player",choices = NULL),
      pickerInput("Select5","Block",choices=NULL, options = list('actions-box' = T, size = 12), multiple = T),
      pickerInput("Select6","NP",choices=NULL, options = list('actions-box' = T, size = 12), multiple = T),
      pickerInput("Select7","Reception type",choices=NULL, options = list('actions-box' = T, size = 12), multiple = T),
      pickerInput("Select8","Attack type",choices=NULL, options = list('actions-box' = T, size = 12), multiple = T)), mainPanel()))

server <- function(input, output, session) {

  observeEvent(input$Select1,{
    updatePickerInput(session,'Select2',choices=unique(sort(
      st$tourn_info[st$teamname==input$Select1])))}) 

  observeEvent(input$Select2,{
    updateSelectInput(session,'Select3',choices=unique(sort(
      st$name[st$teamname==input$Select1 & st$tourn_info %in% input$Select2])))}) 

  observeEvent(input$Select3,{
    updatePickerInput(session,'Select5',choices=unique(sort(
      st$block[st$teamname==input$Select1 & st$tourn_info %in% input$Select2 & st$name == input$Select3])))})

  observeEvent(input$Select5,{
    updatePickerInput(session,'Select6',choices=unique(sort(
      st$np[st$teamname==input$Select1 & st$tourn_info %in% input$Select2 & st$name == input$Select3  & st$block %in% input$Select5])))})

  observeEvent(input$Select6,{
    updatePickerInput(session,'Select7',choices=unique(sort(
      st$fbso_rec_details[st$teamname==input$Select1 & st$tourn_info %in% input$Select2 & st$name == input$Select3 & st$block %in% input$Select5 & st$np %in% input$Select6])))})

  observeEvent(input$Select7,{
    updatePickerInput(session,'Select8',choices=unique(sort(
      st$details[st$teamname==input$Select1 & st$tourn_info %in% input$Select2 & st$name == input$Select3  & st$block %in% input$Select5 & st$np %in% input$Select6 & st$fbso_rec_details %in% input$Select7])))})
}
  shinyApp(ui, server)
Solution

  • First, this is a simplified example of the issue:

    library(shiny)

dd <- data.frame(in1=rep(LETTERS[1:3], 2), in2=letters[1:6])

ui <- basicPage(
    selectInput(
        inputId = "in1",
        label = "in1",
        choices = unique(dd$in1), 
        multiple = TRUE
    ),
    selectInput(
        inputId = "in2",
        label = "in2",
        choices = unique(dd$in2),
        multiple = TRUE
    )
)

server <- function(input, output, session) {

    observeEvent(input$in1, {
        updateSelectInput(
            session = session,
            inputId = "in2",
            label = "updated in2",
            choices = dd[dd$in1 %in% input$in1, "in2"]
        )
    }
    )
}

shinyApp(ui, server)

    We can get not-resetting values by using reactiveVal to store the selections already made, and pass the contents of the reactiveVal to the selected argument of update*input. A proof of concept with a simpler case with two inputs is below:

    library(shiny)

dd <- data.frame("in1"=rep(LETTERS[1:3], 2), "in2"=letters[1:6], stringsAsFactors = FALSE)

ui <- basicPage(
    selectInput(
        inputId = "in1",
        label = "in1",
        choices = unique(dd$in1), 
        multiple = TRUE
    ),
    selectInput(
        inputId = "in2",
        label = "in2",
        choices = unique(dd$in2),
        multiple = TRUE
    )
)

server <- function(input, output, session) {

    current_in2 <- reactiveVal()

    observe({
        current_in2(input$in2)  
    })

    # as normal except notice that
    # `current_in2()` sets the pre-selected choices 
    observeEvent(eventExpr = input$in1,
                 handlerExpr = {
                     updateSelectInput(
                         session = session,
                         inputId = "in2",
                         label = "in2",
                         # keep what we had before
                         selected = current_in2(),
                         choices = dd[dd$in1 %in% input$in1, "in2"]
                     )
                 })
}

shinyApp(ui, server)

    gif