Periodcally disable updateSelectInput()

Question

I have an app that has a few dependent selectInputs, so if you choose something in the first, the second should update to a specific value. That works fine. However! Now I want to force a specific combination on the two selects that do not correspond to the update logic, but after I update the two selects, the change of the first triggers an update of the other and I end up with the wrong result. Also after the forced combination has been applied, if a new change to the first select is done, then the "old" rule should reapply.

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)

EDIT - Timer solution: I set a timestamp to each activation and see which was the last to be activated, except if the time difference is less than a sec then I assume that the button was pressed which activated the select. Then the return from that reactive is decides how to update the selects. A bit of a hack:

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)

You can create a reactive variable that serves as indicator and only update it on that specific event. Then create an observe statement that will check that reacitve variable and swicth ur select inputs accordingly. — JacobJacox, Nov 14 '18 at 12:37
I was also thinking something in that direction, but how the make that switch? If I could make a reactive that could tell which of the two (button and select) that was activated last but still not double trigger on the button. — mtcarsalot, Nov 15 '18 at 07:12

Shree · Accepted Answer · 2018-11-16T18:58:52.970

Here's a simpler implementation of your timestamp idea. I have set the threshold to 0.5 seconds but actual threshold can only be determined after considering other reactive dependencies in the app. You should also look into the priority arguments of observe and observeEvent using which you could potentially control the execution sequence of reactives.

Having said that, I still have a feeling that there is a better way to do this. I think looking at ?shiny::throttle and ?shiny::debounce could help as well.

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)

Periodcally disable updateSelectInput()

1 Answers1