闪亮，observeEvent，updateSelectInput，输入重置

Posted 2023-03-24

【中文标题】闪亮，observeEvent，updateSelectInput，输入重置

【英文标题】：Shiny, observeEvent, updateSelectInput, inputs resetting

【发布时间】：2020-05-24 02:27:10

【问题描述】：

在选择输入选项时，所有内容都会正确返回。但是，如果我在选择所有过滤器后更改了前一个过滤器，它会重置下一个输入。这是example的gif

在您观看 gif 之后，我会返回上一个输入来更改它的最后一部分，然后重置下一个。那是我不希望发生的事情。

这是我正在使用的一些基本示例代码，您可以复制它：

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)

【参考方案1】：

首先，这是一个简化的问题示例：

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)

我们可以通过使用reactiveVal 来存储已经做出的选择，并将reactiveVal 的内容传递给update*input 的selected 参数，从而获得不可重置的值。下面是具有两个输入的更简单案例的概念证明：

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)