Search code examples
rshinyreactiver6

Recreate reactiveValues in shiny without reactiveness (but same scoping behaviour)


I have a shiny app split into multiple modules. To pass data between the modules I use reactiveVal(ues). These can be passed to functions and modified from within the other functions.

I would like to create a similar object, but without all the reactive capabilities of the built-in reactiveValues(). I want to pass quite large dataframes/tibbles around and want to manually control if and when datatables/calculations are done.

In this example, I would like to create a object instead of list(), that can pass data around the scopes in the same way as reactiveValues():

library(shiny)

## Module
module_ui <- function(id) {
    ns <- NS(id)
    actionButton(inputId = ns("increase"), label = "Increase")
}

module_server <- function(id, vals, not_working) {
    moduleServer(id, function(input, output, session) {
        observeEvent(input$increase, {
            vals$a <- vals$a + 1
            not_working$a <- not_working$a + 1
        })
    })
}

## Main
ui <- fluidPage(
    h1("ReactiveValues Test"),
    textOutput(outputId = "out1"),
    textOutput(outputId = "out2"),
    actionButton(inputId = "update", label = "Update Shown Values"),

    module_ui("modid")
)

server <- function(input, output, session) {
    vals <- reactiveValues(a = 10)
    not_working <- list(a = 10)

    observeEvent(input$update, {
        output$out1 <- renderText(paste("The value of vals$a is:", vals$a))
        output$out2 <- renderText(paste("The value of not_working$a is:", not_working$a))
    })

    module_server("modid", vals, not_working)
}

shinyApp(ui, server)

In the example above

  • the problem with reactiveValues is that after the inital "Update Shown Values" is pressed, the vals$a value is updated instantly when "increase"-button is pressed and does not require the manual "Update Shown Values". Because I have large amounts of data and do some calculation I don't want it to trigger automatically, and I don't want to be forced to only read and modify the value inside reactive environments.
  • the problem with list is that the object gets copied into the module_server-call and this the value is not updated in the main function scope.

I have tried to read the source code of reactives.R but it is too advanced R for me to understand what is happening.

I have tried to find a way to pass by reference, but not found one yet. But I think passing a list() by reference might work. In python passing a dictionary would behave in the way I want. Where key/value-pairs can be modified inside function scopes.

How could I go about created an object which scoping behaves as reactiveValues, but without all of the reactiveness-functionality? Are there any good resources describing what is happening in the reactives.R source code? (or not that code specifically but the language-feature used)


Solution

  • After some further digging and experimentation, I found that the underlying object that was used was a fastmap. If we wrap it in some S3 object notation we can use it as a replacement for reactiveValues() without the reactiveness.

    This code is mostly copied from reactives.R. All credit goes there.

    # nolint start: object_name_linter.
    dataHolder <- function(...) {
      args <- rlang::list2(...)
      if ((length(args) > 0) && (is.null(names(args)) || any(names(args) == "")))
        rlang::abort("All arguments passed to dataHolder() must be named.")
    
      values <- structure(
        list(
          impl = fastmap::fastmap()
        ),
        class = "dataholder"
      )
    
      lapply(names(args),
             \(name) {
               .subset2(values, "impl")$set(name, args[[name]])
             })
    
      values
    }
    
    checkName <- function(x) {
      if (!is.character(x) || length(x) != 1) {
        rlang::abort("Must use single string to index into dataholder.")
      }
    }
    
    print.dataholder <- function(x, ...) {
      cat("<DataHolder>", "\n")
      cat("  Values:   ", paste0(.subset2(x, "impl")$keys(sort = TRUE), collapse = ", "), "\n")
    }
    
    is.dataholder <- function(x) inherits(x, "dataholder")
    
    `$.dataholder` <- function(x, name) {
      checkName(name)
      .subset2(x, "impl")$get(name)
    }
    
    `[[.dataholder` <- `$.dataholder`
    
    `$<-.dataholder` <- function(x, name, value) {
      checkName(name)
      .subset2(x, "impl")$set(name, value)
      x
    }
    
    `[[<-.dataholder` <- `$<-.dataholder`
    
    `[.dataholder` <- function(values, name) {
      rlang::abort("Can't index dataholder with `[`.")
    }
    
    `[<-.dataholder` <- function(values, name, value) {
      rlang::abort("Can't index dataholder with `[`.")
    }
    # nolint end