定期禁用 updateSelectInput()

Question

我有一个应用程序有一些依赖 select 输入，所以如果您在第一个中选择某些内容，第二个应该更新为特定值。那很好用。然而！现在我想对不符合更新逻辑的两个select强制进行特定组合，但是我更新两个select之后，第一个的变化触发了另一个的更新我最终得到了错误的结果。此外，在应用强制组合后，如果对第一个 select 进行了新更改，则应重新应用 "old" 规则。

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)

编辑 - 计时器解决方案： 我为每次激活设置一个时间戳，看看哪个是最后激活的，除非时间差小于一秒，然后我假设按下了激活 select 的按钮。然后来自那个反应的 return 决定如何更新 selects。有点黑客：

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)

Answer 1

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

话虽如此，我仍然觉得有更好的方法来做到这一点。我认为查看 ?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)

定期禁用 updateSelectInput()

Periodcally disable updateSelectInput()

r

shiny

selectinput