Using reactiveValues across multiple modules in R Shiny

Question

I'm trying to use reactiveValues across multiple modules in an R shiny app.

I have set up an example to illustrate my problem. It consists of a main application containing a reactiveValue which is a data frame of 3 columns and 3 modules designed to "read", "write" and "read and write" the reactiveValue.

• Read: Application -> Module
• Write: Module -> Application
• Read and Write: Application <-> Module

I get the error:

Warning: Error in <-: object of type 'closure' is not subsettable

Note that the code works if the reactiveValue is just a simple variable eg integer, but not with a data frame where components need to be updated rather than the whole data frame.

I have found the following link very useful. Not sure if it covers my case. https://www.ardata.fr/en/post/2019/04/26/share-reactive-among-shiny-modules/

Any ideas on how to solve this problem?

Here is my code:

library(shiny)
library(shinydashboard)

readUI <- function(id, label = "Read") {

  ns <- NS(id)

  tagList(
    valueBoxOutput(ns("showX"))
  )
}

read <- function(input, output, session, x) {

  ns <- session$ns

  output$showX <- renderValueBox({
    valueBox(x(), "x")
  })

}

writeUI <- function(id, label = "Write") {

  ns <- NS(id)

  tagList(
    selectizeInput(ns("selectX"), "Select a value for x", choices = 1:10),
    actionButton(ns("submit"), "Submit")
  )
}

write <- function(input, output, session) {

  ns <- session$ns

  toReturn <- reactiveValues(x = data.frame(a=c(1), b=c(2), c=c(3)), trigger = NULL)

  observeEvent(input$submit, {
    toReturn$x$a <- as.numeric(input$selectX)
    toReturn$trigger <- toReturn$trigger + 1
  })

  return(toReturn)

}

readAndWriteUI <- function(id, label = "ReadAndWrite") {

  ns <- NS(id)

  tagList(
    valueBoxOutput(ns("showX")),
    selectizeInput(ns("selectX"), "Select a value for x", choices = 1:10),
    actionButton(ns("submit"), "Submit")
  )

}

readAndWrite <- function(input, output, session, x) {

  ns <- session$ns

  toReturn <- reactiveValues(x = x, trigger = NULL)

  output$showX <- renderValueBox({
    valueBox(x(), "x")
  })

  observeEvent(input$submit, {
    toReturn$x$a <- as.numeric(input$selectX)
    toReturn$trigger <- toReturn$trigger + 1
  })

  return(toReturn)

}

ui <- dashboardPage(

  dashboardHeader(title = "Example"),

  dashboardSidebar(),

  dashboardBody(
    tabsetPanel(id = "mainTabSetPanel",
      tabPanel("Read", readUI("Read")),
      tabPanel("Write", writeUI("Write")),
      tabPanel("ReadAndWrite", readAndWriteUI("ReadAndWrite"))
    )
  )
)

server <- function(input, output, session) {

  rv <- reactiveValues(x = data.frame(a=c(1), b=c(2), c=c(3)))

  callModule(read, "Read", reactive(rv$x))
  output_Write <- callModule(write, "Write")
  output_ReadAndWrite <- callModule(readAndWrite, "ReadAndWrite", reactive(rv$x))

  observeEvent(output_Write$trigger, {
    print("Updating x from Write")
    rv$x <- output_Write$x
    #updateTabsetPanel(session, "mainTabSetPanel", selected = "Read")
  })

  observeEvent(output_ReadAndWrite$trigger, {
    print("Updating x from ReadAndWrite")
    rv$x <- output_ReadAndWrite$x
    #updateTabsetPanel(session, "mainTabSetPanel", selected = "Read")
  })
}

shinyApp(ui, server)

Answer 1

Please try the below:

library(shiny)
library(shinydashboard)

readUI <- function(id, label = "Read") {

    ns <- NS(id)

    tagList(
        valueBoxOutput(ns("showX"))
    )
}

read <- function(input, output, session, x) {

    ns <- session$ns

    output$showX <- renderValueBox({
        valueBox(x(), "x")
    })

}

writeUI <- function(id, label = "Write") {

    ns <- NS(id)

    tagList(
        selectizeInput(ns("selectX"), "Select a value for x", choices = 1:10),
        actionButton(ns("submit"), "Submit")
    )
}

write <- function(input, output, session) {

    ns <- session$ns

    toReturn <- reactiveValues(x = data.frame(a=c(1), b=c(2), c=c(3)), trigger = 0)

    observeEvent(input$submit, {
        toReturn$x$a <- as.numeric(input$selectX)
        toReturn$trigger <- toReturn$trigger + 1
    })

    return(toReturn)

}

readAndWriteUI <- function(id, label = "ReadAndWrite") {

    ns <- NS(id)

    tagList(
        valueBoxOutput(ns("showX")),
        selectizeInput(ns("selectX"), "Select a value for x", choices = 1:10),
        actionButton(ns("submit"), "Submit")
    )

}

readAndWrite <- function(input, output, session, x) {

    ns <- session$ns

    toReturn <- reactiveValues(x = x, trigger = 0)

    observeEvent(toReturn, {
        toReturn$x <- toReturn$x()
    }, once = TRUE)

    output$showX <- renderValueBox({
        valueBox(x(), "x")
    })

    observeEvent(input$submit, {
        toReturn$x$a <- as.numeric(input$selectX)
        toReturn$trigger <- toReturn$trigger + 1
    })

    return(toReturn)

}

ui <- dashboardPage(

    dashboardHeader(title = "Example"),

    dashboardSidebar(),

    dashboardBody(
        tabsetPanel(id = "mainTabSetPanel",
                    tabPanel("Read", readUI("Read")),
                    tabPanel("Write", writeUI("Write")),
                    tabPanel("ReadAndWrite", readAndWriteUI("ReadAndWrite"))
        )
    )
)

server <- function(input, output, session) {

    rv <- reactiveValues(x = data.frame(a=c(1), b=c(2), c=c(3)))

    callModule(read, "Read", reactive(rv$x))
    output_Write <- callModule(write, "Write")
    output_ReadAndWrite <- callModule(readAndWrite, "ReadAndWrite", reactive(rv$x))

    observeEvent(output_Write$trigger, {
        print("Updating x from Write")
        rv$x <- output_Write$x
        #updateTabsetPanel(session, "mainTabSetPanel", selected = "Read")
    }, ignoreInit = TRUE)

    observeEvent(output_ReadAndWrite$trigger, {
        print("Updating x from ReadAndWrite")
        rv$x <- output_ReadAndWrite$x
        #updateTabsetPanel(session, "mainTabSetPanel", selected = "Read")
    }, ignoreInit = TRUE)
}

shinyApp(ui, server)

The key is adding in the line toReturn$x <- toReturn$x() as you're dealing with reactives and reactiveValues but this must only run once, hence the below:

observeEvent(toReturn, {
    toReturn$x <- toReturn$x()
}, once = TRUE)

An independent issue I picked up was your code was only working once even for the write module. So, I changed trigger = NULL to trigger = 0 (as you can't add to a NULL value) but then had to add in ignoreInit = TRUE for the observeEvents in the server to ignore them on startup.

Feel free to test these by taking out my additions one by one to understand the process. Comment below if anything needs clarifying.