How to run two for loops inside an observeEvent?

Question

I have an app that dynamically creates plots and updates the input values. The app is working, but I have to load the plots and then load the values requiring two action buttons and observeEvents.

I tried to put two for loops that were used to create the plots and to update the values using the Load All actionButton, but they don't appear to work together in the observeEvent. I also tried converting the for loop into an lapply but it didn't work.

library(shiny)

histogramUI <- function(id,var,bins) {
  tagList(
    fluidRow(column(4, selectInput(NS(id, "var"), "Variable", choices = names(mtcars),selected=var),
                    numericInput(NS(id, "bins"), "bins", value = bins, min = 1)),
             column(8, plotOutput(NS(id, "hist"))))
  )
}

histogramServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    data <- reactive(mtcars[[input$var]])
    output$hist <- renderPlot({
      hist(data(), breaks = 10, main = input$var)
    }, res = 96)
  })
}


ui <- 
  fluidPage(
    actionButton("load_plots", "Load Plots"),
    actionButton("load_values", "Load Values"),
    actionButton("load_all", "Load All"),
    div(id = "add_here")
  )

server <- function(input, output, session) {
  
  a <- list("hist_1-var" = "hp", 
            "hist_2-var" = "cyl", 
            "hist_3-var" = "am", 
            "hist_4-var" = "disp", 
            "hist_5-var" = "wt")
  
  modules <- c("add", "hist_1", "hist_2", "hist_3", "hist_4", "hist_5")
  
  
  
  observeEvent(input$load_plots, {
    
    bins <- 10
    if (length(modules)>1) {
      for (i in 1:(length(modules))) {
        if (substr(modules[i],1,4)=='hist') {
          histogramServer(modules[i])
          insertUI(selector = "#add_here", ui = histogramUI(modules[i],paste0(modules[i],"-var"),paste0(modules[i],"-bin")))
        }
      }
    }
  })
  
  observeEvent(input$load_values, {
    
    for (i in 1:length(a)) {
      updateSelectInput(session, inputId = names(a[i]), choices = names(mtcars), selected = a[[i]])
    }
  })
  
  observeEvent(input$load_all, {
    bins <- 10
    if (length(modules)>1) {
      lapply(seq_along(modules),
             function(i) {
               if (substr(modules[i],1,4)=='hist') {
                 histogramServer(modules[i])
                 insertUI(selector = "#add_here", ui = histogramUI(modules[i],paste0(modules[i],"-var"),paste0(modules[i],"-bin")))
               }
               }
      )
      }
    
    lapply(seq_along(a),
           function(k) {
             for (i in 1:length(a)) {
               updateSelectInput(session, inputId = names(a[i]), choices = names(mtcars), selected = a[[i]])
             }
           }
    )
    
 #   if (length(modules)>1) {
 #     for (i in 1:(length(modules))) {
 #       
 #       if (substr(modules[i],1,4)=='hist') {
 #         histogramServer(modules[i])
 #         insertUI(selector = "#add_here", ui = histogramUI(modules[i],paste0(modules[i],"-var"),paste0(modules[i],"-bin")))
 #       }
 #     }
 #   }
 #   
 #   for (i in 1:length(a)) {
 #     updateSelectInput(session, inputId = names(a[i]), choices = names(mtcars), selected = a[[i]])
 #   }    
  })
}

shinyApp(ui, server, enableBookmarking = "server")

Answer 1

I will answer precisely to your question. The default insertUI is evaluated in a delayed manner. You need to use immediate argument like that insertUI(..., immediate = TRUE) to force an immediate evaluation.

Precisely in your case.

insertUI(selector = "#add_here", 
                     ui = histogramUI(modules[i], paste0(modules[i], "-var"), paste0(modules[i], "-bin")), 
                     immediate = TRUE)

Answer 2

For the initial insert you'll need to make the pre-selected variable available to the server. Otherwise the server will try to access input$var, which does not exists yet (NULL). The same applies to the bins.

Please check the following:

library(shiny)

histogramUI <- function(id, selected_var, selected_bins, module_choices) {
  tagList(fluidRow(
    column(
      4,
      selectInput(
        NS(id, "var"),
        "Variable",
        choices = module_choices,
        selected = selected_var
      ),
      numericInput(NS(id, "bins"), "bins", value = selected_bins, min = 1)
    ),
    column(8, plotOutput(NS(id, "hist")))
  ))
}

histogramServer <- function(id, selected_var, selected_bins, module_choices) {
  moduleServer(id, function(input, output, session) {
    var <- reactive({
      if(is.null(input$var)){
        selected_var
      } else {
        var <- input$var
      }
    })
    
    bins <- reactive({
      if(is.null(input$bins)){
        selected_bins
      } else {
        bins <- input$bins
      }
    })
    
    data <- reactive({
      mtcars[[which(module_choices == var())]]
    })
    
    output$hist <- renderPlot({
      hist(data(), breaks = bins(), main = var())
    }, res = 96)
  })
}

ui <- fluidPage(
  actionButton("load_all", "Load All"),
  div(id = "add_here")
)

server <- function(input, output, session) {
  observeEvent(input$load_all, {
    
    modules <- c("hist_1", "hist_2", "hist_3", "hist_4", "hist_5")
    module_choices <- paste0(modules, "-var")
    names(module_choices) <- colnames(mtcars)[seq_along(module_choices)]
    bins <- 11
    
    if (length(modules) > 1) {
      lapply(seq_along(modules), function(i) {
        histogramServer(modules[i], module_choices[i], bins, module_choices)
        insertUI(
          selector = "#add_here",
          ui = histogramUI(modules[i], module_choices[i], bins, module_choices)
        )
      })
    }
  })
}

shinyApp(ui, server, enableBookmarking = "server")