lapply modules and make use of reactive return from shiny modules

[Trevor Nederlof]

I posted this on SO too so if you have an answer feel free and I will accept it there too.

I have created a sample app below to illustrate the issue I am having. I have an application in Shiny that is using many layers of modules. I am very familiar with using modules and returning reactive values from the modules themselves. However when I need to use lapply to create multiple calls of modules (in this case slider_menu_item_shiny function to create multiple sliders), each which return the reactive value that is set by the user in sliders, I am not sure how to dynamically capture all of the output reactive variables into one reactive vector.

Right now I have 2 sliders hard coded in and this simple app works. However I want to be able to type in an arbitrary value in the first input, have the app create that amount of slider modules using the lapply statement (for the callModule(slider_menu_item_shiny) call too) and then have slider_value_vector contain a vector of that length with all of the slider values.

I feel like I am missing a fundamental trick to making this work. I would really appreciate the learning experience and all of the help.

ui.R code

library(shiny)
library(shinydashboard)
library(DT)

#### MODULE CODE ####
source("modules.R")

# define header
header <- dashboardHeader(
  title = "Test"
)

# define body
body <- dashboardBody(

  tabItems(
    body_set_shinyUI(id = "body_test_mod", tab_name = "body_test_mod")
  )
)

# define sidebar
sidebar <- dashboardSidebar(
    sidebarMenu(id = "dashboard_menu",
      menuItem("Test Body", tabName = "body_test_mod")
    )
)

dashboardPage(skin = "blue",
              header,
              sidebar,
              body
)

server.R code

library(shiny)
library(shinydashboard)
library(DT)

#### MODULE CODE ####
source("modules.R")

#### SERVER CODE ####
function(input, output, session) {
  callModule(body_set_shiny, id = "body_test_mod")
}

modules.R code

### body_set_shiny
body_set_shinyUI <- function(id, tab_name) {
  ns <- NS(id)


  tabItem(tabName = tab_name,
          fluidRow(
            column(12,
                   inner_body_test_menu_shinyUI(ns("inner_body_test_mod"))
            )
          )
  )
}
body_set_shiny <- function(input, output, session) {
  callModule(inner_body_test_menu_shiny, id = "inner_body_test_mod")
}

### inner_body_test_menu_shiny
inner_body_test_menu_shinyUI <- function(id) {
  ns <- NS(id)

  fluidRow(
    column(12,
           box(title = "Test Inner Menu",
               width = 12,
               fluidRow(
                 column(12,
                        wellPanel(
                          uiOutput(ns("inner_number_menu")),
                          uiOutput(ns("inner_sliders_menu")),
                          uiOutput(ns("inner_text_output"))
                        )
                 )
               )
           )
    )
  )
}

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

  output$inner_number_menu <- renderUI({
    ns <- session$ns
    textInput(ns("inner_number_value"), label = "Enter Number of Sliders", value = "2")
  })

  slider_length <- reactive({
    if (is.null(input$inner_number_value))
      return()

    as.numeric(input$inner_number_value)
  })

  output$inner_sliders_menu <- renderUI({
    if (is.null(slider_length()))
      return()

    ns <- session$ns

    lapply((1:slider_length()), function(m) {  

      slider_menu_item_shinyUI(ns(paste("slider_menu_item_", m, sep = "")))
    })

  })

  output$inner_text_output <- renderText({ 
    if (is.null(slider_value_vector()))
      return()

    paste("You have entered", slider_value_vector())
  })

  slider_value_vector <- reactive({
    if (is.null(slider_length()))
      return()
    c(as.numeric(slider_v1()[[1]]),as.numeric(slider_v2()[[1]]))
  })


  slider_v1 <- callModule(slider_menu_item_shiny, paste("slider_menu_item_", 1, sep = ""))
  slider_v2 <- callModule(slider_menu_item_shiny, paste("slider_menu_item_", 2, sep = ""))

}


slider_menu_item_shinyUI <- function(id) {
  ns <- NS(id)

  uiOutput(ns('sider_output_menu'))
}

slider_menu_item_shiny <- function(input, output, session, slider_value = 0, slider_name = "No Name Found") {

  output$sider_output_menu <- renderUI({
    ns <- session$ns

    uiOutput(ns("slider_item_menu"))
  })

  output$slider_item_menu <- renderUI({
    ns <- session$ns

    sliderInput(ns("slider_item"), label = "Slider Example", min = -1, max = 1, value = 0.5, step = 0.01)
  })

  return(reactive(list(input$slider_item)))
}

[Trevor Nederlof]

SO link: http://stackoverflow.com/questions/38442954/lapply-modules-and-make-use-of-reactive-return-from-shiny-modules

[Joe Cheng]

If I'm understanding this correctly, what you have seems pretty reasonable. I'd just put the callModule(slider_menu_item_shiny_X, ...) calls into an lapply, and put the lapply() inside a reactive(), and if necessary create another wrapper reactive() that extracts the slider values out of the list of reactive expressions, for convenience.

slider_reactives <- reactive({

  lapply(1:slider_length(), function(m) {

    callModule(slider_menu_item_shiny, sprintf("slider_menu_item_shiny_", m))

  })

})

slider_values <- reactive({

  lapply(slider_reactives(), function(r) r())

})

Note that this might cause problems if your slider_menu_item_shiny module (or a submodule called therein) sets up observers, as these would be duplicated over time as callModule gets invoked over and over again for these same IDs. Dealing with this would be a bit trickier and involve setting up and destroying only the modules that need to be added/removed from one value of slider_length() to another. But if you're only declaring outputs and reactives in these modules, it should be fine.

--
You received this message because you are subscribed to the Google Groups "Shiny - Web Framework for R" group.
To unsubscribe from this group and stop receiving emails from it, send an email to shiny-discus...@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/shiny-discuss/509274b4-fc7f-4410-85c9-002e136d3000%40googlegroups.com.
For more options, visit https://groups.google.com/d/optout.

[Trevor Nederlof]

Thank you so much Joe. For some reason I didnt think to put the lapply inside the reactive. I tried setting up reactiveValues, etc. There are still some areas of Shiny which trick me but am loving every bit of my time creating applications (especially modules, which I have had a lot of fun building tons of them inside r packages for maximum reuse.

Also thank you for all you and the team do, Shiny is quite impressive in so many ways.

-Trevor