Examples of "stratégie du petit r" or its successor for larger Apps [FR]

Is your feature request related to a problem? Please describe

I’d like to switch to the “stratégie du petit r” model (or your current workflow of doing that as mentioned by @ALanguillaume in #965) for my current App.

The problem is that I cannot make a clear design about how to store intermediate data sets computed from different modules and stored inside r$datasets ( see "Additional context" below).

Describe the solution you'd like

Is there a recent example for “stratégie du petit r” or, as mentioned in #965 the version with the “global reactiveValues” on a larger project where I can see the implemented passing of data sets or other computed data/stuff that usually is passed as a reactive from function to function?

Describe alternatives you've considered

Currently, in structuring the communication of modules I keep returning reactive values from (server-)functions and pass them to (server-)functions back-and-forth between modules via plain arguments, similar to https://engineering-shiny.org/structuring-project.html?q=petit#a.-returning-values-from-the-module

The resulting reactive data sets get standard processing, depending on user input, to finally arrive at either a plot output or to data analysis that in turn produce output of the App.

Additional context

To switch to petit r, I

Define a r <- shiny::reactiveValues(datasets = shiny::reactiveValues()) (following https://rtask.thinkr.fr/communication-between-modules-and-its-whims/ )
Wrap the assignment r$...$data_set_01 <- compute_data_set_01() inside a shiny::reactive({}) inside the corresponding server function of the module to make the reactiveValues() accessible (otherwise an error occurs "Warning: Error in $: Can't access reactive value 'datasets' outside of reactive consumer."):

 mod_01_data_set <- function(id, r, raw_data, ...) {
    shiny::moduleServer(id, function(input, output, session) {
    shiny::reactive({
        r$datasets$data_set_01 <- compute_data_set_01(raw_data, input$user_input_01, ...)
    })
}

Wrapping inside reactive({...}) might not be optimal: all these data_sets/computations with no direct renderXXX()-calls or meaningful side effects get ignored in shiny.... This produces an error further down the App when a render function tries to access r$datasets$data_set_01() which is NULL.

I suspect that a call to r$datasets$data_set_01 evaluates to NULL because the corresponding server that makes the assignment $datasets$data_set_01 <- compute_data_set_01(raw_data, input$user_input_01, ...) never gets executed: output from the server is not in a rendering context and I wrap the assignment inside a shiny::reactive() which never gets evaluated (only its storage part is evaluated i.e. r$....$data_set_01 to NULL).

See the last commit in my current App, but this example is probably too large https://github.com/TASK-no/TaskSVVdcDB/commit/f0e2fa647add604c828ed42719af2230f190f9c6

It might also be a design issue, hence the request for a large scale App that uses petit-r!

This should be enough in your example. You don't have to set reactive values inside reactive global value.

r <- shiny::reactiveValues(
 datasets = NULL,
 ui_inputs = NULL,
 intermediate1 = NULL,
 intermediate2 = NULL
)

Hi! That's not really working due to https://rtask.thinkr.fr/communication-between-modules-and-its-whims/ , as said above, or have a look at this:

In the main server function you really have to use r <- shiny::reactiveValues(datasets = shiny::reactiveValues()) otherwise the console goes nuts for observe inside mod_data_computations_srv. If you use the generally safer observeEvent (see the commented out part inside mod_data_computations_srv), reactivity gets tamed a bit, at least the console does not go nuts. Still, though the data is updated correctly, the console output is wrong indicating an overuse of reactivity (a very subtle bug; you will not see an error in the UI but the implementation is sub-optimal as additional reactivity is invoked). You really have to make it r <- shiny::reactiveValues(datasets = shiny::reactiveValues()), because both r <- shiny::reactiveValues(datasets = NULL) and r <- shiny::reactiveValues() will fail for observe and induce the subtle bug in observeEvent.

library(shiny)
library(dplyr)
library(magrittr)
mod_data_ui <- function(id, num_data) {
  ns <- shiny::NS(id)
  ns_sub_t <- paste0("table_", num_data)
  header   <- paste("Dataset ", num_data)
  shiny::tagList(
    shiny::actionButton(ns("button"),
                        label = paste("Add one to data set", num_data)),
    shiny::h3(header),
    shiny::tableOutput(ns_sub_t),
  )
}
mod_data_computations_srv <- function(id, r, data_set_initial, data_set_name, num) {
  shiny::moduleServer(id, function(input, output, session) {
    # observeEvent(input$button, {
    #   if (input$button == 1) r$datasets[[data_set_name]] <- data_set_initial
    #   r$datasets[[data_set_name]] <- isolate(r$datasets[[data_set_name]]) %>%
    #                                            dplyr::mutate(count = input$button)
    # })
    observe({
    if (input$button == 0)  r$datasets[[data_set_name]] <- data_set_initial
    r$datasets[[data_set_name]] <- isolate(r$datasets[[data_set_name]]) %>%
      dplyr::mutate(count = input$button)
    })
    observeEvent(r$datasets[[data_set_name]], {
      message(paste("Dataset", num, "updated!"))
    })
  }
  )
}
ui <- shiny::fluidPage(
  mod_data_ui("count_01", 1),
  mod_data_ui("count_02", 2)
)
server <- function(input, output, session) {
  ds1 <- data.frame(cbind(mtcars, list(count = 0)))
  ds2 <- data.frame(cbind(mtcars, list(count = 0)))

  # r <- shiny::reactiveValues(datasets = shiny::reactiveValues())
  r <- shiny::reactiveValues(datasets = NULL)
  # r <- shiny::reactiveValues()

  mod_data_computations_srv("count_01", r, ds1, data_set_name = "data_1", num = 1)
  mod_data_computations_srv("count_02", r, ds2, data_set_name = "data_2", num = 2)

  output$table_1 <- shiny::renderTable({
    head(r$datasets$data_1)
  })
  output$table_2 <- shiny::renderTable({
    head(r$datasets$data_2)
  })
}
shinyApp(ui, server)

Hello @IlyaZar !

We are glad you found some value in the "stratégie du petit r" and are willing to implement it on your own project.

As I mentionned in #965, we now tend to call that design pattern the global messenger strategy instead of "stratégie du petit r".

That is for two main reasons:

1 - It reduces the cognitive load for none French speakers. 2 - Calling your reactiveValues global or r_global reflects its global nature at the app scale. This also allows the dev to distinguish between r_global and another reactiveValue r_local that will be confined to a given module.

I had a look at your reprex above.

This is not a golem issue nor a reactivity bug but the way Shiny works. If you just define r as r <- reactiveValues(), reactivity is scoped at the level of the whole r objects.

Then if r$datasets$data_1 gets updated that invalidates reactivity for the whole object.

Since you are monitoring r$datasets[[data_set_name]] in your observeEvent()

observeEvent(r$datasets[[data_set_name]], {
    message(paste("Dataset", data_set_name, "updated!"))
})

but only input$update in the other one :

observeEvent(input$update, {
    if (input$update == 1) {
        r_global$values[[id]] <- 0
    }
    r_global$values[[id]] <- r_global$values[[id]] + 1
})

The correct dataset gets updated but you trigger two messages instead of one because both datasets get there reactivity invalidated. In other words from a reactivity point of view both datasets get updated even if only one has its values changed.

Dataset data_1 updated!
Dataset data_2 updated!

However, if you use r <- reactiveValues(datasets = reactiveValues()), reactivity will be scoped at a finer level. Updating one dataset will only invalidate reactivity for that particular dataset and not the whole r.

Here is a more minimal version of your reprex capturing the gist of the problem:

library(shiny)

mod_reprex_ui <- function(id) {
  ns <- NS(id)
  tagList(
    actionButton(
      inputId = ns("update"),
      label = "Update value"
    ),
    textOutput(
      outputId = ns("value")
    )
  )
}

mod_reprex_server <- function(id, r_global) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns

    observeEvent(input$update, {
      if (input$update == 1) {
        r_global$values[[id]] <- 0
      }
      r_global$values[[id]] <- r_global$values[[id]] + 1
    })

    output$value <- renderText({
      r_global$values[[id]]
    })

    observeEvent(r_global$values[[id]], {
      message(
        paste(
          "Value:", id, "updated!"
        )
      )
    })
  })
}

ui <- fluidPage(
  mod_reprex_ui("id_1"),
  mod_reprex_ui("id_2")
)

server <- function(input, output, session) {
  r_global <- reactiveValues(
    # Defining values as a reactiveValues() will solve the issue
    # values = reactiveValues()
    values = NULL
  )
  mod_reprex_server("id_1", r_global = r_global)
  mod_reprex_server("id_2", r_global = r_global)
}

shinyApp(ui, server)

Here is a corrected version of your own reprex:

library(shiny)
library(dplyr)
library(magrittr)
mod_data_ui <- function(id, num_data) {
  ns <- shiny::NS(id)
  header   <- paste("Dataset ", num_data)
  shiny::tagList(
    shiny::actionButton(
      ns("button"),
      label = paste("Add one to data set", num_data)
    ),
    shiny::h3(header),
    # No need to do any namespacing yoursself. 
    # Shiny does that for you
    shiny::tableOutput(ns("table")),
  )
}
mod_data_computations_srv <- function(id, r, data_set_initial, data_set_name, num) {
  shiny::moduleServer(id, function(input, output, session) {
    # This was missing from the module template
    # No impact on the current reprex though
    ns <- session$ns
    observeEvent(input$button, {
      if (input$button == 1) r$datasets[[data_set_name]] <- data_set_initial
      # isolate() was not needed there
      r$datasets[[data_set_name]] <- r$datasets[[data_set_name]] %>%
        dplyr::mutate(count = input$button)
    })

    observeEvent(r$datasets[[data_set_name]], {
      message(paste("Dataset", data_set_name, "updated!"))
    })

    # This belongs here in the same module were the output is define
    # on the UI side
    output$table <- shiny::renderTable({
      head(r$datasets[[data_set_name]])
    })
  }
  )
}
ui <- shiny::fluidPage(
  mod_data_ui("count_01", 1),
  mod_data_ui("count_02", 2)
)
server <- function(input, output, session) {
  ds1 <- data.frame(cbind(mtcars, list(count = 0)))
  ds2 <- data.frame(cbind(mtcars, list(count = 0)))

  r <- shiny::reactiveValues(datasets = shiny::reactiveValues())

  mod_data_computations_srv("count_01", r, ds1, data_set_name = "data_1", num = 1)
  mod_data_computations_srv("count_02", r, ds2, data_set_name = "data_2", num = 2)

}
shinyApp(ui, server)

PS : If you have question about the book Engineering Production-Grade Shiny Apps, it will be better to post your issue on the dedicated repo: Engineering Production-Grade Shiny Apps.

Hope this helps.

thanks for going though the effort of correcting my reprex!! (it was in fact a bit lousy :) )

Actually I was just an answering to @YonghuiDong comment from above to highlight the same fact as you did with your cleaner reprex.

My initial question was whether there exists a large scale app/example that implements "the global messenger strategy" to have a look at the overall design (see my initial post, "Describe the solution you'd like"). I'll move this into the engineering shiny app repo though.

ThinkR-open / golem