RShiny adding a module within a loop, based on user input

101 views Asked by At

I want to make an RShiny app where the user can select a folder, and then add a navbarMenu containing as many tabPanels as there are files in the selected folder. The tabPanels are made with a module. Here is an app with a button that adds just one tab with one call to the module:

library(shiny)

mod_tabPanel_ui <- function(id, title) {
  ns <- NS(id)
  tabPanel(
    title = title,
    fluidPage(
      h1("Module UI goes here")
    )
  )
}

mod_tabPanel_server <- function(id) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
  })
}

ui <- navbarPage(
  title = "Main Title",
  id = "tabs",
  tabPanel(
    id = "home",
    title = "Home",
    actionButton(
      inputId = "add_tab",
      label = "Add tab"
    )
  )
)


server <- function(input, output, session) {
  ## other server logic goes here
  observeEvent(input$add_tab, {
    appendTab(
      inputId = "tabs",
      navbarMenu(
        title = "new tab",
        mod_tabPanel_ui("mod1", "Module 1")
      )
    )
    mod_tabPanel_server("mod1")
  })
}

shinyApp(ui, server)

The add_tab actionButton makes a new navbarMenu using the appendTab function with one call to the module mod_tabPanel_ui+mod_tabPanel_server.

Now what I want to be able to do is something like this, where the 1:3 in the for loop will be replaced with 1:number of files:

server <- function(input, output, session) {
  ## other server logic goes here
  observeEvent(input$add_tab, {
    appendTab(
      inputId = "tabs",
      navbarMenu(
        title = "new tab",
        # mod_tabPanel_ui("mod1", "Module 1")
        for (i in 1:3) {
          mod_tabPanel_ui(paste("mod1", i), paste("Module", i))
        }
      )
    )
    for (i in 1:3) {
      mod_tabPanel_server(paste("mod1", i))
    }
  })
}

But this results on the module never appearing in the new tabs.

I've been told that it is possible to do by using assign and environment like so:

server <- function(input, output, session) {
  shiny_env <- environment()
  ## other server logic goes here
  observeEvent(input$add_tab, {
    appendTab(
      inputId = "tabs",
      navbarMenu(
        title = "new tab",
        lapply(1:3, function(i) {
          mod_tabPanel_ui(paste("mod1", i), paste("Module", i))
        })
      )
    )
    for (i in 1:3) {
      assign(paste0("dynamic_server_", i),
             mod_tabPanel_server(paste0("exp", i)),
             envir = shiny_env)
    }
  })
}

But this give the error message:

Warning: Error in : Navigation containers expect a collection of bslib::nav()/shiny::tabPanel()s and/or bslib::nav_menu()/shiny::navbarMenu()s. Consider using header or footer if you wish to place content above (or below) every panel's contents.

Which does not really help me. Reading the observeEvent documentation makes me think that the problem is that the module is being created in the wrong environment of something along those lines.

1

There are 1 answers

0
Quillox On

Got it working with do.call and lapply:

server <- function(input, output, session) {
  ## other server logic goes here
  observeEvent(
    eventExpr = input$add_tab,
    handlerExpr = {
      n_mods <- 3
      appendTab(
        inputId = "tabs",
        do.call(
          what = navbarMenu,
          args = c(
            lapply(seq_len(n_mods), function(i) {
              mod_tabPanel_ui(
                id = paste0("mod", i),
                title = paste("Module", i)
              )
            }),
            list(title = "Tab title")
          )
        )
      )
      lapply(seq_len(n_mods), function(i) {
        mod_tabPanel_server(paste0(id = "mod", i))
      })
    }
  )
}