yasel
Reputation: 453
Switch to top of shiny dashboard panel via sidebarmenu
Considering the shiny dashboard example below (adapted from https://rstudio.github.io/shinydashboard/get_started.html). Is it somehow possible to scroll down in one tab item and when then switching to another tab item by clicking in the sideboard end up at the top of the new item instead of the same height as before?
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(
sidebarMenu(
style = "position: fixed; overflow: visible;",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
## Body content
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
box(plotOutput("plotA", height = 250)),
box(
title = "Controls",
sliderInput("sliderA", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plotB", height = 250)),
box(
title = "Controls",
sliderInput("sliderB", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plotC", height = 250)),
box(
title = "Controls",
sliderInput("sliderC", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plotD", height = 250)),
box(
title = "Controls",
sliderInput("sliderD", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plotE", height = 250)),
box(
title = "Controls",
sliderInput("sliderE", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plotF", height = 250)),
box(
title = "Controls",
sliderInput("sliderF", "Number of observations:", 1, 100, 50)
)
)
),
# Second tab content
tabItem(tabName = "widgets",
h2("Widgets tab content"),
fluidRow(
box(plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider1", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plot2", height = 250)),
box(
title = "Controls",
sliderInput("slider2", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plot3", height = 250)),
box(
title = "Controls",
sliderInput("slider3", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plot4", height = 250)),
box(
title = "Controls",
sliderInput("slider4", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plot5", height = 250)),
box(
title = "Controls",
sliderInput("slider5", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plot6", height = 250)),
box(
title = "Controls",
sliderInput("slider6", "Number of observations:", 1, 100, 50)
)
)
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider1)]
hist(data)
})
output$plot2 <- renderPlot({
data <- histdata[seq_len(input$slider2)]
hist(data)
})
output$plot3 <- renderPlot({
data <- histdata[seq_len(input$slider3)]
hist(data)
})
output$plot4 <- renderPlot({
data <- histdata[seq_len(input$slider4)]
hist(data)
})
output$plot5 <- renderPlot({
data <- histdata[seq_len(input$slider5)]
hist(data)
})
output$plot6 <- renderPlot({
data <- histdata[seq_len(input$slider6)]
hist(data)
})
output$plotA <- renderPlot({
data <- histdata[seq_len(input$sliderA)]
hist(data)
})
output$plotB <- renderPlot({
data <- histdata[seq_len(input$sliderB)]
hist(data)
})
output$plotC <- renderPlot({
data <- histdata[seq_len(input$sliderC)]
hist(data)
})
output$plotD <- renderPlot({
data <- histdata[seq_len(input$sliderD)]
hist(data)
})
output$plotE <- renderPlot({
data <- histdata[seq_len(input$sliderE)]
hist(data)
})
output$plotF <- renderPlot({
data <- histdata[seq_len(input$sliderF)]
hist(data)
})
}
shinyApp(ui, server)
Upvotes: 1
Views: 628
Answers (1)
ismirsehregal
Reputation: 33397
Here is a solution using shinyjs. A line of JS is executed everytime another item in the sidebar is clicked. See the observeEvent I added:
library(shiny)
library(shinyjs)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(
sidebarMenu(id = "sidebarID",
style = "position: fixed; overflow: visible;",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
## Body content
dashboardBody(
useShinyjs(),
extendShinyjs(text = 'shinyjs.scrolltop = function() {window.scrollTo(0, 0)};', functions = c("scrolltop")),
tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
box(plotOutput("plotA", height = 250)),
box(
title = "Controls",
sliderInput("sliderA", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plotB", height = 250)),
box(
title = "Controls",
sliderInput("sliderB", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plotC", height = 250)),
box(
title = "Controls",
sliderInput("sliderC", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plotD", height = 250)),
box(
title = "Controls",
sliderInput("sliderD", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plotE", height = 250)),
box(
title = "Controls",
sliderInput("sliderE", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plotF", height = 250)),
box(
title = "Controls",
sliderInput("sliderF", "Number of observations:", 1, 100, 50)
)
)
),
# Second tab content
tabItem(tabName = "widgets",
h2("Widgets tab content"),
fluidRow(
box(plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider1", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plot2", height = 250)),
box(
title = "Controls",
sliderInput("slider2", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plot3", height = 250)),
box(
title = "Controls",
sliderInput("slider3", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plot4", height = 250)),
box(
title = "Controls",
sliderInput("slider4", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plot5", height = 250)),
box(
title = "Controls",
sliderInput("slider5", "Number of observations:", 1, 100, 50)
)
),
fluidRow(
box(plotOutput("plot6", height = 250)),
box(
title = "Controls",
sliderInput("slider6", "Number of observations:", 1, 100, 50)
)
)
)
)
)
)
server <- function(input, output) {
observeEvent(input$sidebarID, {
js$scrolltop()
})
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider1)]
hist(data)
})
output$plot2 <- renderPlot({
data <- histdata[seq_len(input$slider2)]
hist(data)
})
output$plot3 <- renderPlot({
data <- histdata[seq_len(input$slider3)]
hist(data)
})
output$plot4 <- renderPlot({
data <- histdata[seq_len(input$slider4)]
hist(data)
})
output$plot5 <- renderPlot({
data <- histdata[seq_len(input$slider5)]
hist(data)
})
output$plot6 <- renderPlot({
data <- histdata[seq_len(input$slider6)]
hist(data)
})
output$plotA <- renderPlot({
data <- histdata[seq_len(input$sliderA)]
hist(data)
})
output$plotB <- renderPlot({
data <- histdata[seq_len(input$sliderB)]
hist(data)
})
output$plotC <- renderPlot({
data <- histdata[seq_len(input$sliderC)]
hist(data)
})
output$plotD <- renderPlot({
data <- histdata[seq_len(input$sliderD)]
hist(data)
})
output$plotE <- renderPlot({
data <- histdata[seq_len(input$sliderE)]
hist(data)
})
output$plotF <- renderPlot({
data <- histdata[seq_len(input$sliderF)]
hist(data)
})
}
shinyApp(ui, server)
Upvotes: 2
Related Questions
- Toggle display of sidebar menu in shinydashboard programmatically
- How to enable toggling between 3 menu items in shiny dashboard sidebar
- Shiny Dashboard load new tab at top of page
- Display controlbarMenu() in right sidebar of shiny dashboard based on tab selection
- closing sidebar in shiny dashboard
- Create shiny dashboard sidebar menu from dataframe
- Navigate to particular sidebar menu item in ShinyDashboard?
- shiny dashboard -sidebarMenu with menuItem
- R Shiny Dashboard Scroll to Top on Button Click
- R Shiny Dashboard does not load rendered UI inside of sidebarMenu on initialization