Managing reactively created observers

I am looking for a way to manage (create, delete) observers in a shiny app. The idea is to create x numbers of buttons, where x is dependent on a reactive input (the number of buttons needed can change). Each button gets an observer, because each button should execute the same function but with different input parameters. Now creating the buttons and the observers works perfectly fine, I am not able to manage the old observers, when the new ones are created (delete them). The consequence is that old observers start piling up and cluttering the app. My attempt to store them in a list and destroy them every time the reactive input changes does not work however...
Here is an example. You can check the number of active observers via reactlog (ctrl+f3)

options(shiny.reactlog = TRUE)

library(shiny)
library(reactlog)
library(shinydashboard)
library(rlist)
o <- list()  

ui <- dashboardPage(
  dashboardHeader(title = "test"),
  dashboardSidebar(),
    
  dashboardBody(
    uiOutput("def"),
    uiOutput("def2")
  )
)

server <- function(input, output, session) {
  
  output$def <- renderUI({
    fluidPage(fluidRow(
      numericInput("numberOfButtons", "provide number of buttons", value = 10, min = 1, max = 1000)
    ))
  })

  output$def2 <- renderUI({
    req(input$numberOfButtons > 0)
    fluidPage(fluidRow(
      lapply(1:input$numberOfButtons, function(x){
        actionButton(inputId = paste0("button_", x), label = paste0("button_", x))  
      })  
    ))
  })

  observe({
    req(input$numberOfButtons > 0)
    lapply(o, function(x){x$destroy()})
    inputBtn <- paste0("button_", 1:input$numberOfButtons)
    lapply(inputBtn, function(x){
      list.append(o, observeEvent(input[[x]],{
        showModal(modalDialog(
          title = as.character(x),
          paste(x,"!"),
          easyClose = TRUE
        ))
      })
      )
    })
  })
}

shinyApp(ui, server)

I am not sure whether it will work for your general case, but here is a solution for the example you have provided. It uses the property of an actionButton whose value is initially zero, and increments by one each time it is pressed. It maintains the state of how many times each button has been pressed, and resets the state if a button is added or deleted. By looking at the difference of the current and previous state, it figures out which button has been pressed and displays the modal dialog appropriately. No observers are created.

options(shiny.reactlog = TRUE)

library(shiny)
library(reactlog)
library(shinydashboard)
library(rlist)
o <- list()  

ui <- dashboardPage(
  dashboardHeader(title = "test"),
  dashboardSidebar(),
  
  dashboardBody(
    uiOutput("def"),
    uiOutput("def2")
  )
)

server <- function(input, output, session) {
  
  curr_state <- reactiveVal()
  
  output$def <- renderUI({
    fluidPage(fluidRow(
      numericInput("numberOfButtons", "provide number of buttons", value = 10, min = 1, max = 1000)
    ))
  })
  
  output$def2 <- renderUI({
    req(input$numberOfButtons > 0)
    fluidPage(fluidRow(
      lapply(1:input$numberOfButtons, function(x){
        actionButton(inputId = paste0("button_", x), label = paste0("button_", x))  
      })  
    ))
  })
  
  num_press <- reactive({
    req(input$numberOfButtons > 0)
    purrr::reduce(purrr::map(1:input$numberOfButtons, ~ input[[paste0("button_", .x)]]), c)
  })
  
  observe({
    req(input$numberOfButtons > 0)
    cs <- isolate(curr_state())
    ns <- num_press()
    if (all(ns == 0) || (length(ns) < length(cs))) {
      curr_state(ns)
      return(NULL)
    }
    ds <- ns - cs
    b <- which(ds == 1)
    if (length(b) == 0) {
      return(NULL)
    }
    showModal(modalDialog(
      title = as.character(paste0("Button ", b)),
      paste0("Button ", b, "!"),
      easyClose = TRUE
    ))
    curr_state(ns)
  })
}

shinyApp(ui, server)
1 Like

I think that would work in my case, thank you! I am still leaving this thread open though because i would be interested in solution using the multiple observers. In this thread Joe Cheng indicated that this is in theory possible (https://groups.google.com/forum/#!msg/shiny-discuss/VMtWeH--d3o/EDyobdjuAQAJ)

Hi @viciously. Your code problem is due to the o is not a reactive valuable. So, you may change your code like this.

options(shiny.reactlog = TRUE)

library(shiny)
library(reactlog)
library(shinydashboard)
library(rlist)

ui <- dashboardPage(
  dashboardHeader(title = "test"),
  dashboardSidebar(),
  
  dashboardBody(
    uiOutput("def"),
    uiOutput("def2")
  )
)

server <- function(input, output, session) {
  o <- reactiveVal(list())
  
  output$def <- renderUI({
    fluidPage(fluidRow(
      numericInput("numberOfButtons", "provide number of buttons", value = 10, min = 1, max = 1000)
    ))
  })
  
  output$def2 <- renderUI({
    req(input$numberOfButtons > 0)
    fluidPage(fluidRow(
      lapply(1:input$numberOfButtons, function(x){
        actionButton(inputId = paste0("button_", x), label = paste0("button_", x))  
      })  
    ))
  })
  
  observe({
    req(input$numberOfButtons > 0)
    isolate({
      lapply(o(), function(x){x$destroy()})
      inputBtn <- paste0("button_", 1:input$numberOfButtons)
      o(lapply(inputBtn, function(x){
        observeEvent(input[[x]],{
          showModal(modalDialog(
            title = as.character(x),
            paste(x,"!"),
            easyClose = TRUE
          ))
        })
      }))
    })
  })
}

shinyApp(ui, server)

But if your question is to completely destroy the observer and it seems the destroy function didn't help. The destroy function just to stop the observer from being triggered again by the reactive. You can test it by adding the following code and increase the numberOfButtons over 10 to destroy the a observer, but it still exists in the reactlog just cannot trigger by reactive anymore.

  a <- observeEvent(input$numberOfButtons,{
    if(input$numberOfButtons <= 10) {
      cat("Test", file = stderr())
    } else {
      a$destroy()
    }
  })

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