[英]Shiny Dashboard load new tab at top of page
我已经按照这个线程在窗口顶部冻结了 Shiny Dashboard 的标题,这很方便,因为我的仪表板上会有很多长标签。 但是,每当我切换选项卡时,新选项卡都不会在选项卡顶部与我一起加载 - 无论我在新选项卡上有多远,我在切换时都在旧选项卡上。 有没有办法改变这种情况? 这是一些播放代码:
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 https://stackoverflow.com/questions/45706670/shiny-dashboadpage-lock-dashboardheader-on-top
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 https://stackoverflow.com/questions/47830553/r-shiny-automatically-hide-the-sidebar-when-you-navigate-into-tab-items
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 https://stackoverflow.com/questions/47830553/r-shiny-automatically-hide-the-sidebar-when-you-navigate-into-tab-items
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)
在身体的任何地方添加这个
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 https://stackoverflow.com/questions/45706670/shiny-dashboadpage-lock-dashboardheader-on-top
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 https://stackoverflow.com/questions/47830553/r-shiny-automatically-hide-the-sidebar-when-you-navigate-into-tab-items
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 https://stackoverflow.com/questions/47830553/r-shiny-automatically-hide-the-sidebar-when-you-navigate-into-tab-items
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)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.