3

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?

3
  • 1
    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 8 at 0:03
  • 1
    @jantau thanks for the ping on my old post. I left an answer below. Cheers Apr 9 at 10:40
  • 1
    @MyNameisTK just FYI below is another approach. Apr 12 at 6:59

2 Answers 2

Reset to default

Trending sort

Trending sort is based off of the default sorting method — by highest score — but it boosts votes that have happened recently, helping to surface more up-to-date answers.

It falls back to sorting by highest score if no posts are trending.

2

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)
    if(!is.null(currentTab)){
      updateNavbarPage(session, "navbarID", selected = currentTab)
    }
  })
}

shinyApp(ui, server)

result

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)
    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)

result

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

5
  • 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 at 7:40
  • 1
    @jantau we can use mode = push in updateQueryString to enable browser navigation. Please see my edit. Apr 11 at 8: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 at 13:03
  • 1
    @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 by switching to mode = push. It should be fixed now. Apr 11 at 14:35
  • 1
    Excellent! Thanks a lot, this works great. Now, the "show next page" browser navigation works, too.
    – jantau
    Apr 11 at 15:29
1

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)
 
1
  • 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 8 at 16:01

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.