Stop Shiny Animation instantly

shiny
1

I posted this question on Stack Overflow, but didn't get an answer. The problem is that I am displaying an animation controlled by a slider. The slider 'runs ahead' of the plots; so maybe the slider has got to frame 100, while the plots have only got to 20. When I try to pause the animation it continues until the plots have caught up with the slider. What I would like to happen is that the animation stops dead when I pause the slider.

I posted a reproducible example on Stack Overflow here:

library(shiny)
library(ggplot2)
library(dplyr)

df <- data.frame(frame_no = rep(1:500,10), x = runif(5000), y=runif(5000))

ui <- fluidPage(

sliderInput("frameInterval", "Set frame Interval (ms.)", min=0, 
max=2000, value=100,step=50),

uiOutput("frameSlider"),
plotOutput("plot.positions", height=500, width = 500) 
)

server <- function(input, output, session) {

output$frameSlider <- renderUI( sliderInput("frame", label= h3("Animate"), 
          min=1, max = 5000, 
          value=1, step=1, sep=NULL,
          animate = animationOptions(interval = input$frameInterval, loop = 
          TRUE))
)

output$plot.positions <- renderPlot( {
    f <- filter(df, frame_no==input$frame)
    ggplot(f, aes(x=x, y=y)) + xlim(0,1) + ylim(0,1) +
    geom_point(aes(size=3)) +
    annotate("text", x= 0.5, y= 0.5, label=paste("Frame ", input$frame), 
    size=6)
},
bg="transparent"
  )
}
 shinyApp(ui = ui, server = server)

Any help/thoughts appreciated.

2

One idea is to use the debounce() function to make Shiny skip over frames if it can't keep up. The below code is the same as yours except I created the frame debounced reactive, and replace input$frame in the plot with frame().


library(shiny)
library(ggplot2)
library(dplyr)

df <- data.frame(frame_no = rep(1:500,10), x = runif(5000), y=runif(5000))

ui <- fluidPage(
  
  sliderInput("frameInterval", "Set frame Interval (ms.)", min=0, 
    max=2000, value=100,step=50),
  
  uiOutput("frameSlider"),
  plotOutput("plot.positions", height=500, width = 500) 
)

server <- function(input, output, session) {
  
  output$frameSlider <- renderUI( sliderInput("frame", label= h3("Animate"), 
    min=1, max = 5000, 
    value=1, step=1, sep=NULL,
    animate = animationOptions(interval = input$frameInterval, loop = 
        TRUE))
  )
  
  frame <- reactive(input$frame) %>% debounce(25)
  
  output$plot.positions <- renderPlot( {
    f <- filter(df, frame_no==frame())
    ggplot(f, aes(x=x, y=y)) + xlim(0,1) + ylim(0,1) +
      geom_point(aes(size=3)) +
      annotate("text", x= 0.5, y= 0.5, label=paste("Frame ", frame()), 
        size=6)
  },
    bg="transparent"
  )
}
shinyApp(ui = ui, server = server)
3 Likes
3

Thanks for that idea Joe. It works very nicely.