Use updateTabsetPanel to go to a tabPanel created with renderUI

[vnijs]

Can you use updateTabsetPanel to navigate to tab sub2?

library(shiny)
runApp(list(
  ui = shinyUI(
    navbarPage( "test", id = 'someID',
                tabPanel("tab1", h1("page1")),

                navbarMenu( "menu",
                            tabPanel('tab2a',  value='foo', h1("page2a")),
                            tabPanel('tab2b',  value='bar', h1("page2b")),
                            # tabPanel('tab_sub',  value='sub', uiOutput("sub_tabPanel"))
                            tabPanel('tab_sub',  uiOutput("sub_tabPanel"))
                )
    )),

  server = function(input, output, session) {
    observe(print(input$someID))

    output$sub_tabPanel <- renderUI({
      tabsetPanel(
        tabPanel("Summary", value = "sub1", h1("sub1")),
        tabPanel("Plot", value = "sub2", h2("sub2"))
      )
    })

    # updateTabsetPanel(session, 'someID', 'sub')
    updateTabsetPanel(session, 'someID', 'sub2')
    # updateTabsetPanel(session, 'someID', 'sub')
    # updateTabsetPanel(session, 'sub', 'sub2')
  }
))

[wch]

I think the issue here is one of timing - the updateTabsetPanel gets called immediately, and this is before the output value is sent to the client. We've discussed (optionally) putting update calls in the same queue as regular outputs. If we do that it should provide a solution for this problem.

Edit: it turns out that we had discussed this for sendCustomMessage, not the update* functions: #665. But I think it makes sense to implement it for both cases.

[vnijs]

Thanks for the update @wch. Just to be clear, I'm hoping to use updateTabsetPanel for navigation in a multi-page app so you could provide a url that would take a user to a specific tab within an app.

A related approach is mentioned here. @jcheng5 commented on that approach here. If there are other alternatives or approaches in the works please let me know

[jcheng5]

I'm in a hurry so pardon if I'm missing something.

• @wch I don't think using queues would solve this, as updateTabsetPanel is still being called before the renderUI would be invoked. It would only work if the update calls were put in a queue after the outputs, and I'm not sure that's a sensible move.
• @vnijs What if you just provide the proper selected argument to tabsetPanel?

[vnijs]

@jcheng5 I'd like to create links that can point to any (sub) tab. I expect that hard-coding sub2 in the example using selected in tabsetPanel would always take the user to sub2 so you can't link to sub1.

I'm thinking of something like updateTabsetPanel with a (possible) extra argument for a sub-tab. Something like updateTabsetPanel(session, 'someID', 'tab_sub', 'sub2')

[jcheng5]

I didn't mean selected should be hard coded--you can figure out the desired
subtab during renderUI time, can't you?

On Mon, Jun 1, 2015 at 6:01 PM Vincent Nijs notifications@github.com
wrote:

@jcheng5 https://github.com/jcheng5 I'd like to create links that can
point to any (sub) tab. I expect that hard-coding sub2 in the example
using selected in tabsetPanel would always take the user to sub2 so you
can't link to sub1.

I'm thinking of something like updateTabsetPanel with a (possible) extra
argument for a sub-tab. Something like `updateTabsetPanel(session,
'someID', 'tab_sub', 'sub2')

—
Reply to this email directly or view it on GitHub
#772 (comment).

[vnijs]

Interesting idea @jcheng5 (cc @wch). I hacked something up that seems to work (see below). If the url query is ?url=tab_sub/Plot the user is taken to the appropriate page. Comments/suggestions on how to improve? For example, it would be nice to get rid of the ?url= part.

A great enhancement would be to change the url as the user is browsing. I assume that would require something like the setUrl function suggested here. Function also copied below.

library(shiny)

url1 <- url2 <- ""

runApp(list(
  ui = shinyUI(
    navbarPage( "test", id = 'someID',
                tabPanel("tab1", h1("page1")),

                navbarMenu( "menu",
                            tabPanel('tab2a',  value='foo', h1("page2a")),
                            tabPanel('tab2b',  value='bar', h1("page2b")),
                            tabPanel('tab_sub',  uiOutput("sub_tabPanel"))
                )
    )),

  server = function(input, output, session) {
    observe(print(input$someID))

    output$sub_tabPanel <- renderUI({
      tabsetPanel(
        tabPanel("Summary", h1("sub1")),
        tabPanel("Plot", h2("sub2")),
        selected = ifelse(url2 == "", "Summary", url2)
      )
    })

    observe({
      # suppose url is http://127.0.0.1:5682/?url=tab_sub/Plot
      query <- parseQueryString(session$clientData$url_search)
      if(!is.null(query$url)) {
        url <- strsplit(query$url,"/")[[1]]
        url1 <<- url[1]
        url2 <<- url[2]
        updateTabsetPanel(session, 'someID', url1)
      }
    })
  }
))

Shiny.addCustomMessageHandler('setURL',
    function(data) {
        // make each key and value URL safe (replacing spaces, etc.), then join
        // them and put them in the URL
        var search_terms = [];
        for (var key in data) {
            search_terms.push(encodeURIComponent(key) + '=' + encodeURIComponent(data[key]));
        }
        window.history.pushState('object or string', 'Title', '/?' + search_terms.join('&'));
    }
);

[daattali]

@vnijs I was able to come up with a (non-pretty) solution for navigating to any tab, no matter how deep it is. The basic idea is that I keep track of how deep I navigated so far and I look at the url, and until I get to the same depth, I update the next tabpanel in the list. Because they don't update right away and you can't update a tabpanel that's not visible, there's some logic that makes it ignore until the tab was properly switched. For this idea to work, you need to follow a certain naming scheme for the tabs: if you have a tabpanel inside a tab with id/value of "sometab", then the id of the tabpanel must be "sometab_tabs". It's a bit restrictive but it works I think.

I didn't deal with the other issue of saving the current tab history, that can certainly be solved as well, but this seemed like a fun problem and I wanted to try it. It is a bit ugly so maybe you won't use it, but here's my attempt :)
Here is an expansion of your previous code

library(shiny)

url1 <- url2 <- ""

runApp(list(
  ui = shinyUI(
    navbarPage( "test", id = 'someID',
                tabPanel("tab1", h1("page1")),

                navbarMenu( "menu",
                            tabPanel('tab2a',  value='foo', h1("page2a")),
                            tabPanel('tab2b',  value='bar', h1("page2b")),
                            tabPanel('tab_sub',  uiOutput("sub_tabPanel"))
                ),
                tabPanel("tab3", h1("page3"))
    )),

  server = function(input, output, session) {

    output$sub_tabPanel <- renderUI({
      tabsetPanel(id = "tab_sub_tabs",
        tabPanel("Summary", h1("sub1")),
        tabPanel(
          "Plot", h2("sub2"),
          tabsetPanel(
            id = "Plot_tabs",
            tabPanel("plot1", "plot1"),
            tabPanel("plot2", "plot2")
          )
        )          
      )
    })    

    values <- reactiveValues(myurl = c(), parent_tab = "")

    observe({
      # make sure this is called on pageload (to look at the query string)
      # and whenever any tab is successfully changed.
      # If you want to stop running this code after the initial load was
      # successful so that further manual tab changes don't run this,
      # maybe just have some boolean flag for that.

      input$someID
      input$tab_sub_tabs
      query <- parseQueryString(session$clientData$url_search)
      url <- query$url
      if (is.null(url)) {
        url <- ""
      }

      # "depth" is how many levels the url in the query string is
      depth <- function(x) length(unlist(strsplit(x,"/")))

      # if we reached the end, done!
      if (length(values$myurl) == depth(url)) {
        return()
      }
      # base case - need to tell it what the first main nav name is
      else if (length(values$myurl) == 0) {
        values$parent_tab <- "someID"
      }
      # if we're waiting for a tab switch but the UI hasn't updated yet
      else if (is.null(input[[values$parent_tab]])) {
        return()
      }
      # same - waiting for a tab switch
      else if (tail(values$myurl, 1) != input[[values$parent_tab]]) {
        return()
      }
      # the UI is on the tab that we last switched to, and there are more
      # tabs to switch inside the current tab
      # make sure the tabs follow the naming scheme
      else {
        values$parent_tab <- paste0(tail(values$myurl, 1), "_tabs")
      }

      # figure out the id/value of the next tab
      new_tab <- unlist(strsplit(url, "/"))[length(values$myurl)+1]

      # easy peasy.
      updateTabsetPanel(session, values$parent_tab, new_tab)
      values$myurl <- c(values$myurl, new_tab)
    })
  }
))

[vnijs]

That was really useful @daattali. Thanks. Based on your setup I created the solution below. Observers are created (and disabled) as needed. @jcheng5 @wch Do you see any problems with this approach?

I'm now working on putting information about the active tab back into the url. I expect this will require reversing the order of the key:value pairs in the url_patterns list below (see SO question) and session$sendCustomMessage.

url_patterns <- list(
  "base/single-mean/" = list("nav_radiant" = "Single mean", "tabs_single_mean" = "Summary"),
  "base/single-mean/plot/" = list("nav_radiant" = "Single mean", "tabs_single_mean" = "Plot"),
  "sample/sampling/"    = list("nav_radiant" = "Sampling"),
  "sample/sample-size/" = list("nav_radiant" = "Sample size")
)

observe({
  url_query <- parseQueryString(session$clientData$url_search)
  if (!"url" %in% names(url_query)) return()

  ## create an observer and suspend when done
  url_observe <- observe({
    url <- url_patterns[[url_query$url]]
    if (is.null(url)) {
      ## if pattern not found suspend observer
      url_observe$suspend()
      return()
    }
    for(u in names(url)) {
      if(is.null(input[[u]])) return()
      if(input[[u]] != url[[u]])
        updateTabsetPanel(session, u, selected = url[[u]])
      if(names(tail(url,1)) == u) url_observe$suspend()
    }
  })
})

[jcheng5]

I'm sorry, I don't have the bandwidth to review this right now... I'm busy trying to close down leaflet and d3heatmap in preparation for useR. If you still need a review in the second week of July, ping me then :)

[vnijs]

What I have seems to working ok so I'll close this.

[fabiangehring]

I'm facing a similar problem. I can update the url using the java script snippet above, but unfortunately the observe-part of session$clientData$url_search is not executed.

I have a navbar which initially containing a single navbarMenu with several (sub)entries. Whenever I chose one of the menu-entries I'd like to create a (new) tabPanel (next to the initial navbarMenu) which is focused.

I think all the above code should make this possible, but I can't figure it out. Will this be possible? Do you have some hints / minimal examples?

[vnijs]

I don't have a minimal example. The relevant code is here:

https://github.com/vnijs/radiant/blob/master/inst/base/init.R#L169-L316