R Shiny 使用 updateCheckboxGroupInput() 和 selectinput() 缓存值

Question

我正在构建一个 Shiny 的应用程序，它根据 selectInput() 值更新 checkboxGroupInput() 。我还想存储选择/取消选择的值，以便每当我重新选择输入值时它们都会显示相同。为此，我使用 react 值来存储选择。

这是一个玩具示例:

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 的 react 速度和通信速度有关，但我不知道如何解决它。

注意:我还尝试为每个“字母”使用单独的条件面板，但这会大大增加我的应用程序的加载时间，因此我不想使用该策略。

Answer 1

这似乎是一个竞争条件，input$letter 的更新速度太快，shinyServer 无法跟上，并且它尝试使用不一致的数据更新 react 状态。例如，它尝试用“J”选项覆盖“I”单词，然后输入选择器不再起作用。我认为根本原因不容易解决。

但是，解决方法是仅在 input$letter 和 input$words_by_letter 中的值一致时更新您的 react 状态。

这可能有效，也可能无效，具体取决于您的实际数据 - 您需要组织数据，以便存在可以测试的一致性条件，并使用它来保护您的更新。在您的玩具示例中，我可以将所选的单词与您初始化选择所用的单词进行比较 - 我利用了这一点。

我本可以比较 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)

就其值(value)而言，该应用程序如下所示: