Repeating Shiny Modules using insertUI

Question

I use a shiny module to plot each element (some data) of a list respectively.

The ui creates some Data (DataPack) (a list with so far two elements) by clicking the "Load"-button. The data is then plotted via the module whereas the x-axis range of each module's plot is controlled by the sliderInput of the ui. In addition, each module plots some "analysis" (a running mean) by clicking the module's "Process" button.

Is there a way, for the ui as well as for the server function, to use insertUI in a way that repeats the module depending on the length of the list DataPack but preserving the connectivity between the ui's slider input with each module (thereby avoiding to copy and paste Module_ui in the ui as well as callModule in the server function several times)? Thanks!

library(shiny)
library(TTR)

Module_ui <- function(id) {

  ns <- NS(id)

  tagList(

    fluidRow(
      column(2, column(12, fluidRow(
        numericInput(
          inputId = ns("NumericInput_BW"),
          label   = NULL,
          min     = 1,
          max     = 100,
          value   = 10,
          step    = 1))),
        fluidRow(
          column(12, actionButton(
            ns("InputButton_ProcessData"), "Process", width = "100%")))),
      column(10, plotOutput(ns("Plot"))))

  )

}


Module_Server <- function(input, output, session,
                          DataPack, AnalysedPack, 
                          DataSetName, 
                          InputButton_GetData,
                          xlim) {

  AnalysedPack <- eventReactive(c(
    InputButton_GetData(),
    input$InputButton_ProcessData), {

      message(paste("Analysed Pack", DataSetName))
      AnalysedPack <-
        runMean(DataPack()[[DataSetName]],
                min(input$NumericInput_BW,
                    length(DataPack()[[DataSetName]])))

      return(AnalysedPack)

    })

  output$Plot <- renderPlot({

    message(paste("Base_Plot", DataSetName))
    plot(DataPack()[[DataSetName]],
         xlim = c(xlim()[1],
                  xlim()[2]))

    lines(AnalysedPack(), 
      col = "tomato", lwd = 2)

  })

}


ui <- fluidPage(

  fluidRow(

    column(
      6,
      column(
        12,
        fluidRow(h4("Data Generation")),
        fluidRow(actionButton("InputButton_GetData", "Load", width = "100%")))),

    column(
      6,
      column(
        12,
        fluidRow(h4("Update Plot")),
        sliderInput(
          "SliderInput_xAxis",
          label = NULL,
          min = 0,
          max = 150,
          value = c(0, 150),
          animate = TRUE))
    )

  ),

  Module_ui("Plot_1"),

  Module_ui("Plot_2")

)


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

  DataPack <- eventReactive(
    input$InputButton_GetData, {

      message("DataPack")

      n <- round(runif(1, min = 100, max = 500))

      message(n)

      DataPack <- NULL
      DataPack$one <- rnorm(n)
      DataPack$two <- rnorm(n)^2

      updateSliderInput(
        session = session,
        inputId = "SliderInput_xAxis",
        value   = c(1, n),
        min     = 1,
        max     = n)

      return(DataPack)

    })

  SliderInput_xAxis_rx       <- reactive(input$SliderInput_xAxis)
  InputButton_GetData_rx     <- reactive(input$InputButton_GetData)

  callModule(Module_Server, "Plot_1",
             DataPack                = DataPack,
             DataSetName             = "one",
             InputButton_GetData     = InputButton_GetData_rx,
             xlim                    = SliderInput_xAxis_rx)

  callModule(Module_Server, "Plot_2",
             DataPack                = DataPack,
             DataSetName             = "two",
             InputButton_GetData     = InputButton_GetData_rx,
             xlim                    = SliderInput_xAxis_rx)

}



shinyApp(ui, server)

You could try to use insertUI in a loop in server, but it is hard to tell with your example. Can you make your example reproducible? — bretauv
@bretauv Reproducible example added (hope not too long, however focused on the relevant interplay). I am just not sure how to harmonize the selector, the Module_ui, as well as the callModule. — Fabian

Fabian Fabian · Accepted Answer · 2020-04-13T20:48:18

Inspired by Thomas Roh's article (Link 1, Link 2) as well as this post it works like this:

library(shiny)
library(TTR)

Module_ui <- function(id) {
  ns <- shiny::NS(id)
  shiny::uiOutput(ns("Plot"))
}

Module_Server <- function(
  input, output, session,
  DataPack, DataSetName, InputButton_GetData, xlim) {

  AnalysedPack <- eventReactive(c(
    InputButton_GetData(),
    input$InputButton_ProcessData), {

      message(paste("Analysed Pack", DataSetName))
      AnalysedPack <-
        runMean(DataPack()[[DataSetName]],
                min(input$NumericInput_BW,
                    length(DataPack()[[DataSetName]])))

      return(AnalysedPack)

    })

  output[['Plot']] <- renderUI({

    ns <- session$ns

    tags$div(
      id = environment(ns)[['namespace']],
      tagList(
        fluidRow(
          column(2, column(12, fluidRow(
            numericInput(
              inputId = ns("NumericInput_BW"),
              label   = NULL,
              min     = 1,
              max     = 100,
              value   = 10,
              step    = 1))),
            fluidRow(
              column(12, actionButton(
                ns("InputButton_ProcessData"),
                "Process", width = "100%")))),
          column(10, 
                 renderPlot({
                   message(paste("Base_Plot", DataSetName))
                   plot(DataPack()[[DataSetName]],
                        xlim = c(xlim()[1],
                                 xlim()[2]))
                   lines(AnalysedPack(),
                         col = "tomato", lwd = 2)
                 }) ) )
      )
    )

  })

}



ui <- fluidPage(

  fluidRow(

    column(
      6,
      column(
        12,
        fluidRow(h4("Data Generation")),
        fluidRow(actionButton(
          "InputButton_GetData", "Load", width = "100%")))),

    column(
      6,
      column(
        12,
        fluidRow(h4("Update Plot")),
        sliderInput(
          "SliderInput_xAxis",
          label = NULL,
          min = 0,
          max = 150,
          value = c(0, 150),
          animate = TRUE)
      )
    ),
    column(12, actionButton('addButton', '', icon = icon('plus')))

  )

)



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

  DataPack <- eventReactive(
    input$InputButton_GetData, {

      message("DataPack")

      n <- round(runif(1, min = 100, max = 500))

      message(n)

      DataPack <- NULL
      DataPack$one <- rnorm(n)
      DataPack$two <- rnorm(n)^2

      updateSliderInput(
        session = session,
        inputId = "SliderInput_xAxis",
        value   = c(1, n),
        min     = 1,
        max     = n)

      return(DataPack)

    })

  SliderInput_xAxis_rx   <-
    reactive(input$SliderInput_xAxis)
  InputButton_GetData_rx <-
    reactive(input$InputButton_GetData)

  observeEvent(input$InputButton_GetData, {
    lapply(names(DataPack()), function(DataSetName) {

      id <- sprintf('Plot%s', DataSetName)

      insertUI(
        selector = "#addButton",
        where = "afterEnd",
        ui = Module_ui(id)
      )
      callModule(
        Module_Server, id,
        DataPack            = DataPack,
        DataSetName         = DataSetName,
        InputButton_GetData = InputButton_GetData_rx,
        xlim                = SliderInput_xAxis_rx)

    })
  })

}



shinyApp(ui, server)

Repeating Shiny Modules using insertUI

1 Answers