Proposal: reactive subDomains

[wch]

Normally if an observer is created in a reactive or observer, it will stay around forever, and keep responding to its inputs. In this example, each time the foo button is clicked, it'll create a new observer that listens to the bar button. After pressing the foo button a couple times, pressing the bar button will cause multiple lines to be printed out. In many cases, this is undesirable behavior:

server <- function(input, output) {
  observe({
    foo <- input$foo

    observe({
      print(paste0("foo was: ", foo, ". bar: ", input$bar))
    })
  })
}

ui <- basicPage(
  actionButton("foo", "foo"),
  actionButton("bar", "bar")
)

shinyApp(ui, server)

One way to solve this problem right now is to create a mock domain and end it each time the outer observer is called:

server <- function(input, output) {
  domain <- shiny:::createMockDomain()

  observe({
    domain$end()
    domain <<- shiny:::createMockDomain()
    foo <- input$foo

    withReactiveDomain(domain,
      observe({
        print(paste0("foo was: ", foo, ". bar: ", input$bar))
      })
    )
  })
}

ui <- basicPage(
  actionButton("foo", "foo"),
  actionButton("bar", "bar")
)

shinyApp(ui, server)

Right now, this is kind of a hack, and uses an unexported function.

It would be nice to instead have a function like createSubDomain(). The resulting subdomain object would get values like $clientData from the parent domain object. Also, on creation, it would register its $end() method with the $onEnd() on the parent, so that the subdomain ends when the parent ends.

It might also be nice to simply add an option to observe and reactive that tells Shiny that the code inside should be run in a subdomain.

[tsmith64]

I'm running into this exact issue while trying to dynamically call modules from within an observer. If the module is called multiple times, it creates multiple observers and reactives in the background. Is there a quick solution to this?

[tsmith64]

My current approach in handling this is the following:

library(shiny)

#Module
tabUI <- function(id) {
  ns <- NS(id)
  tagList(
    actionButton(ns('clickThis'),'Click this!'),
    textOutput(ns('text'))
  )
}

tabServer <- function(input, output, session, active){
  numClicks <- 0

  #Sample reactive with dependence on active()
  a <- reactive({
    input$clickThis
    if (!active()) {return(NULL)}
    numClicks <<- numClicks+1
    return(numClicks)
  })

  #Sample observer
  b <- observeEvent(input$clickThis,{print('b')})

  #Destroy observers when inactive
  c <- observeEvent(active(),{
    if(!active()) {
      b$destroy()
      c$destroy()
    }
  })

  output$text <- renderText({a()})
}

#UI function
ui <- fluidPage(
  actionButton('addTabButton','Add'),
  actionButton('removeTabButton','Remove'),
  tabsetPanel(id='tabset')
)

#server
server <- function(input, output, session){
  values <- reactiveValues()
  values$numTabs <- 0

  observeEvent(input$addTabButton, {
    values$numTabs <- values$numTabs + 1
    tabNum <- values$numTabs
    newName <- paste0('Tab',tabNum)
    tabUI <- tabPanel(tabUI(newName), title = newName) 

    appendTab('tabset', tabUI, select = TRUE)
    callModule(module = tabServer, id = newName, active=reactive(tabNum<=values$numTabs))
  })

  observeEvent(input$removeTabButton, {
    numTabs <- values$numTabs
    values$numTabs <- numTabs-1
    removeTab('tabset', paste0('Tab',numTabs))
  })
}

shinyApp(ui = ui, server = server)

The app populates versions of the module as "addTabButton" is clicked and removes them when "removeTabButton" is pressed. The "active" flag is reactive and is TRUE for tabs with a number below the current count. When the remove button is pressed, the last tab is removed from the UI, destroying outputs, and the observers are destroyed. The active flag also invalidates the reactive and clears its cached values from memory until the next time it is called (never). This leaves a floating reactive with no value or a NULL value somewhere in memory.

My question is: Is this a valid way of handling this issue?

[jcheng5]

Sure, this should work. What would be a problem is if you could remove arbitrary tabs, not just the last one. In that case, what I'd do is have the tabServer function return an anonymous function that destroys b and c (and, while we're at it, assigns NULL to output$text). Then keep a list of these functions around, invoking and removing them when the corresponding tab is removed.

tabServer <- function(input, output, session) {
  # ...

  return(function() {
    b$destroy()
    c$destroy()
    output$text <- NULL
  })
}

# ...
server <- function(input, output, session) {
  tab_destructors <- list()
  # ...

  observeEvent(input$addTabButton, {
    # ...
    tab_destructors[[length(tab_destructors)]] <- callModule(module = tabServer, id =  newName)
  })

  observeEvent(input$removeTabButton, {
    # ...
    destructor <- tab_destructors[[length(tab_destructors)]]
    destructor()
    tab_destructors <<- head(tab_destructors, -1)
  })
}

[tsmith64]

Thanks for the quick reply! I'm glad that this idea actually works! The sample module listed above was a simplified case modified from here This also applies to #2281 and the other issues mentioned there.

My typical use case involves a module with multiple outputs that returns the reactive of all the input values/states. So the module server function would have to look more like:

tabServer <- function(input, output, session) {
  # ...

  return(reactive(list(
    'text'=input$(first input),
    'destroy'=function() {
        b$destroy()
        c$destroy()
        output$text <- NULL
        output$plot <- NULL
        output$datatable <- NULL
     }
  )))
}

and then I could call the module 'destroy' function when the module is no longer in use.

Last question: is there a type of output that would have an issue with this?