闪亮的仪表板在页面顶部加载新标签

Question

我已经将 Shiny Dashboard 的 header 冻结在每个的 window 顶部，这很方便，因为我会有很多长标签在我的仪表板上。但是，每当我切换选项卡时，新选项卡都不会在选项卡顶部随我一起加载——我从新选项卡开始，但在我切换时位于旧选项卡上。有没有办法改变这个？这是一些播放代码：

library(shiny)          # shiny application
library(shinydashboard) # shiny dashboard toolkit
library(shinyjs)        # allows use of Javascript--used for sidebar closing ability

# ------------------------------------------------------------------------------
# BUILD UI
# ------------------------------------------------------------------------------

# Box height
boxHeight = "30em"

# Header content
header <- dashboardHeader(
  title = span("Jim's Dashboard", 
               style = "color: white; font-size: 28px"), 
  titleWidth = 260
)

# Sidebar content
sidebar <- dashboardSidebar(
  width = 260,
  collapsed = TRUE,
  sidebarMenu(
    id = "mysidebar",
    menuItem("Dashboard 1", tabName = "tab1", icon = icon("tachometer-alt")),
    menuItem("Dashboard 2", tabName = "tab2", icon = icon("chart-pie"))
  )
)

# Body content
body <- dashboardBody(

  # Keep header/sidebar frozen at top, per 
  tags$script(HTML("$('body').addClass('fixed');")), 
  
  # This line allows us to use Javascript; so far, it's only used to make the
  # sidebar go away once we've changed pages, per 
  useShinyjs(),
  
  tabItems(
    # 1ST TAB
    tabItem(tabName = "tab1",
      fluidRow(
        column(width=10, offset=1,
          fluidRow(
            box(height = boxHeight),
            box(height = boxHeight),
            box(height = boxHeight),
            box(height = boxHeight),
            box(height = boxHeight,width = 12),
            box(height = boxHeight),
            box(height = boxHeight),
            box(height = boxHeight,width = 12)
    )))),
    # 2ND TAB
    tabItem(tabName = "tab2",
      fluidRow(
        column(width=10, offset=1,
        fluidRow(
          box(height = boxHeight,width = 12),
          box(height = boxHeight),
          box(height = boxHeight),
          box(height = boxHeight),
          box(height = boxHeight),
          box(height = boxHeight,width = 12),
          box(height = boxHeight,width = 12),
          box(height = boxHeight,width = 12)
    ))))
  )
)

server <- function(input,output,session){
  
  # Adding these lines makes the sidebar go away once we've loaded a new page,
  # per 
  observeEvent(input$mysidebar,
               {
                 # for desktop browsers
                 addClass(selector = "body", class = "sidebar-collapse")
                 # for mobile browsers
                 removeClass(selector = "body", class = "sidebar-open")
               }
  )
}

#Dashboard page
dashboard <- dashboardPage(header, sidebar, body, tags$head(tags$style(HTML('* {font-family: "Lucida Sans"}!important;'))))

shinyApp(dashboard, server)

Answer 1

将其添加到正文的任何位置

tags$script('$(".sidebar-menu a[data-toggle=\'tab\']").click(function(){window.scrollTo({top: 0});})')

像这样

library(shiny)          # shiny application
library(shinydashboard) # shiny dashboard toolkit
library(shinyjs)        # allows use of Javascript--used for sidebar closing ability

# ------------------------------------------------------------------------------
# BUILD UI
# ------------------------------------------------------------------------------

# Box height
boxHeight = "30em"

# Header content
header <- dashboardHeader(
  title = span("Jim's Dashboard", 
               style = "color: white; font-size: 28px"), 
  titleWidth = 260
)

# Sidebar content
sidebar <- dashboardSidebar(
  width = 260,
  collapsed = TRUE,
  sidebarMenu(
    id = "mysidebar",
    menuItem("Dashboard 1", tabName = "tab1", icon = icon("tachometer-alt")),
    menuItem("Dashboard 2", tabName = "tab2", icon = icon("chart-pie"))
  )
)

# Body content
body <- dashboardBody(
  tags$script('$(".sidebar-menu a[data-toggle=\'tab\']").click(function(){window.scrollTo({top: 0});})'),
  # Keep header/sidebar frozen at top, per 
  tags$script(HTML("$('body').addClass('fixed');")), 
  
  # This line allows us to use Javascript; so far, it's only used to make the
  # sidebar go away once we've changed pages, per 
  useShinyjs(),
  
  tabItems(
    # 1ST TAB
    tabItem(tabName = "tab1",
            fluidRow(
              column(width=10, offset=1,
                     fluidRow(
                       box(height = boxHeight),
                       box(height = boxHeight),
                       box(height = boxHeight),
                       box(height = boxHeight),
                       box(height = boxHeight,width = 12),
                       box(height = boxHeight),
                       box(height = boxHeight),
                       box(height = boxHeight,width = 12)
                     )))),
    # 2ND TAB
    tabItem(tabName = "tab2",
            fluidRow(
              column(width=10, offset=1,
                     fluidRow(
                       box(height = boxHeight,width = 12),
                       box(height = boxHeight),
                       box(height = boxHeight),
                       box(height = boxHeight),
                       box(height = boxHeight),
                       box(height = boxHeight,width = 12),
                       box(height = boxHeight,width = 12),
                       box(height = boxHeight,width = 12)
                     ))))
  )
)

server <- function(input,output,session){
  
  # Adding these lines makes the sidebar go away once we've loaded a new page,
  # per 
  observeEvent(input$mysidebar,
               {
                 # for desktop browsers
                 addClass(selector = "body", class = "sidebar-collapse")
                 # for mobile browsers
                 removeClass(selector = "body", class = "sidebar-open")
               }
  )
}

#Dashboard page
dashboard <- dashboardPage(header, sidebar, body, tags$head(tags$style(HTML('* {font-family: "Lucida Sans"}!important;'))))

shinyApp(dashboard, server)

闪亮的仪表板在页面顶部加载新标签

Shiny Dashboard load new tab at top of page

r

shiny

shinydashboard