Shiny ReactiveTriggers in observeEvent

shiny
1

Hello! Thanks in advance for everyone's help.

I've created a sample shiny app that summarizes my main problem. The real app is more complex. It contains multiple updateselectInput() functions that all work downstream to create multiple table and graph outputs. To get around the multiple selectInput()'s that trigger an update of multiple outputs, I've been using a combination of reactive-triggers and debounce().

My main problem is the reactive triggers are not recognized in the observeEvent. I can't seem to figure out a combination of reactive-trigger / debounce with reactive's to get this to work correctly. I've written the app as I would like it to work (and I believe the most readable). I realize with the current code there is a more straight forward way but with multiple updates and downstream proceses I keep hitting bottlenecks.

Here is how it should work.

Click Load: mt gets altered through fn.1() and saved as a reactiveValue rv$step1. This then triggers updateSelectInput() of the "car" input to have all choices added. Then fn.2() gets ran on rv$step1 to create rv$step2. rv$step2 then becomes the output$tbl table output.

On "car" selectInput edit: This should then should update rv$step2 which in turn updates output$tbl

library(shiny)
library(dplyr)

mt <- mtcars %>% tibble::rownames_to_column(var = "car") %>% select(car, mpg, cyl)
makeReactiveTrigger <- function() {
  rv <- reactiveValues(a = 0)
  list(
    depend = function() {
      rv$a
      invisible()
    },
    trigger = function() {
      rv$a <- isolate(rv$a + 1)
    }
  )
}

fn.1 <- function(mt){
  #Very computationaly expensive function
  return(mt)
}

fn.2 <- function(mt, car.selected){
  x <- mt %>% filter(car %in% car.selected) %>% group_by(cyl) %>% summarise(mpg.avg = mean(mpg))
  return(x)
}


ui <- fluidPage(
  selectizeInput("car", "car", choices = NULL , multiple = T),
  actionButton("load", "load"),
  tableOutput("tbl")
)

server <- function(input, output, session) {
  
  trg1 <- makeReactiveTrigger() #Create Reactive Trigger
  trg1_d <- trg1$depend %>% debounce(2000) #Create debounce Trigger
  
  trg2 <- makeReactiveTrigger()
  trg2_d <- trg2$depend %>% debounce(2000)
  
  rv <- reactiveValues(
    step1 = NULL,
    step2 = NULL
  )
  
  observeEvent(input$load,{
    #Update 25 inputs and options
    trg1$trigger()
    updateSelectInput(session, "car", choices = mt$car, selected = mt$car)
  })
  
  observeEvent(input$car,{
    trg2$trigger()
  })
  
  observeEvent(trg1_d(),{
    rv$step1 <- fn.1(mt)
    trg2$trigger()
  })
  
  observeEvent(trg2_d(), {
    rv$step2 <- fn.2(mt, input$car) 
  })
  
  output$tbl <- renderTable(rv$step2)
  
}

shinyApp(ui, server)
````
2

Okay, using an observe() works in this simple example.

Why doesn't it work with an observeEvent() ?

library(shiny)
library(dplyr)

mt <- mtcars %>% tibble::rownames_to_column(var = "car") %>% select(car, mpg, cyl)

makeReactiveTrigger <- function() {
  rv <- reactiveValues(a = 0)
  list(
    depend = function() {
      rv$a
      invisible()
    },
    trigger = function() {
      rv$a <- isolate(rv$a + 1)
    }
  )
}

fn.1 <- function(mt){
  #Very computationaly expensive function
  return(mt)
}

fn.2 <- function(mt, car.selected){
  x <- mt %>% filter(car %in% car.selected) %>% group_by(cyl) %>% mutate(mpg.avg = mpg)
  return(x)
}

ui <- fluidPage(
  selectizeInput("car", "car", choices = NULL , multiple = T),
  actionButton("load", "load"),
  tableOutput("tbl")
)

server <- function(input, output, session) {
  
  trg1 <- makeReactiveTrigger() #Create Reactive Trigger
  trg1_d <- trg1$depend %>% debounce(2000) #Create deboyunce Trigger
  
  trg2 <- makeReactiveTrigger()
  trg2_d <- trg2$depend %>% debounce(2000)
  
  rv <- reactiveValues(
    step1 = NULL,
    step2 = NULL
  )
  
  observeEvent(input$load,{
    #Update 25 inputs and options
    message("load ran")
    updateSelectInput(session, "car", choices = mt$car, selected = mt$car)
    trg1$trigger
  })
  
  observeEvent(trg1_d,{
    # browser()
    message("trg1_d ran")
    rv$step1 <- fn.1(mt)
    trg2$trigger()
  })
  
  observeEvent(input$car,{
    message("car ran")
    # browser()
    trg2$trigger()
  })
  
  observe({
    message("trg2 ran")
    trg2_d()
    # browser()
    rv$step2 <- fn.2(mt, isolate(input$car)) 
  })
  
  output$tbl <- renderTable(rv$step2)
  
}
3

Hi @jordanwebb10. In the first code, the observeEvent observe the trg2_d() which is just a function which didn't give out a reactive event, so it cannot trigger observeEvent function. You may change your makeReactiveTrigger$depend to a reactive which will give out a reactive expression, so the observeEvent can capture the change.

library(shiny)
library(dplyr)

mt <- mtcars %>% tibble::rownames_to_column(var = "car") %>% select(car, mpg, cyl)

makeReactiveTrigger <- function() {
  rv <- reactiveValues(a = 0)
  list(
    depend = reactive(rv$a),
    trigger = function() {
      rv$a <- isolate(rv$a + 1)
    }
  )
}

fn.1 <- function(mt){
  #Very computationaly expensive function
  return(mt)
}

fn.2 <- function(mt, car.selected){
  x <- mt %>% filter(car %in% car.selected) %>% group_by(cyl) %>% mutate(mpg.avg = mpg)
  return(x)
}

ui <- fluidPage(
  selectizeInput("car", "car", choices = NULL , multiple = T),
  actionButton("load", "load"),
  tableOutput("tbl")
)

server <- function(input, output, session) {
  
  trg1 <- makeReactiveTrigger() #Create Reactive Trigger
  trg1_d <- trg1$depend %>% debounce(2000) #Create deboyunce Trigger
  
  trg2 <- makeReactiveTrigger()
  trg2_d <- trg2$depend %>% debounce(2000)
  
  rv <- reactiveValues(
    step1 = NULL,
    step2 = NULL
  )
  
  observeEvent(input$load,{
    #Update 25 inputs and options
    message("load ran")
    updateSelectInput(session, "car", choices = mt$car, selected = mt$car)
    trg1$trigger
  })
  
  observeEvent(trg1_d,{
    # browser()
    message("trg1_d ran")
    rv$step1 <- fn.1(mt)
    trg2$trigger()
  })
  
  observeEvent(input$car,{
    message("car ran")
    # browser()
    trg2$trigger()
  })
  
  observeEvent(trg2_d(), {
    rv$step2 <- fn.2(mt, isolate(input$car)) 
  })
  
  output$tbl <- renderTable(rv$step2)
  
}

shinyApp(ui, server)
2 Likes
4

Everything is running smoothly now! Thanks.

5

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.