闪亮，observeEvent，updateSelectInput，输入重置
Shiny, observeEvent, updateSelectInput, inputs resetting
选择输入选项时，所有内容均已正确返回。但是，如果我在选择所有过滤器后更改了前一个过滤器，它会重置下一个输入。这是 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)
首先，这是问题的简化示例：
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的内容传递给[=15=的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)
选择输入选项时，所有内容均已正确返回。但是，如果我在选择所有过滤器后更改了前一个过滤器，它会重置下一个输入。这是 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)
首先，这是问题的简化示例：
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的内容传递给[=15=的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)