Invoking and passing reactive values to modules programmatically

[bearloga]

I'm working on an app with a dynamic number of modules which take module-specific reactive values. If the value is non-reactive, using force (per #1711) fixes the problem but I just can't figure out how to get around reactive values due to lazy evaluation.

This is a simplified, reproducible version. The actual version is a Shiny-powered app for interfacing with any discrete Bayesian network, where every node is a module and can be unobserved (in which case the probabilities are inferred) or observed -- in which case it is evidence that propagates to other nodes (modules) -- so I'm trying to figure out how handle dynamically-named reactive values in a programmatic way.

The goal here is that every module renders the selected values from the other modules.

library(shiny)

modUI <- function(id) {
  ns <- NS(id)
  wellPanel(
    h3(id),
    selectInput(ns("choices"), "Choose:", choices = LETTERS[1:4], selected = "A"),
    verbatimTextOutput(ns("others"))
  )
}

mod <- function(input, output, session, label, rvar) {
  force(label) # due to lazy evaluation
  output$others <- renderPrint({
    paste0("outside of ", label, ": ", paste0(rvar(), collapse = ", "))
  })
  return(input$choices)
}

launch_app <- function(N = 3) {
  module_uis <- purrr::map(1:N, function(n) {
    return(modUI(n))
  })

  ui <- fluidPage(
    tagList(module_uis)
  )

  initial_rvars <- paste0(rep("A", N - 1), collapse = ", ")

  server <- function(input, output, session) {
    modules <- reactiveValues()
    rvars <- reactiveValues()
    for (n in as.character(1:N)) {
      # populate the reactive vars with some initial values:
      rvars[[n]] <- reactive({ initial_rvars })
    }
    observe({
      for (n in as.character(1:N)) {
        modules[[n]] <- callModule(mod, n, label = n, rvar = rvars[[n]])
      }
    })
    observe({
      for (n in as.character(1:N)) {
        others <- setdiff(as.character(1:N), n)
        rvals <- reactiveValuesToList(modules)[others]
        rvals_subset <- rvals[others]
        rval <- paste0(purrr::map_chr(rvals_subset, ~ .x()), collapse = ", ")
        rvars[[n]] <- reactive({ rval })
      }
    })
  }

  shinyApp(ui, server)
}

launch_app()

This is what I get:

Warning: Error in .x: could not find function ".x"
  51: .f
  50: purrr::map_chr
  48: <observer> [~/Desktop/reproducible.R#48]
   5: runApp
   3: print.shiny.appobj
   1: source

and I'm stumped. What am I doing wrong or not seeing here? Or are Shiny modules just not built to handle this kind of logic?

[grrrck]

This probably doesn't get you all the way there, but you can resolve the error by just accessing ~ .x directly in the map_chr().

With a couple additional simplifications:

    observe({
      for (n in as.character(1:N)) {
        others <- setdiff(as.character(1:N), n)
        rvals <- reactiveValuesToList(modules)[others]
        rval <- paste0(purrr::map_chr(rvals, ~ .x), collapse = ", ")
        rvars[[n]] <- reactive({ rval })
      }
    })

[bearloga]

Thanks, @grrrck! That does start to do…rather interesting things:

[chasec]

Sorry to change things around, but this should work and hopefully stays on task...

library(shiny)

modUI <- function(id) {
  ns <- NS(id)
  tagList(
    wellPanel(
      h3(id),
      selectInput(ns("choices"),
                  "Choose:", 
                  choices = LETTERS[1:4],
                  selected = "A"),
      verbatimTextOutput(ns("others"),
                         placeholder = T)
    )
  ) 
}

mod <- function(input, output, session, outside) {
  
  
  output$others <- renderPrint({
    rvals <- outside[names(outside) != as.character(session$ns(character()) )]
    paste0("outside of ", 
           session$ns(character()),
           ": ", 
           paste0(rvals, collapse = ", "))
  })
  return(input$choices)
}


ui <- fluidPage(
  column(2,
         sliderInput("numMods","# Modules", 1, 10, 3)),
  column(10,
         uiOutput("module_uis"))
)


server <- function(input, output) {
  
  modd <- reactiveValues()
  
  observeEvent(input$numMods,{
       output$module_uis <- renderUI({ lapply(1:input$numMods, function(n) {
      return(modUI(n))})
    })
  })
  
  observe({
    modd <- reactiveValues()
      for (i in 1:input$numMods){
      modd[[as.character(i)]] <-  callModule(mod,
                                             as.character(i),
                                             outside = reactiveValuesToList(modd))
    }
  })
  
  
  
}

shinyApp(ui, server)

[bearloga]

Thank you very much @chasec! Your solution is really cool and you've given me a lot to study and learn from here.