CODEWITHSUNDEEP
rshinyselectinput
mtcarsalot
mtcarsalot

Reputation: 321

Periodcally disable updateSelectInput()

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)

Upvotes: 2

Views: 249

Answers (1)

Shree
Shree

Reputation: 11140

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)

Upvotes: 1

Related Questions