r - 定期禁用 updateSelectInput()

Question

我有一个应用程序，它有几个依赖的 selectInputs，所以如果你在第一个中选择一些东西，第二个应该更新为一个特定的值。这很好用。然而！现在我想对与更新逻辑不对应的两个选择强制进行特定组合，但是在我更新两个选择之后，第一个的更改会触发另一个的更新，我最终得到了错误的结果。同样在应用强制组合后，如果对第一个选择进行了新的更改，则应重新应用“旧”规则。

library(shiny)
ui <- fluidPage(

 selectInput("A_sel","select" ,c("A","B","C","D"),"A",FALSE)
,selectInput("B_sel","same"   ,c("A","B","C","D"),"A",FALSE)
,actionButton("ForceCombi","force C and D")
)

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

observeEvent(input$A_sel,{
updateSelectInput(session,"B_sel",selected = input$A_sel)
})

observeEvent(input$ForceCombi,{
updateSelectInput(session,"A_sel",selected = "C")
updateSelectInput(session,"B_sel",selected = "D")
})

}

shinyApp(ui, server)

编辑 - 计时器解决方案： 我为每个激活设置一个时间戳，看看哪个是最后一个被激活的，除非时间差小于一秒，那么我假设按下了激活选择的按钮。然后该反应的返回决定如何更新选择。有点小技巧：

library(shiny)
library(dplyr)

ui <- fluidPage(
   selectInput("A_sel","select",c("A","B","C","D"),"A",FALSE)
  ,selectInput("B_sel","same as above",c("A","B","C","D"),"A",FALSE)
  ,actionButton("A_to_B","force C and D")
)

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

  but <- eventReactive(input$A_to_B,{tibble(src = "but", time = Sys.time())})
  sel <- eventReactive(input$A_sel ,{tibble(src = "sel", time = Sys.time())})

  src <- eventReactive(c(input$A_to_B,input$A_sel),{
            df <- try(rbind(but(),sel()))

            if(typeof(df) == "character") return("sel")

            if(abs(difftime(df$time[1],df$time[2],units = "sec")) < 1) return("but")

            df %>% arrange(time) %>% pull(src) %>% last -> df
            return(df)
  })


  observe({
    src <- src()

    if(src == "sel") {
        updateSelectInput(session,"B_sel",selected = input$A_sel)
    } else if (src == "but") {
        updateSelectInput(session,"A_sel",selected = "C")
        updateSelectInput(session,"B_sel",selected = "D")
    }
})

}


shinyApp(ui, server)

标签： rshinyselectinput

Answer 1

这是您的时间戳想法的更简单实现。我已将阈值设置为 0.5 秒，但实际阈值只能在考虑应用程序中的其他反应性依赖项后才能确定。您还应该研究可能控制响应式执行顺序的priority参数observe和使用这些参数。observeEvent

话虽如此，我仍然觉得有更好的方法可以做到这一点。我认为看看?shiny::throttle也?shiny::debounce可以提供帮助。

library(shiny)
ui <- fluidPage(
  selectInput("A_sel","select", c("A","B","C","D"),"A",FALSE)
  ,selectInput("B_sel","same", c("A","B","C","D"),"A",FALSE)
  ,actionButton("ForceCombi", "force C and D")
)

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

  tstamp <- reactiveValues(t = Sys.time())

  observeEvent(input$A_sel, {
    req((Sys.time() - tstamp$t) > 0.5)
    tstamp$t <- Sys.time()
    updateSelectInput(session,"B_sel", selected = input$A_sel)
  })

  observeEvent(input$ForceCombi, {
    updateSelectInput(session,"A_sel", selected = "C")
    updateSelectInput(session,"B_sel", selected = "D")
    tstamp$t <- Sys.time()
  })
}

shinyApp(ui, server)