R 闪亮缓存值与 updateCheckboxGroupInput() 和 selectinput()
R Shiny caching values with updateCheckboxGroupInput() and selectinput()
我正在构建一个闪亮的应用程序,它根据 selectInput() 值更新 checkboxGroupInput() 。我还想存储 selected/de-selected 的值,以便在我重新 select 输入值时它们将显示相同。为此,我使用反应值来存储 select 离子。
这是一个玩具示例:
library(shiny)
letters = c('A','B','C','D','E','F','G','H','I','J','K','L')
words = list( "A" = c("apples","aardvark","alabama"),
"B" = c("banana","baltimore","beehive"),
"C" = c("catastrophe","cantalope"),
"D" = c("dinosaur","dairy","dolphin"),
"E" = c("eager","elephant","ecumenical"),
"F" = c("fleming","florida","flight"),
"G" = c("gator","greater","gait"),
"H" = c("HI"),
"I" = c("igloo","ignominious","interesting"),
"J" = c("jogging","jumpsuit"),
"K" = c("kellog","kangaroo"),
"L" = c("lemon","lime","lemonjello"))
ui <- fluidPage(
selectInput("letter","Choose Letter",choices=letters,selectize=F),
# Initiate check box group
checkboxGroupInput('words_by_letter',label='Select Your Favorite Words',choices = c(1))
)
server <- function(input, output, session) {
v_selected <- reactiveValues(
"A" = c("apples","aardvark","alabama"),
"B" = c("banana","baltimore","beehive"),
"C" = c("catastrophe","cantalope"),
"D" = c("dinosaur","dairy","dolphin"),
"E" = c("eager","elephant","ecumenical"),
"F" = c("fleming","florida","flight"),
"G" = c("gator","greater","gait"),
"H" = c("HI"),
"I" = c("igloo","ignominious","interesting"),
"J" = c("jogging","jumpsuit"),
"K" = c("kellog","kangaroo"),
"L" = c("lemon","lime","lemonjello"))
observeEvent(input$letter,{
updateCheckboxGroupInput(session,
inputId = "words_by_letter",
choices = words[[input$letter]],
selected = v_selected[[input$letter]])
})
observeEvent(input$words_by_letter,{
v_selected[[input$letter]] = input$words_by_letter
})
}
shinyApp(ui = ui, server = server)
在大多数情况下,这工作正常。但是,如果您快速滚动输入(通过按住箭头按钮),最终一些复选框组将全部取消选中。我假设这与 Javascript 的反应速度和通信速度有关,但我不知道如何解决它。
注意:我也尝试过为每个 'letter' 使用单独的条件面板,但这会大大增加我的应用程序的加载时间,所以我更喜欢不要使用该策略。
这似乎是一个竞争条件,input$letter
更新得太快以至于 shinyServer 无法跟上,它试图用不一致的数据更新反应状态。例如,它尝试用 "J" 选项覆盖 "I" 单词,然后输入选择器不再工作。我认为根本原因不容易解决。
然而,解决方法是仅在 input$letter
和 input$words_by_letter
中的值一致时才更新您的反应状态。
这可能有效,也可能无效,具体取决于您的实际数据 - 您需要组织数据,以便存在可以测试的一致性条件,并使用它来保护您的更新。在你这里的玩具示例中,我可以将选择的单词与你初始化选择的单词进行比较 - 我利用了它。
我本可以使用比较 input$words_by_letter
匹配 input$letter
中单词的第一个字母,但这似乎太专业了 - 这样,将所选数据与选择初始化进行比较更有可能概括。
代码如下:
library(shiny)
letters = c('A','B','C','D','E','F','G','H','I','J','K','L')
words = list( "A" = c("apples","aardvark","alabama"),
"B" = c("banana","baltimore","beehive"),
"C" = c("catastrophe","cantalope"),
"D" = c("dinosaur","dairy","dolphin"),
"E" = c("eager","elephant","ecumenical"),
"F" = c("fleming","florida","flight"),
"G" = c("gator","greater","gait"),
"H" = c("HI"),
"I" = c("igloo","ignominious","interesting"),
"J" = c("jogging","jumpsuit"),
"K" = c("kellog","kangaroo"),
"L" = c("lemon","lime","lemonjello"))
ui <- fluidPage(
selectInput("letter","Choose Letter",choices=letters,selectize=F),
# Initiate check box group
checkboxGroupInput('words_by_letter',label='Select Your Favorite Words',choices = c(1))
)
server <- function(input, output, session) {
v_selected <- reactiveValues(
"A" = c("apples","aardvark","alabama"),
"B" = c("banana","baltimore","beehive"),
"C" = c("catastrophe","cantalope"),
"D" = c("dinosaur","dairy","dolphin"),
"E" = c("eager","elephant","ecumenical"),
"F" = c("fleming","florida","flight"),
"G" = c("gator","greater","gait"),
"H" = c("HI"),
"I" = c("igloo","ignominious","interesting"),
"J" = c("jogging","jumpsuit"),
"K" = c("kellog","kangaroo"),
"L" = c("lemon","lime","lemonjello"))
observeEvent(input$letter,{
v_selected$last <- input$letter
updateCheckboxGroupInput(session,
inputId = "words_by_letter",
choices = words[[input$letter]],
selected = v_selected[[input$letter]])
})
overwriteIfConsistent <- function(selector,newvals,initwords){
# only overwrite if the new values are int the initial list
initwords1 <- initwords[[selector]]
truthvek <- newvals %in% initwords1 # are the newvals in this list?
if (sum(truthvek)==length(newvals)){ # need them all to be true
v_selected[[selector]] = newvals # ok, then overwrite
}
}
observeEvent(input$words_by_letter,{
overwriteIfConsistent(input$letter,input$words_by_letter,words)
})
}
shinyApp(ui = ui, server = server)
对于它的价值,这就是应用程序的外观:
我正在构建一个闪亮的应用程序,它根据 selectInput() 值更新 checkboxGroupInput() 。我还想存储 selected/de-selected 的值,以便在我重新 select 输入值时它们将显示相同。为此,我使用反应值来存储 select 离子。
这是一个玩具示例:
library(shiny)
letters = c('A','B','C','D','E','F','G','H','I','J','K','L')
words = list( "A" = c("apples","aardvark","alabama"),
"B" = c("banana","baltimore","beehive"),
"C" = c("catastrophe","cantalope"),
"D" = c("dinosaur","dairy","dolphin"),
"E" = c("eager","elephant","ecumenical"),
"F" = c("fleming","florida","flight"),
"G" = c("gator","greater","gait"),
"H" = c("HI"),
"I" = c("igloo","ignominious","interesting"),
"J" = c("jogging","jumpsuit"),
"K" = c("kellog","kangaroo"),
"L" = c("lemon","lime","lemonjello"))
ui <- fluidPage(
selectInput("letter","Choose Letter",choices=letters,selectize=F),
# Initiate check box group
checkboxGroupInput('words_by_letter',label='Select Your Favorite Words',choices = c(1))
)
server <- function(input, output, session) {
v_selected <- reactiveValues(
"A" = c("apples","aardvark","alabama"),
"B" = c("banana","baltimore","beehive"),
"C" = c("catastrophe","cantalope"),
"D" = c("dinosaur","dairy","dolphin"),
"E" = c("eager","elephant","ecumenical"),
"F" = c("fleming","florida","flight"),
"G" = c("gator","greater","gait"),
"H" = c("HI"),
"I" = c("igloo","ignominious","interesting"),
"J" = c("jogging","jumpsuit"),
"K" = c("kellog","kangaroo"),
"L" = c("lemon","lime","lemonjello"))
observeEvent(input$letter,{
updateCheckboxGroupInput(session,
inputId = "words_by_letter",
choices = words[[input$letter]],
selected = v_selected[[input$letter]])
})
observeEvent(input$words_by_letter,{
v_selected[[input$letter]] = input$words_by_letter
})
}
shinyApp(ui = ui, server = server)
在大多数情况下,这工作正常。但是,如果您快速滚动输入(通过按住箭头按钮),最终一些复选框组将全部取消选中。我假设这与 Javascript 的反应速度和通信速度有关,但我不知道如何解决它。
注意:我也尝试过为每个 'letter' 使用单独的条件面板,但这会大大增加我的应用程序的加载时间,所以我更喜欢不要使用该策略。
这似乎是一个竞争条件,input$letter
更新得太快以至于 shinyServer 无法跟上,它试图用不一致的数据更新反应状态。例如,它尝试用 "J" 选项覆盖 "I" 单词,然后输入选择器不再工作。我认为根本原因不容易解决。
然而,解决方法是仅在 input$letter
和 input$words_by_letter
中的值一致时才更新您的反应状态。
这可能有效,也可能无效,具体取决于您的实际数据 - 您需要组织数据,以便存在可以测试的一致性条件,并使用它来保护您的更新。在你这里的玩具示例中,我可以将选择的单词与你初始化选择的单词进行比较 - 我利用了它。
我本可以使用比较 input$words_by_letter
匹配 input$letter
中单词的第一个字母,但这似乎太专业了 - 这样,将所选数据与选择初始化进行比较更有可能概括。
代码如下:
library(shiny)
letters = c('A','B','C','D','E','F','G','H','I','J','K','L')
words = list( "A" = c("apples","aardvark","alabama"),
"B" = c("banana","baltimore","beehive"),
"C" = c("catastrophe","cantalope"),
"D" = c("dinosaur","dairy","dolphin"),
"E" = c("eager","elephant","ecumenical"),
"F" = c("fleming","florida","flight"),
"G" = c("gator","greater","gait"),
"H" = c("HI"),
"I" = c("igloo","ignominious","interesting"),
"J" = c("jogging","jumpsuit"),
"K" = c("kellog","kangaroo"),
"L" = c("lemon","lime","lemonjello"))
ui <- fluidPage(
selectInput("letter","Choose Letter",choices=letters,selectize=F),
# Initiate check box group
checkboxGroupInput('words_by_letter',label='Select Your Favorite Words',choices = c(1))
)
server <- function(input, output, session) {
v_selected <- reactiveValues(
"A" = c("apples","aardvark","alabama"),
"B" = c("banana","baltimore","beehive"),
"C" = c("catastrophe","cantalope"),
"D" = c("dinosaur","dairy","dolphin"),
"E" = c("eager","elephant","ecumenical"),
"F" = c("fleming","florida","flight"),
"G" = c("gator","greater","gait"),
"H" = c("HI"),
"I" = c("igloo","ignominious","interesting"),
"J" = c("jogging","jumpsuit"),
"K" = c("kellog","kangaroo"),
"L" = c("lemon","lime","lemonjello"))
observeEvent(input$letter,{
v_selected$last <- input$letter
updateCheckboxGroupInput(session,
inputId = "words_by_letter",
choices = words[[input$letter]],
selected = v_selected[[input$letter]])
})
overwriteIfConsistent <- function(selector,newvals,initwords){
# only overwrite if the new values are int the initial list
initwords1 <- initwords[[selector]]
truthvek <- newvals %in% initwords1 # are the newvals in this list?
if (sum(truthvek)==length(newvals)){ # need them all to be true
v_selected[[selector]] = newvals # ok, then overwrite
}
}
observeEvent(input$words_by_letter,{
overwriteIfConsistent(input$letter,input$words_by_letter,words)
})
}
shinyApp(ui = ui, server = server)
对于它的价值,这就是应用程序的外观: