Search code examples
rshinyshinydashboard

How can I navigate longer tabs in R shiny?


I have a shiny app with a sidebar menue and several different tabs. Within each tab, there is a lot of content that is supposed to be seen toghether, so the tabs are quite lengthy and navigating can be a pain because a lot of scrolling is needed. However, spliting the content into sub-tabs is not an option.

I have thus tried to implement "location markers" as fake sub-tabs to navigate through, but my efforts have been unsuccessful. What Im trying to do here is to use the shinys function scroll.position to first select the tab the "location marker" is located on, and then scroll down to the position of the content. As you can see, the problem with this approach is simply that the observeEvent calls itself within the function and can thus never end at the desired position, but instead goes to that position and then back to the top of the tab.

Here is a minimal working example of what Im trying to do:

library(shiny)
library(shinydashboard)
library(shinyjs)

ui <- dashboardPage(
                    dashboardHeader(title = "Dashboard", titleWidth = 350),
                    dashboardSidebar(
                      width = 350, 
                      disable = FALSE,
                      sidebarMenu(id = "Tabs", 
                                  menuItem(text = "This is basically just the header for the first tab",
                                           tabName = "Tab_Menue",
                                             menuSubItem(text = "This is the actual tab",
                                                         tabName = "Tab_1"
                                                         ),
                                             menuSubItem(text = "This is just for navigating the page",
                                                         tabName = "Not_an_actual_Tab_1"
                                                         )
                                           ),
                                  menuItem(text = "This is the header for the 2nd tab",
                                           tabName = "Tab_Menue",
                                             menuSubItem(text = "This is the 2nd actual tab",
                                                         tabName = "Tab_2"
                                                         ),
                                             menuSubItem(text = "This is just for navigating the page in tab 2",
                                                         tabName = "Not_an_actual_Tab_2"
                                                         )
                                  )
                            )
                      ),
                    dashboardBody(
                                  useShinyjs(),
                                  extendShinyjs(text = 'shinyjs.scrollposition = function(y) {window.scrollTo(0, y)};',
                                                functions = c("scrollposition")),
                                  tabItems(
                                    tabItem(
                                            tabName = "Tab_1",
                                            h2("Some content up here that I want to navigate to with Tab_1"),
                                            br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),
                                            br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),
                                            br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),
                                            br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),
                                            h2("Some content on the same tab/page that I want to navigate to with Not_an_actual_Tab_1")
                                    ),
                                    tabItem(
                                      tabName = "Tab_2",
                                      h2("Some content up here that I want to navigate to with Tab_2"),
                                      br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),
                                      br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),
                                      br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),
                                      br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),
                                      h2("Some content on the same tab/page that I want to navigate to with Not_an_actual_Tab_2")
                                    )
                                  )
                         )
)


server <- function(input, output, session) {
  
  observeEvent(input$Tabs, {
    print(input$Tabs) 
    updateTabsetPanel(session, "Tabs", switch(input$Tabs,
                                              "Not_an_actual_Tab_1" = "Tab_1",
                                              "Not_an_actual_Tab_2" = "Tab_2",
                                              input$Tabs)
    )
    js$scrollposition(switch(input$Tabs,
                             "Not_an_actual_Tab_1" = 900,
                             "Not_an_actual_Tab_2" = 900,
                             0)
    )
    
    
  })
  
}

shinyApp(ui = ui, server = server)

One way to solve this would be to stop the observer from taking input from itself (I dont know how). If you have different solutions, I would be glad to hear them!

Thanks in advance!


Solution

  • I found a workaround to my problem described above.

    You can hide the menue items containing the actual tabs and instead insert proxy menu items which can be included in the observer. This way, input$tabs is triggered again when the proxy menu item is clicked and you can set the resulting trigger to switch to the actual tab and scroll up to 0.

    library(shiny)
    library(shinydashboard)
    library(shinyjs)
    
    ui <- dashboardPage(
        dashboardHeader(title = "Dashboard", titleWidth = 350),
        dashboardSidebar(
            width = 350, 
            disable = FALSE,
            sidebarMenu(id = "Tabs", 
                        menuItem(text = "This is basically just the header for the first tab",
                                 tabName = "Tab_Menue",
                                 hidden(menuSubItem(text = "This is the actual tab",
                                                    tabName = "Tab_1"
                                 )),
                                 menuSubItem(text = "This navigates to the top of Tab 1",
                                             tabName = "Proxy_Tab_1"
                                 ),
                                 menuSubItem(text = "This is just for navigating the page",
                                             tabName = "Not_an_actual_Tab_1"
                                 )
                        ),
                        menuItem(text = "This is the header for the 2nd tab",
                                 tabName = "Tab_Menue",
                                 hidden(menuSubItem(text = "This is the 2nd actual tab",
                                                    tabName = "Tab_2"
                                 )),
                                 menuSubItem(text = "This navigates to the top of Tab 2",
                                             tabName = "Proxy_Tab_2"
                                 ),
                                 menuSubItem(text = "This is just for navigating the page in tab 2",
                                             tabName = "Not_an_actual_Tab_2"
                                 )
                        )
            )
        ),
        dashboardBody(
            useShinyjs(),
            extendShinyjs(text = 'shinyjs.scrollposition = function(y) {window.scrollTo(0, y)};',
                          functions = c("scrollposition")),
            tabItems(
                tabItem(
                    tabName = "Tab_1",
                    h2("Some content up here that I want to navigate to with Tab_1"),
                    br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),
                    br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),
                    br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),
                    br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),
                    h2("Some content on the same tab/page that I want to navigate to with Not_an_actual_Tab_1")
                ),
                tabItem(
                    tabName = "Tab_2",
                    h2("Some content up here that I want to navigate to with Tab_2"),
                    br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),
                    br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),
                    br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),
                    br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),
                    h2("Some content on the same tab/page that I want to navigate to with Not_an_actual_Tab_2")
                )
            )
        )
    )
    
    
    server <- function(input, output, session) {
        
        observeEvent(input$Tabs, {
            
            if(sum(c("Proxy_Tab_1", "Proxy_Tab_2","Not_an_actual_Tab_1", "Not_an_actual_Tab_2") %in% input$tabs) > 0) {
                updateTabsetPanel(session, "Tabs", switch(input$Tabs,
                                                          "Proxy_Tab_1" = "Tab_1",
                                                          "Proxy_Tab_2" = "Tab_2",
                                                          "Not_an_actual_Tab_1" = "Tab_1",
                                                          "Not_an_actual_Tab_2" = "Tab_2",
                                                          input$Tabs)
                )
                js$scrollposition(switch(input$Tabs,
                                         
                                         "Not_an_actual_Tab_1" = 900,
                                         "Not_an_actual_Tab_2" = 900,
                                         0)
                )
                
            }
        })
        
    }
    
    shinyApp(ui = ui, server = server)