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

Question

我正在尝试创建一个包含过多页面的 R Shiny 网站(它应该基于教科书。)请注意，我在网络开发方面经验不足。我主修统计和数学，因此使用了 R。

我决定使用 R Shiny Router因为它似乎最适合我的多页用途。

但是，我真的很感激第二个导航栏。我看到了this tutorial使用具有辅助导航功能的 navbarPage() 和 navbarMenu()。这太棒了，这样我就可以轻松地将每一页分成几个部分!

目前我的路由器如下所示:

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)

我天真地尝试了以下方法，希望它能起作用(注意我现在只用一个部分 3.2 测试了它)

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
)

我得到这个错误:

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.

对我来说，如果我需要使用 navbarMenu() 和/或 navbarPage()，我似乎必须使用 tabPanel()，由于我的代码太长，我不想使用它。

请告诉我是否有一种方法可以使辅助导航栏与 R Shiny Router 兼容？感谢任何回答的人!

编辑:为了更清楚我正在寻找的输出，我正在寻找以下内容:

目前我只有每一页，即主页、第 3.2.1 节、第 3.2.2 节、...、第 3.3.2 节、联系人，都在页面顶部。这是困惑且不可持续的，因为我需要添加第 4 节和第 5 节。

Answer 1

似乎 library(shiny.router) 使用的路由方法不适合将其与 navbarPage 上的选择同步，因为我们不能使用 router$ui 多次作为 tabPanel 的子项。

但是，我们可以使用 basic shiny 进行路由，如前所述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)