Dynamically adding modules in shiny

Question

This isn't about creating modules using renderUI. With renderUI as i understand it you put a placeholder inside the UI function and then you write your controls/widget inside the server function.

Modules come in two parts. One part you have to add to the UI function and another part to the server function using callModule().

I have a slider module. I want to add it to a wellpanel when an "add" action button is clicked. If it helps you can think of duplicating the module as many times i want when a button is clicked. The duplicate modules should all be independent.

Visually

I want to know how can an action button add the UI part of the module inside the UI function and server part inside the server function.

#Dynamically adding modules
library(shiny)

#slider module ------------------------
sliderUI <- function(id) {
  ns <- NS(id)
  sliderInput(ns("bins"), "Number of Bins:", min = 1, max = 5, value = 3)
}

slider <- function(input, output, session) {}


#shiny app ------------------------
ui <- fixedPage(
  fixedRow(
    column(width = 4, wellPanel(
      h4("Slider Module"),
      sliderUI("slider"),
      actionButton("addSliderModule", "Add Slider Module"))
    ),
    column(width = 4, wellPanel(
      h4("Dynamic Loading Modules"),
      p("Clicking on the 'Add' button on the left should add the module here. You should be able to duplicate that slider module as many times as the button is clicked"),
  hr())
    )
  )
)

server <- function(input, output, session) {
   observeEvent(input$addSliderModule, {
      #what goes here
   })
}

shinyApp(ui, server)

cross posted on shiny-group

Answer 1

Okay, here is your solution. I am so glad I found one, because it took me hours.

Basically, if you want to add a module from nothing (no render functions), it has to be through JavaScript. This comes in three steps:

• Create the HTML element
• Register it as slider with the ionrangeslider.js library
• Create the Shiny callback

If you call inputSlider from Shiny, all three are done for you. But without it, we have to do those things alone. Good thing, its not that hard if you know what to do.

The important part of my code happens inside the script. There I create the element (what you tried before in the function sliderUI), then call to ionRangeSlider, to make it look like a real slider and finally, Shiny.unbindAll() / Shiny.bindAll() creates a binding for the corresponding input variable.

The other additions are just for illustration.

Enjoy!

Code:

library(shiny)

  ui <- fixedPage(
  fixedRow(
    column(width = 4, wellPanel(
      h4("Slider Module"),
      tags$div(
        sliderInput("slider-bins", "Number of Bins:", min = 1, max = 5, value = 3)
      ),
      actionButton("addSliderModule", "Add Slider Module"))
    ),
    column(width = 4, wellPanel(id = "target",
      h4("Dynamic Loading Modules"),
      p("Clicking on the 'Add' button on the left should add the module here. You should be able to duplicate that slider module as many times as the button is clicked"),
      hr(),

      tags$script('
        Shiny.addCustomMessageHandler("createSlider",
          function(ID) {
            Shiny.unbindAll();

            var targetContainer = document.getElementById("target");

            var container = document.createElement("div");
            container.setAttribute("class", "form-group shiny-input-container");

            var label = document.createElement("label");
            label.setAttribute("class", "control-label");
            label.setAttribute("for", "ID");

            var labelText = document.createTextNode("Number of Bins");

            label.appendChild(labelText);
            container.appendChild(label);

            var input = document.createElement("input");
            input.setAttribute("class", "js-range-slider");
            input.setAttribute("id", ID);
            input.setAttribute("data-min", "1");
            input.setAttribute("data-max", "5");
            input.setAttribute("data-from", "3");
            input.setAttribute("data-step", "1");
            input.setAttribute("data-grid", "true");
            input.setAttribute("data-grid-num", "4");
            input.setAttribute("data-grid-snap", "false");
            input.setAttribute("data-prettify-separator", ",");
            input.setAttribute("data-keyboard", "true");
            input.setAttribute("data-keyboard-step", "25");
            input.setAttribute("data-drag-interval", "true");
            input.setAttribute("data-data-type", "number");

            container.appendChild(input);

            targetContainer.appendChild(container);

            $("#" + ID).ionRangeSlider();

            Shiny.bindAll();
          }
        );'
      )
    )),
    column(width = 4, wellPanel(
      uiOutput("response") 
    ))
  )
)

server <- function(input, output, session) {
  observeEvent(input$addSliderModule, {
    session$sendCustomMessage(type = "createSlider", message = paste0("slider-", input$addSliderModule))
  })
  output$response <- renderUI({
    if(input$addSliderModule >0){

      lapply(1:input$addSliderModule, function(x){

        output[[paste("response", x)]] <- renderText({paste("Value of slider", x, ":", input[[paste0("slider-", x)]])})

        textOutput(paste("response", x))
      })
    }
  })
}

runApp(shinyApp(ui, server))

Answer 2

OK I have a partial solution that duplicates the module only once. The idea is to add the module UI and CallModule code inside the actionButton observer event.

Looks like you have to manually create x uiOutput() placeholder to duplicate the module x times.

I tried dynamically adding another uiOutput() insside renderUI() but that doesn't work.

here is the code to duplicate it once.

#Dynamically adding modules
library(shiny)

#slider module ------------------------
sliderUI <- function(id) {
  ns <- NS(id)
  tagList(
    sliderInput(ns("bins"), "Number of Bins:", min = 1, max = 5, value = 3),
    textOutput(ns("textBins"))  
  )
}

slider <- function(input, output, session) {
  output$textBins <- renderText({
    input$bins
  })
}


#shiny app ------------------------
ui <- fixedPage(
  fixedRow(
    column(width = 4, wellPanel(
      h4("Slider Module"),
      sliderUI("originalSlider"),
      actionButton("addSliderModule", "Add Slider Module"))
    ),
    column(width = 4, wellPanel(
      h4("Dynamic Loading Modules"),
      p("Clicking on the 'Add' button on the left should add the module here. You should be able to duplicate that slider module as many times as the button is clicked"),
      hr(),
      uiOutput("addModule"))
    )
  )
)

server <- function(input, output, session) {
  #server code for the original module
  callModule(slider, "originalSlider")

  #Here we add the UI and callModule of the duplicate module
  observeEvent(input$addSliderModule, {
    duplicateSliderid <- paste0("duplicateSlider", input$addSliderModule)

    output$addModule <- renderUI({
      sliderUI(duplicateSliderid)
    })
    callModule(slider, duplicateSliderid)

  })
}

shinyApp(ui, server)

Answer 3

Another answer that extends, what MySchizoBuddy has been doing. It might also not be fully satisfying, but it works.

I added a script, that simply moves all Elements from the dynamic creator to a target div. That way, dynamically creating elements does not erase those created before.

#Dynamically adding modules
library(shiny)

#slider module ------------------------
sliderUI <- function(id) {
  ns <- NS(id)
  tagList(
    sliderInput(ns("bins"), "Number of Bins:", min = 1, max = 5, value = 3),
    textOutput(ns("textBins"))  
  )
}

slider <- function(input, output, session) {
  output$textBins <- renderText({
    input$bins
  })
}


#shiny app ------------------------
ui <- fixedPage(
  fixedRow(
    column(width = 4, wellPanel(
      h4("Slider Module"),
      sliderUI("originalSlider"),
      actionButton("addSliderModule", "Add Slider Module"))
    ),
    column(width = 4, wellPanel(
      h4("Dynamic Loading Modules"),
      p("Clicking on the 'Add' button on the left should add the module here. You should be able to duplicate that slider module as many times as the button is clicked"),
      hr(),
      tags$script(HTML('
        Shiny.addCustomMessageHandler("moveModule", function(message) {
          var source = document.getElementById("addModule").childNodes;
          var target = document.getElementById("target");
          for (var i = 0; i < source.length; i++) {
            target.appendChild(source[i]);
          }
        })
      ')),
      tags$div(id = "target"),
      uiOutput("addModule"))
    )
  )
)

server <- function(input, output, session) {
  #server code for the original module
  callModule(slider, "originalSlider")

  #Here we add the UI and callModule of the duplicate module
  observeEvent(input$addSliderModule, {

    session$sendCustomMessage(type = "moveModule", message = "Something")

    duplicateSliderid <- paste0("duplicateSlider", input$addSliderModule)

    output$addModule <- renderUI({
      sliderUI(duplicateSliderid)
    })
    callModule(slider, duplicateSliderid)
  })
}

shinyApp(ui, server)

Answer 4

I think you'll find this solution more generic. First, it uses InsertUI instead of JavaScript (InsertUI has been introduced since the last response). However, I haven't found anyone presenting how to use the corresponding object produced by callModule in later reactive code elsewhere. Note that the bit inside renderText is the part that may need to be done quite differently depending on your goal (maybe using a for statement for example)

# user interface module----
numberInput = function(id, label = "Numeric input"){
  ns = NS(id)

  numericInput(ns("term"), label, value = 0)
}

#Module server logic
number = function(input, output, session){
  #just returns the expression for a reactive containing whatever you want (the relevant numericInput in this case)
  num_out = reactive({input$term})
  return(num_out)
}

# User interface ----
ui = fluidPage(
  titlePanel("Inserting UI and Callable Reactive using Modules"),
  actionButton('insertBtn', 'Insert module'),
  textOutput("total")
)

# Server logic
server = function(input, output, session) {
  num_values = reactiveValues()# this is basically a list that can store reactive expressions
  observeEvent(ignoreNULL = FALSE, #simple way of running module initially by allowing to run when button is at 0
               input$insertBtn, {
    btn = as.character(input$insertBtn + 1)#so first module will be labeled #1
    insertUI(
      selector = "#insertBtn",
      where = "afterEnd",
      ui = numberInput(btn,paste0('term #', btn))
    )
    num_values[[btn]] = callModule(number, btn)#stores the reactive expression from the call of the module related to the input inserted in a corresponding element of num_Values
  })
  output$total = renderText({
    num_vector = sapply(num_values, function(num_out){num_out()}) #calls each reactive expression in num_values (defined in the module) to get each input$term
    sum(num_vector) #sums all the numericInputs
  })
}

# Run the app
shinyApp(ui, server)