如何在 R shiny 中导航更长的选项卡？

Question

我有一个闪亮的应用程序，带有侧边栏菜单和几个不同的选项卡。在每个选项卡中，有很多内容应该一起看到，因此选项卡非常冗长，导航可能会很痛苦，因为需要大量滚动。但是，将内容拆分为子选项卡不是一种选择。

因此，我尝试将“位置标记”实现为假的子选项卡来导航，但我的努力没有成功。我在这里尝试做的是使用 shinys 函数 scroll.position 首先 select “位置标记”所在的选项卡，然后向下滚动到内容的位置。如您所见，这种方法的问题很简单，即 observeEvent 在函数内调用自身，因此永远不会在所需位置结束，而是转到该位置，然后返回选项卡顶部。

这是我尝试做的一个最小工作示例：

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)

解决这个问题的一种方法是阻止观察者从自身获取输入（我不知道如何）。如果您有不同的解决方案，我很乐意听取他们的意见！

提前致谢！

Answer 1

只需向下滚动到您想要前往的位置，如下所示。要向上滚动，您可以单击右下角的向上箭头（如图所示）或使用鼠标滚轮向上滚动。

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)
    )
    if ( sum(c("Not_an_actual_Tab_1","Not_an_actual_Tab_2") %in% input$Tabs)>0) {
      shinyjs::runjs("window.scrollTo(0, 900)")
    }

  })

}

shinyApp(ui = ui, server = server)

Answer 2

我找到了解决上述问题的方法。

您可以隐藏包含实际选项卡的菜单项，而是插入可以包含在观察器中的代理菜单项。这样，当代理菜单项被点击时，input$tabs 会再次被触发，你可以设置结果触发器切换到实际的选项卡并向上滚动到 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)

如何在 R shiny 中导航更长的选项卡？

How can I navigate longer tabs in R shiny?

r

shiny

shinydashboard