Question

我正在开发一个具有多个选项卡（大约10个）的闪亮应用程序，每个选项卡包含较长的内容（必须滚动每个选项卡）。当用户向下滚动一个选项卡上的页面，然后从侧栏菜单中选择另一个选项卡时，新选项卡将在主面板中加载与前一个选项卡相同的滚动位置。我希望每次在侧栏菜单上单击tabItem时，主面板（仪表板主体）都将返回到页面顶部。

我已经尝试了一些使用Shinyjs的解决方案，但是对于javascript我是一个完全的新手。我在这里尝试使用侧边栏标题（选项卡）的div名称成功实现的另一个问题中找到了以下代码：

tags$script(" $(document).ready(function () {
            $('#tabs a[data-toggle=\"tab\"]').bind('click', function (e) {
            $(document).load().scrollTop(0);
            });

            });")

上面的代码将仅在应用程序的侧面菜单部分中运行。由于js代码中意外的类问题，将其放置在dashboardPagePlus（）代码或dashboardBody（）部分中会引发错误。我还尝试对div参考中的一个特定选项卡使用代码，以查看是否只能使一个选项卡工作，但无济于事（使用“＃shiny-tab-subtab1”而不是“ tabs”）。

下面是一个有效的示例。我在每个选项卡中放置了一些特别高的图，以便在尝试解决方案时可以测试滚动行为。我很确定这需要JavaScript解决方案。您能提供的任何帮助将不胜感激！

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(tidyverse)
library(datasets)
library(shinyjs)

data <- data.frame(x=c(0,1,2,3,4), y = c(0,1,2,3,4))

ui <- 
  dashboardPagePlus(
skin = "green",
header = dashboardHeaderPlus(disable = FALSE,
                             title = "ScrolltoTop Testing"
),


dashboardSidebar(
  sidebarMenu(
    style = "position:relative;",
    id = "tabs",
    menuItem("FirstTab", 
             menuItem("Test 1", tabName = "subtab1"),
             menuItem("Test 2",tabName = "subtab2")
             ),
    menuItem("SecondTab", 
             menuItem("Test 3", tabName = "subtab3"),
             menuItem("Test 4",tabName = "subtab4")
             )
  )),


dashboardBody(
  position = "fixed-top",
  #prevent sidebar scrolling
  tags$script(HTML("$('body').addClass('fixed');")),
  tabItems(
    tabItem(tabName = "subtab1",
      fluidRow(column(12,plotOutput("testplot1", height = 1200)
                      ))),
      tabItem(tabName = "subtab2",
              fluidRow(column(12,plotOutput("testplot2", height = 1200)
              ))),
      tabItem(tabName = "subtab3",
              fluidRow(column(12,plotOutput("testplot3", height = 1200)
              ))),
      tabItem(tabName = "subtab4",
              fluidRow(column(12,plotOutput("testplot4", height = 1200)
    )))
    )
  )
)

server <- function(input, output) {

 output$testplot1 <- renderPlot({
 ggplot(data, aes(x=x,y=y))+geom_point()+theme(plot.background = element_rect("green"))
   })

 output$testplot2 <- renderPlot({
 ggplot(data, aes(x=x,y=y))+geom_point()+theme(plot.background = element_rect("red"))
   })

 output$testplot3 <- renderPlot({
 ggplot(data, aes(x=x,y=y))+geom_point()+theme(plot.background = element_rect("blue"))
   })

 output$testplot4 <- renderPlot({
 ggplot(data, aes(x=x,y=y))+geom_point()+theme(plot.background = element_rect("yellow"))
   })
}

# Run the application 
shinyApp(ui = ui, server = server)

Shinydashboard：单击menuItem时，在页面顶部加载tabItems

0 个答案: