Automatic scrolling based on recent output in Shiny

Question

This question builds on this previous question R Shiny: keep old output.

I would like to view the output at the top of the page. How to automatically scroll the output to the top of the page?

library(shiny)
library(broom)
library(dplyr)
library(shinyjs)
library(shinydashboard)

header <- dashboardHeader(title = "My Dashboard")

sidebar <-  dashboardSidebar(
    sidebarMenu(
          checkboxGroupInput(inputId = "indep",
                             label = "Independent Variables",
                             choices = names(mtcars)[-1],
                             selected = NULL),
          actionButton(inputId = "fit_model",
                       label = "Fit Model"),
          numericInput(inputId = "model_to_show",
                       label = "Show N most recent models",
                       value = 20)
      )
)
  
body <- dashboardBody(
  includeScript("www/scrolldown.js"),
  tags$head(includeCSS('www/style.css')),
       
          htmlOutput("model_record")
)

ui <- dashboardPage(header, sidebar, body)

server <-  
  shinyServer(function(input, output, session){
    Model <- reactiveValues(
      Record = list()
    )
    
    observeEvent(
      input[["fit_model"]],
      {
        fit <- 
          lm(mpg ~ ., 
             data = mtcars[c("mpg", input[["indep"]])])
        
        #Model$Record <- c(Model$Record, list(fit))
        #Last result up
        Model$Record <- c(list(fit),Model$Record)
      }
    )
    
    output$model_record <- 
      renderText({
        tail(Model$Record, input[["model_to_show"]]) %>%
          lapply(tidy) %>%
          lapply(knitr::kable,
                 format = "html") %>%
          lapply(as.character) %>%
          unlist() %>%
          paste0(collapse = "<br/><br/>")
      })
    
  })


shinyApp(ui, server)

style.css file:

.sidebar {
    color: #FFF;
    position: fixed;
    width: 220px;
    white-space: nowrap;
    overflow: visible;
  }
  
  .main-header {
    position: fixed;
    width:100%;
  }

  .content {
    padding-top: 60px;
  }

EDIT: Javascript added based on Waldi's answer:

scrolldown.js

$(document).on('shiny:value', function(event) {
  // Scroll down after model update
  if (event.target.id === 'model_record') {
    window.scrollTo(0,document.body.scrollHeight);
  }
});

View Video Screenshot Gif

This sounds like something you could achieve by adding some javascript to your Shiny. https://shiny.rstudio.com/articles/communicating-with-js.html — mhovd, Jul 13 '20 at 09:30
I am not sure if i understand it correctly: `scroll the output section to the top`. Do you want to sort the output to have it on top or you just want to scroll to the last output at the bottom? — Tonio Liebrand, Jul 15 '20 at 20:19
I would like the most recent output to be displayed at the top. — writer_typer, Jul 16 '20 at 00:47

Waldi · Accepted Answer · 2020-07-16T15:52:49.513

3

As mentionned in the comments, you can set a javascript trigger on model_record tag:

create the js script under www/scrolldown.js :

$(document).on('shiny:value', function(event) {
  // Scroll down after model update
  if (event.target.id === 'model_record') {
    window.scrollTo(0,document.body.scrollHeight);
  }
});

include the script in the UI:

library(shiny)
library(broom)
library(dplyr)
library(shinyjs)
library(shinydashboard)

header <- dashboardHeader(title = "My Dashboard")

sidebar <-  dashboardSidebar(
  sidebarMenu(
    checkboxGroupInput(inputId = "indep",
                       label = "Independent Variables",
                       choices = names(mtcars)[-1],
                       selected = NULL),
    actionButton(inputId = "fit_model",
                 label = "Fit Model"),
    numericInput(inputId = "model_to_show",
                 label = "Show N most recent models",
                 value = 20)
  )
)

body <- dashboardBody(
  includeScript("www/scrolldown.js"),
  tags$head(includeCSS('www/style.css')),
  
  htmlOutput("model_record"),
  div(style="height: 90vh;")
)

ui <- dashboardPage(header, sidebar, body)

server <-  
  shinyServer(function(input, output, session){
    Model <- reactiveValues(
      Record = list()
    )
    
    observeEvent(
      input[["fit_model"]],
      {
        fit <- 
          lm(mpg ~ ., 
             data = mtcars[c("mpg", input[["indep"]])])
        
        Model$Record <- c(Model$Record, list(fit))
      }
    )
    
    output$model_record <- 
      renderText({
        tail(Model$Record, input[["model_to_show"]]) %>%
          lapply(tidy) %>%
          lapply(knitr::kable,
                 format = "html") %>%
          lapply(as.character) %>%
          unlist() %>%
          paste0(collapse = "<br/><br/>")
      })
    
  })


shinyApp(ui, server)

Now the scrollbar moves down after each model update... but you have to scroll up to find the fit model button : this can be changed by using a fixed sidebar css.

Finally, to show only the last model on top, building on @Tonio Liebrand suggestion, you can add a div with 90% of viewport height so that it automatically adapts to screen size.

edited Jul 16 '20 at 15:52

answered Jul 15 '20 at 22:15

Waldi

39,242
6
30
78

The scrolling works, but I would like the output to be displayed all the way up to the top of the screen instead of being at the bottom of the screen. I've added the updated the code in my question based on your previous answer. – writer_typer Jul 16 '20 at 00:27
If you want the last output first, you could just modify `Model$Record <- c(Model$Record,list(fit))` to `Model$Record <- c(list(fit),Model$Record)`, see my edit in your post – Waldi Jul 16 '20 at 04:32
I'm so sorry for the confusion. I liked your first solution better. I wanted the app to scroll the latest output to the top. The new solution just reverses the order. But I would like the original order with the output being automatically scrolled and positioned at the top of the screen instead of being at the bottom of the screen. – writer_typer Jul 16 '20 at 05:20
@typewriter, no problem, I guess I don't fully get your needs : do you mean by output the Model$Record object? I'm a bit confused by scrolling down and then showing top of it which seems a contradiction. But I certainly miss your point. Could you please clarify this? Thanks ;) – Waldi Jul 16 '20 at 05:27
Thanks for trying to understand :) In the first solution that you sent the output gets generated and is shown at the bottom of the page. The scrolling works great. The solution I am looking for is for the app to automatically keep scrolling after each output is rendered so that the most recent output is at the top. To say it in another way, the old output would be hidden and would be visible if the user clicks the up arrow on the scroll bar. The new output would be visible at the top of the page with a lot of blank space filling the screen under it. – writer_typer Jul 16 '20 at 05:55
We're getting closer. I've added a video screen capture gif [https://i.stack.imgur.com/o8TU1.gif] to explain a little more. As you can see, at the moment I'm running models and manually scrolling after each time I click ```Fit Model```. I would like the screen to be automatically scrolled to the most recently fit model instead of me scrolling manually. That is what I'm looking for. – writer_typer Jul 16 '20 at 15:20
On the last update I did, I have nothing manual : the latest model is always on top. Are you sure you're trying the latest version? I just modified back the Model$Record <- c(Model$Record, list(fit)) part – Waldi Jul 16 '20 at 15:50
I realized I was using the old code! The new modified code works great. – writer_typer Jul 16 '20 at 16:04
We did :) see you around – writer_typer Jul 16 '20 at 16:07

score 2 · Answer 2 · answered Jul 16 '20 at 07:48

Thanks for clarifying concerning my question in the comments. I think now i understand what you are attempting to achieve.

I think one challenge you might face is that the sidebar wont scroll down as well. I am not sure that it is desired.

Potential solution:

You could add a placeholder that ensures that your latest modell output will be on top if you scroll down. It could be just an empty div:

div(style="height: 850px;")

This is more of a draft as we should ensure first that the spec is fully understood. Enhancements would be to scale this div to the size of the users screen.

Reproducible example:

library(shiny)
library(broom)
library(dplyr)
library(shinyjs)
library(shinydashboard)

header <- dashboardHeader(title = "My Dashboard")

js_code <- "$(document).on('shiny:value', function(event) {
  // Scroll down after model update
  if (event.target.id === 'model_record') {
    window.scrollTo(0,document.body.scrollHeight);
  }
});"

sidebar <-  dashboardSidebar(
  
  sidebarMenu(
    
    checkboxGroupInput(inputId = "indep",
                       label = "Independent Variables",
                       choices = names(mtcars)[-1],
                       selected = NULL),
    
    actionButton(inputId = "fit_model",
                 label = "Fit Model"),
    
    numericInput(inputId = "model_to_show",
                 label = "Show N most recent models",
                 value = 20)
  )
)

body <- dashboardBody(
  tags$script(js_code),
  htmlOutput("model_record"),
  div(style="height: 850px;")
)

ui <- dashboardPage(header, sidebar, body)

server <-  
  shinyServer(function(input, output, session){
    Model <- reactiveValues(
      Record = list()
    )
    
    observeEvent(
      input[["fit_model"]],
      {
        fit <- 
          lm(mpg ~ ., 
             data = mtcars[c("mpg", input[["indep"]])])
        
        Model$Record <- c(Model$Record, list(fit))
      }
    )
    
    output$model_record <- 
      renderText({
        tail(Model$Record, input[["model_to_show"]]) %>%
          lapply(tidy) %>%
          lapply(knitr::kable,
                 format = "html") %>%
          lapply(as.character) %>%
          unlist() %>%
          paste0(collapse = "<br/><br/>")
      })
    
  })


shinyApp(ui, server)

Automatic scrolling based on recent output in Shiny

2 Answers2