shinydashboard: загрузка tabItems вверху страницы при нажатии на menuItem - PullRequest
0 голосов
/ 29 января 2019

Я разрабатываю блестящее приложение с несколькими вкладками (около 10), каждая из которых содержит длинный контент (необходима прокрутка внутри каждой вкладки).Когда пользователь прокручивает страницу вниз на одной вкладке, а затем выбирает другую вкладку в меню боковой панели, новая вкладка загружается в ту же позицию прокрутки в основной панели, что и предыдущая вкладка.Мне бы хотелось, чтобы основная панель (тело приборной панели) возвращалась в верхнюю часть страницы каждый раз, когда в боковой панели нажимается tabItem.

Я пробовал несколько решений, использующих блестящий, но я начинающий, когдаречь идет о JavaScript.Я нашел следующий код в другом вопросе, который я пытался реализовать без успеха, используя имя div моего заголовка боковой панели (вкладки):

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

            });")

Приведенный выше код будет выполняться только в разделе sidemenu.приложения.Помещение его в код dashboardPagePlus () или разделы dashboardBody () приводит к ошибкам и ошибкам из-за непредвиденных проблем с классами в коде js.Я также пытался использовать код для одной конкретной вкладки в ссылке на div, чтобы посмотреть, смогу ли я заставить работать только одну вкладку, но безрезультатно (используя «# глянцевый-tab-subtab1» вместо «вкладок»).

Ниже приведен рабочий пример.Я поместил несколько дополнительных высоких графиков в каждую вкладку, чтобы я мог проверить поведение прокрутки, когда я пробую решения.Я уверен, что для этого требуется решение 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)
...