URI routing with shiny.router and navbarPage in a R shiny app

Question

I would like to use shiny.router to create shareable links to tabs of a shiny app that uses navbarPage and tabPanel.

Here is reproducible example that does not work:

library(shiny)
library(shiny.router)

page_1 <- tabPanel("Page 1", value = "page_1",
                   "This is Page 1")

page_2 <- tabPanel("Page 2", value = "page_2",
                   "This is Page 2")

router <- make_router(
  route("/", page_1),
  route("page2", page_2)
)

#+++++++++++++
# ui
#+++++++++++++

ui <- navbarPage("Dashboard", theme = shinytheme("flatly"), 

      router$ui
)

#+++++++++++++
# server
#+++++++++++++

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

shinyApp(ui, server)

It kind of works if I use for the ui part this code:

#+++++++++++++
# ui
#+++++++++++++

ui <- navbarPage("Dashboard", theme = shinytheme("flatly"),

  tabPanel(
    tags$ul(
      tags$li(a(href = route_link("/"), "Page 1")),
      tags$li(a(href = route_link("page2"), "Page 2"))
    ),
  router$ui
  )

)

But that does not leave me with a proper looking navbar. Is ist possible to use a navbarPage and tabPanel structure with shiny.router?

This is also my question! So far I've resorted to not using tabPanel but using fluidRow() and column() instead and then creating the navbar in CSS as shown in the shiny.router demo but I'd rather use navbar and shinythemes if possible. — MyNameisTK, Apr 08 '22 at 00:03
@jantau thanks for the ping on my old post. I left an answer below. Cheers — ismirsehregal, Apr 09 '22 at 10:40

ismirsehregal · Accepted Answer · 2022-12-21T10:57:52.147

The following is a slightly modified version of my answer here, which avoids using library(shiny.router).

The difference is using shiny::updateNavbarPage instead of shinydashboard::updateTabItems:

# remotes::install_github("rstudio/shinythemes")

library(shiny)
library(shinythemes)

ui <- navbarPage(title = "Dashboard", id = "navbarID", theme = shinytheme("flatly"), 
                 tabPanel("Page 1", value = "page_1", "This is Page 1"),
                 tabPanel("Page 2", value = "page_2", "This is Page 2")
)

server <- function(input, output, session){
  observeEvent(input$navbarID, {
    # http://127.0.0.1:3252/#page_1
    # http://127.0.0.1:3252/#page_2
    
    newURL <- paste0(
      session$clientData$url_protocol,
      "//",
      session$clientData$url_hostname,
      ":",
      session$clientData$url_port,
      session$clientData$url_pathname,
      "#",
      input$navbarID
    )
    updateQueryString(newURL, mode = "replace", session)
  })
  
  observe({
    currentTab <- sub("#", "", session$clientData$url_hash) # might need to wrap this with `utils::URLdecode` if hash contains encoded characters (not the case here)
    if(!is.null(currentTab)){
      updateNavbarPage(session, "navbarID", selected = currentTab)
    }
  })
}

shinyApp(ui, server)

The above is using clientData$url_hash - the same could be done with clientData$url_search as shown in my earlier answer.

Edit: using mode = "push" in updateQueryString for browser navigation:

library(shiny)
library(shinythemes)

ui <- navbarPage(title = "Dashboard", id = "navbarID", theme = shinytheme("flatly"), 
                 tabPanel("Page 1", value = "page_1", "This is Page 1"),
                 tabPanel("Page 2", value = "page_2", "This is Page 2")
)

server <- function(input, output, session){
  observeEvent(session$clientData$url_hash, {
    currentHash <- 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) # might need to wrap this with `utils::URLdecode` if hash contains encoded characters (not the case here)
    pushQueryString <- paste0("#", input$navbarID)
    if(is.null(currentHash) || currentHash != input$navbarID){
      freezeReactiveValue(input, "navbarID")
      updateQueryString(pushQueryString, mode = "push", session)
    }
  }, priority = 0)
}

shinyApp(ui, server)

Alternative using clientData$url_search and mode = "push":

library(shiny)
library(shinythemes)

ui <- navbarPage(title = "Dashboard", id = "navbarID", theme = shinytheme("flatly"),
                 tabPanel("Page 1", value = "page_1", "This is Page 1"),
                 tabPanel("Page 2", value = "page_2", "This is Page 2")
)

server <- function(input, output, session){
  observeEvent(getQueryString(session)$page, {
    currentQueryString <- getQueryString(session)$page # alternative: parseQueryString(session$clientData$url_search)$page
    if(is.null(input$navbarID) || !is.null(currentQueryString) && currentQueryString != input$navbarID){
      freezeReactiveValue(input, "navbarID")
      updateNavbarPage(session, "navbarID", selected = currentQueryString)
    }
  }, priority = 1)

  observeEvent(input$navbarID, {
    currentQueryString <- getQueryString(session)$page # alternative: parseQueryString(session$clientData$url_search)$page
    pushQueryString <- paste0("?page=", input$navbarID)
    if(is.null(currentQueryString) || currentQueryString != input$navbarID){
      freezeReactiveValue(input, "navbarID")
      updateQueryString(pushQueryString, mode = "push", session)
    }
  }, priority = 0)
}

shinyApp(ui, server)

PS: restoring a selected tab is also possible using shiny's bookmarking capabilities, as long as the navbarPage is provided with an id.

PPS: Here a related question on a navbarPage using secondary navigation can be found.

Thank you very much for the suggested solution. It is a pity that browser navigation does not work with this solution. However, it is worth a lot to me to have permanent tab links that I can share. And I am glad that I can continue to use navbarPage. — jantau, Apr 11 '22 at 07:40
@jantau we can use `mode = push` in `updateQueryString` to enable browser navigation. Please see my edit. — ismirsehregal, Apr 11 '22 at 08:37
Thank you so much for another addition to your answer. I noticed that the solution with browser navigation does not route directly to a tab of the dashboard if it was not cached before. It works without prior caching in your first answer (the one without browser navigation). Ideally I would like to have both: link directly to a tab and have browser navigation. Can you think of a way to combine both solutions? If not, I will use your first answer. — jantau, Apr 11 '22 at 13:03
@jantau - thanks for pointing this out - it was a initialization problem when `input$navbarID == NULL` on startup. I've had another look at the code and updated both approaches. Furhtermore, I accidentally introduced a [circular reference](https://mastering-shiny.org/action-dynamic.html#circular-references) by switching to `mode = push`. It should be fixed now. — ismirsehregal, Apr 11 '22 at 14:35
Excellent! Thanks a lot, this works great. Now, the "show next page" browser navigation works, too. — jantau, Apr 11 '22 at 15:29

score 3 · Answer 2 · answered Apr 08 '22 at 01:24

As a workaround I took class tags from shinytheme("flatly") source code and applied them individually to ul() and a(). I'd rather use navbarPage() if possible.

library(shiny)
library(shiny.router)


home_page <- div(
  titlePanel("Dashboard"),
  p("This is a dashboard page")
)

settings_page <- div(
  titlePanel("Settings"),
  p("This is a settings page")
)

contact_page <- div(
  titlePanel("Contact"),
  p("This is a contact page")
)


router <- make_router(
  route("/", home_page),
  route("settings", settings_page),
  route("contact", contact_page)
)


ui <- fluidPage(theme = shinytheme("flatly"),


tags$ul(class="navbar navbar-expand-lg navbar-dark bg-primary",
        a(class="navbar-brand", href = route_link("/"), "Dashboard"),
        a(class="navbar-brand", href = route_link("settings"), "Settings"),
        a(class="navbar-brand", href = route_link("contact"), "Contact")
        ),
router$ui
)

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

shinyApp(ui, server)

Thank you very much for the workaround. I am working on a complex dashboard that uses navbarPage and I would like to prevent major rebuilds of the dashboard. On a new project I would probably use your solution with fluidPage, because I think URI routing is really important for a good ux. — jantau, Apr 08 '22 at 16:01

URI routing with shiny.router and navbarPage in a R shiny app

2 Answers2

Linked