使用辅助导航的 shiny.router 和 navbarPage 的 URI 路由

Question

I am trying to create an R shiny website with a plethora of pages (it is supposed to be based off of a textbook.) Note that I am not that experienced in web-development. I am a statistics & math major, hence the use of R.

I have decided to use R Shiny Router since it seems the best for my multi-page purpose.

However, I would really appreciate a second navigation bar. I saw this tutorial using navbarPage() and navbarMenu() that has a secondary navigation feature. This would be awesome so I can easily divide each page by sections!

Currently my router looks like the following:

library(shiny)
library(shiny.router)

router = make_router(
  route("/", div("home_page")),
  route("section_3.2.1", div("page_3.2.1")),
  route("section_3.2.2", div("page_3.2.2")),
  route("section_3.2.3", div("page_3.2.3")),
  route("section_3.2.4", div("page_3.2.4")),
  route("section_3.3.1", div("page_3.3.1")),
  route("section_3.3.2", div("page_3.3.2")),
  route("contact", div("contact_page"))
)

ui = fluidPage(
  theme = "main.css",
  tags$ul(
    tags$li(a(href = route_link("/"), "Home Page")),
    tags$li(a(href = route_link("section_3.2.1"), "Section 3.2.1")),
    tags$li(a(href = route_link("section_3.2.2"), "Section 3.2.2")),
    tags$li(a(href = route_link("section_3.2.3"), "Section 3.2.3")),
    tags$li(a(href = route_link("section_3.2.4"), "Section 3.2.4")),
    tags$li(a(href = route_link("section_3.3.1"), "Section 3.3.1")),
    tags$li(a(href = route_link("section_3.3.2"), "Section 3.3.2")),
    tags$li(a(href = route_link("contact"), "Contact Page"))
  ),
  router$ui
)

server <- function(input, output, session) {
  router$server(input, output, session)
}

shinyApp(ui, server)

I naively tried the following, hoping it would work (note I just tested it with one section, 3.2, for now)

ui = navbarPage("Website Title",
     theme = "main.css",
       tags$ul(
         tags$li(a(href = route_link("/"), "Home Page")),
         tags$li(a(href = route_link("contact"), "Contact Page"))
       ),
     navbarMenu("Section 3.2",
        tags$ul(
          tags$li(a(href = route_link("section_3.2.1"), "Section 3.2.1")),
          tags$li(a(href = route_link("section_3.2.2"), "Section 3.2.2")),
          tags$li(a(href = route_link("section_3.2.3"), "Section 3.2.3")),
          tags$li(a(href = route_link("section_3.2.4"), "Section 3.2.4")),
        )),
    router$ui
)

I obtain this error:

Error: 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.
In addition: Warning messages:
1: 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.
2: 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.

To me, it seems like if I need to use navbarMenu() and/or navbarPage(), I must use tabPanel(), which I don't want to due to the length of my code.

Please let me know if there's a method to have a secondary navigation bar that is compatible with R Shiny Router? Thanks to anyone who answers!

Edit: to make it more clear with what output I'm looking for exactly, I'm looking for the following:

Currently I just have every single page, ie, home, section 3.2.1, section 3.2.2, ..., section 3.3.2, contact, all on top of the page. This is messy and unsustainable because I need to add sections 4 and 5.

Answer 1

It seems the routing approach library(shiny.router) uses is not suitable to synchronize it with the selections made on a navbarPage , as we can't use router$ui as a child of tabPanel multiple times.

However, we can do the routing using basic shiny as already explained here :

library(shiny)

ui <- navbarPage(title = "My Application",
                 tabPanel("Home", "Home content"),
                 navbarMenu("Section 3.2",
                            # To avoid the need to parse encoded URLs via utils::URLdecode use e.g.:
                            # tabPanel(title = "Section 3.2.1", "3.2.1 content", value = "section_3.2.1"),
                            tabPanel("Section 3.2.1", "3.2.1 content"),
                            tabPanel("Section 3.2.2", "3.2.2 content"),
                            tabPanel("Section 3.2.3", "3.2.3 content"),
                            tabPanel("Section 3.2.4", "3.2.4 content")
                 ),
                 navbarMenu("Section 3.3",
                            tabPanel("Section 3.3.1", "3.3.1 content"),
                            tabPanel("Section 3.3.2", "3.3.2 content")
                 ),
                 tabPanel("Contact", "Contact content"),
                 id = "navbarID",
                 theme = "main.css"
)

server <- function(input, output, session) {
  observeEvent(session$clientData$url_hash, {
    currentHash <- utils::URLdecode(sub("#", "", session$clientData$url_hash))
    if(is.null(input$navbarID) || !is.null(currentHash) && currentHash != input$navbarID){
      freezeReactiveValue(input, "navbarID")
      updateNavbarPage(session, "navbarID", selected = currentHash)
    }
  }, priority = 1)
  
  observeEvent(input$navbarID, {
    currentHash <- sub("#", "", session$clientData$url_hash)
    pushQueryString <- paste0("#", input$navbarID)
    if(is.null(currentHash) || currentHash != input$navbarID){
      freezeReactiveValue(input, "navbarID")
      updateQueryString(pushQueryString, mode = "push", session)
    }
  }, priority = 0)
}

shinyApp(ui, server)