How to display the active tabs' name in a Shiny app when tabs where generated in the server using bslib::nav_insert()?

Question

(MRE is shown below) Given a Shiny application with a tabset (bslib::navset_tab) containing one static tab created in the UI, and some dynamic tabs created in the server, using bslib::insert(), and with the active tab name displaying in the sidebar of the app:

• If the static tab is active, the name of the tab is displayed as expected in the sidebar:

• However, if any of the dynamically created tabs is active, the name in the sidebar does not show up and remains NULL in the input variable:

What do I need to change to get the name of the active tab again in input variable input$all_tabs?

library(shiny)
library(bslib)

all_forms <- c("Dynamic Tab1", "Dynamic Tab2")

ui <- fluidPage(
  bslib::page_navbar(
    id = "all_tabs",
    sidebar = bslib::sidebar(textOutput("active_tab")), 
    bslib::nav_panel("static tab")
  ) 
)

server <- function(input, output, session) {
  lapply(all_forms, \(i){
    bslib::nav_insert(
      id = "all_tabs",
      bslib::nav_panel(i)
    )
  })
  
  output[["active_tab"]] <- renderText({
    input$all_tabs
  })
  
}

shinyApp(ui, server)

SessionInfo:

R version 4.3.1 (2023-06-16 ucrt)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 11 x64 (build 22621)

Matrix products: default


locale:
[1] LC_COLLATE=German_Germany.utf8  LC_CTYPE=German_Germany.utf8    LC_MONETARY=German_Germany.utf8 LC_NUMERIC=C                   
[5] LC_TIME=German_Germany.utf8    

time zone: Europe/Berlin
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices datasets  utils     methods   base     

other attached packages:
[1] bslib_0.5.1   shiny_1.7.5.1

loaded via a namespace (and not attached):
 [1] digest_0.6.33     later_1.3.1       R6_2.5.1          httpuv_1.6.12     fastmap_1.1.1     magrittr_2.0.3    cachem_1.0.8     
 [8] memoise_2.0.1     htmltools_0.5.6.1 lifecycle_1.0.3   promises_1.2.1    cli_3.6.1         xtable_1.8-4      sass_0.4.7       
[15] jquerylib_0.1.4   renv_1.0.3        compiler_4.3.1    rstudioapi_0.15.0 tools_4.3.1       ellipsis_0.3.2    mime_0.12        
[22] Rcpp_1.0.11       yaml_2.3.7        fs_1.6.3          jsonlite_1.8.7    rlang_1.1.1      

Answer 1

For some mysterious reason, changing the function shiny::fluidPage() to bslib::page_fluid() solves the problem for me. If anyone knows why, I would love to know.

library(shiny)
library(bslib)

all_forms <- c("Dynamic Tab1", "Dynamic Tab2")

ui <- bslib::page_fluid(
  bslib::page_navbar(
    id = "all_tabs",
    sidebar = bslib::sidebar(textOutput("active_tab")), 
    bslib::nav_panel("static tab")
  ) 
)

server <- function(input, output, session) {
  lapply(all_forms, \(i){
    bslib::nav_insert(
      id = "all_tabs",
      bslib::nav_panel(i)
    )
  })
  
  output[["active_tab"]] <- renderText({
    input$all_tabs
  })
  
}

shinyApp(ui, server)

Answer 2

One way to do it use do.call in a renderUI. Try this

library(shiny)
library(bslib)

all_forms <- c("Dynamic Tab1", "Dynamic Tab2")

link_shiny <- tags$a(
  shiny::icon("github"), "Shiny",
  href = "https://github.com/rstudio/shiny",
  target = "_blank"
)
link_posit <- tags$a(
  shiny::icon("r-project"), "Posit",
  href = "https://posit.co",
  target = "_blank"
)

ui <- fluidPage(
  uiOutput("all_tabs"),
  textOutput("active_tab")
)

server <- function(input, output, session) {
  
  output[["all_tabs"]] <- renderUI({
    do.call(page_navbar, c(title = "My App",
                           id = "all_tabs",
                           bg = "#0062cc",
                           list(
                             nav_panel(title = "One", p("First tab content.")),
                             nav_panel(title = "Two", p("Second tab content.")),
                             nav_panel(title = "Three", p("Third tab content"))),
                           lapply(all_forms, \(nav){bslib::nav_panel(nav, p(nav))}),
                           list(
                             nav_spacer(),
                             nav_menu(
                               title = "Links",
                               align = "right",
                               nav_item(link_shiny),
                               nav_item(link_posit)
                             )
                           )))
  })
  
  output[["active_tab"]] <- renderText({
    paste("You selected tab ",input$all_tabs)
  })
  
}

shinyApp(ui, server)