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)

Answer 1

这是您的时间戳记想法的简单实现。我已将阈值设置为0.5秒，但只有在考虑了应用程序中的其他反应性依赖关系之后才能确定实际阈值。您还应该研究priority和observe的{{1}}自变量，使用它们可以潜在地控制反应堆的执行顺序。

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

?shiny::debounce

Answer 2

希望我能正确理解您的问题；

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) {
  ind <- reactiveValues(ind=data.frame(A=0,B=0))

  observeEvent(input$A_sel,{
    ind$ind$A <- 0
  })

  observeEvent(input$B_sel,{

    ind$ind$B <- 0
  })

  observeEvent(input$ForceCombi,{
    ind$ind$A <- 1
    ind$ind$B <- 1
  })

  observe({
    if(ind$ind$A + ind$ind$B==2){
      ind$ind$A <- 0
      ind$ind$B <- 0
      updateSelectInput(session,"A_sel",selected = "C")
      updateSelectInput(session,"B_sel",selected = "D")
    }
  })
}

shinyApp(ui, server)

定期禁用updateSelectInput（）

2 个答案: