R shinydashboard auto-scroll to bottom when new output element is rendered

Question

Consider the code below. It produces Shiny dashboard with two menu items where every time the user checks a box on either tab, a histogram is displayed. However, after a certain point (after the second histogram on every tab is rendered), every time a new element histogram is rendered, the user has to scroll down by hand.

What I am looking for is a solution where every time a new element is rendered further down on the tab of a Shiny dashboard, the tab is immediately scrolled down to the bottom, so the new element is fully seen, and that it applies to all tabs of the dashboard. This example is with plots (histograms) but it can be any kind of output.

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "My dashboard"),
  
  dashboardSidebar(
    menuItem(text = "Tab 1", tabName = "tab1"),
    menuItem(text = "Tab 2", tabName = "tab2")
    
  ),
  
  dashboardBody(
    tabItems(
      tabItem(tabName = "tab1",
              h1(textOutput(outputId = "header1")),
              checkboxInput(inputId = "sepalLng", label = "Histogram - iris, Sepal.Length"),
              conditionalPanel(condition = "input.sepalLng",
                               plotOutput(outputId = "histSepalLng", height = "500px")
              ),
              checkboxInput(inputId = "sepalWdt", label = "Histogram - iris, Sepal.Width"),
              conditionalPanel(condition = "input.sepalWdt",
                               plotOutput(outputId = "histSepalWdt", height = "500px")
              ),
              checkboxInput(inputId = "petalLng", label = "Histogram - iris, Petal.Length"),
              conditionalPanel(condition = "input.petalLng",
                               plotOutput(outputId = "histPetalLng", height = "500px")
              ),
              checkboxInput(inputId = "petalWdt", label = "Histogram - iris, Petal.Width"),
              conditionalPanel(condition = "input.petalWdt",
                               plotOutput(outputId = "histPetalWdt", height = "500px")
              )
      ),
      tabItem(tabName = "tab2",
              h1(textOutput(outputId = "header2")),
              checkboxInput(inputId = "mpg", label = "Histogram - mtcars, mpg"),
              conditionalPanel(condition = "input.mpg",
                               plotOutput(outputId = "histMpg", height = "500px")
              ),
              checkboxInput(inputId = "drat", label = "Histogram - mtcars, drat"),
              conditionalPanel(condition = "input.drat",
                               plotOutput(outputId = "histDrat", height = "500px")
              ),
              checkboxInput(inputId = "wt", label = "Histogram - mtcars, wt"),
              conditionalPanel(condition = "input.wt",
                               plotOutput(outputId = "histWt", height = "500px")
              ),
              checkboxInput(inputId = "qsec", label = "Histogram - mtcars, qsec"),
              conditionalPanel(condition = "input.qsec",
                               plotOutput(outputId = "histQsec", height = "500px")
              )
      )
    )
  )
)

server <- function(input, output) {
  
  output$header1 <- renderText({"Tab 1 - iris data"})
  output$histSepalLng <- renderPlot(hist(iris$Sepal.Length))
  output$histSepalWdt <- renderPlot(hist(iris$Sepal.Width))
  output$histPetalLng <- renderPlot(hist(iris$Petal.Length))
  output$histPetalWdt <- renderPlot(hist(iris$Petal.Width))
  
  output$header2 <- renderText({"Tab 2 - mtcars data"})
  output$histMpg <- renderPlot(hist(mtcars$mpg))
  output$histDrat <- renderPlot(hist(mtcars$drat))
  output$histWt <- renderPlot(hist(mtcars$wt))
  output$histQsec <- renderPlot(hist(mtcars$qsec))
}

shinyApp(ui, server)

Can someone help?

lz100 · Answer 1 · 2020-08-19T01:58:14.067

The code below is what you want. But first, some little details you need to notice:

you need to add sidebarMenu() wrapper for menuItem, otherwise, it is ugly bullet points, and when you have clicked tab1 and tab2 you can't click tab1 to go back to tab1. I don't know what version of dashboard you are using, at least it is the case by my end.

# just add this to your dash body
    dashboardBody(
        tags$script(
            "$( document ).ready(function() {
               $(\".tab-content [type='checkbox']\").on('click', function(){
                  setTimeout(function() {
                    window.scrollTo(0,document.body.scrollHeight);
                }, 200)
               })
             })"
        ),
        ...
    )

Look like this:

ui <- dashboardPage(
    dashboardHeader(title = "My dashboard"),
    dashboardSidebar(
        sidebarMenu(
            menuItem(text = "Tab 1", tabName = "tab1"),
            menuItem(text = "Tab 2", tabName = "tab2")
        )
    ),
    
    dashboardBody(
        tags$script(
            "$( document ).ready(function() {
               $(\".tab-content [type='checkbox']\").on('click', function(){
                  setTimeout(function() {
                    window.scrollTo(0,document.body.scrollHeight);
                }, 200)
               })
             })"
        ),
        tabItems(
            tabItem(tabName = "tab1",
                    h1(textOutput(outputId = "header1")),
                    checkboxInput(inputId = "sepalLng", label = "Histogram - iris, Sepal.Length"),
                    conditionalPanel(condition = "input.sepalLng",
                                     plotOutput(outputId = "histSepalLng", height = "500px")
                    ),
                    checkboxInput(inputId = "sepalWdt", label = "Histogram - iris, Sepal.Width"),
                    conditionalPanel(condition = "input.sepalWdt",
                                     plotOutput(outputId = "histSepalWdt", height = "500px")
                    ),
                    checkboxInput(inputId = "petalLng", label = "Histogram - iris, Petal.Length"),
                    conditionalPanel(condition = "input.petalLng",
                                     plotOutput(outputId = "histPetalLng", height = "500px")
                    ),
                    checkboxInput(inputId = "petalWdt", label = "Histogram - iris, Petal.Width"),
                    conditionalPanel(condition = "input.petalWdt",
                                     plotOutput(outputId = "histPetalWdt", height = "500px")
                    )
            ),
            tabItem(tabName = "tab2",
                    h1(textOutput(outputId = "header2")),
                    checkboxInput(inputId = "mpg", label = "Histogram - mtcars, mpg"),
                    conditionalPanel(condition = "input.mpg",
                                     plotOutput(outputId = "histMpg", height = "500px")
                    ),
                    checkboxInput(inputId = "drat", label = "Histogram - mtcars, drat"),
                    conditionalPanel(condition = "input.drat",
                                     plotOutput(outputId = "histDrat", height = "500px")
                    ),
                    checkboxInput(inputId = "wt", label = "Histogram - mtcars, wt"),
                    conditionalPanel(condition = "input.wt",
                                     plotOutput(outputId = "histWt", height = "500px")
                    ),
                    checkboxInput(inputId = "qsec", label = "Histogram - mtcars, qsec"),
                    conditionalPanel(condition = "input.qsec",
                                     plotOutput(outputId = "histQsec", height = "500px")
                    )
            )
        )
    )
)

I used some Jquery and JS functions. You can use shinyjs package to run the JS if you prefer a more R way. It is more tricky than I thought.

Basically what I do is, whenever you click the checkbox under tab content(doesn't matter which one or which tab), it will automatically scroll your window. However, the plot is rendered after button is clicked. If I scroll at the time of clicking, the window height is still unchanged until the plot is been sent from server to frontend. So I added a delay for 200ms, you can see the 200 in script. If your plot takes more than 200ms to render, you need to change this delay time to a longer time. If you say you want to automatically decide the delay time:

add JS script to the renderPlot function, when the render function triggers, then you scroll, but you need to do it for every render function so there will be a lot of repeated code which is not ideal.This can be done by the shinyjs package.
My solution only needs to work on the frontend script, there is no back-front communication. So another option is to add shiny-server communications to tell JS the triggering time. It can be done by sendCustomMessage but takes quite some time to learn. I don't recommend if you are a beginner.

Maybe just estimate the time, most plots should take under 1s to render.

EDITS:

The script above scrolls on both check/uncheck the box, but I think you only want it on check:

        HTML(
        "<script>
           $( document ).ready(function() {
              $(\".tab-content [type='checkbox']\").on('click', function(){
                var is_checked = this.checked;
                if(typeof is_checked === 'boolean' && is_checked === true){
                  setTimeout(function() {
                    window.scrollTo(0,document.body.scrollHeight);
                  }, 200)
                }
              })
           })
        </script>"
        ),

tags$script change my & to "&", have to use HTML instead.

Thank you very much for the time and effort to provide this comprehensive answer, it also helps me on my learning journey. I did not use `sidebarMenu`, just wanted to provide a minimal reproducible example, not a pretty one. I am new to Shiny and have no expertise in JS or `Jquery`. So, if I understand correctly, the auto scrolling down always needs to be bound to the type of object (checkbox in this case) causing the event of rendering of the new element (plot in this case). That is, there can't be some general solution to apply to all dashboard tabs regardless of their content? — panman, Aug 19 '20 at 10:37
Well, there can be a JS `listener` to monitor the tab content. Store the document height in a JS variable and when the `listener` finds out height change, compare it to the stored variable. If it is a larger height(you render something new), scroll to the bottom, if smaller(you remove something), do nothing. So it is possible but you need to learn JS. — lz100, Aug 19 '20 at 22:29

R shinydashboard auto-scroll to bottom when new output element is rendered

1 Answers1