Ben
Ben

Reputation: 307

R Shiny: How to start and stop an iteration / animation using action buttons

In R Shiny, I would like to create an animation that is started by an action button and can be interrupted by another action button. Below is a dummy version of the nonfunctioning code. The goal is to start an iteration that prints year=year+1 every second until it reaches the max. The user, however, should also be able to interrupt the process with the stop button.

The reason why I am using the observeEvent(), observe(), and reactiveValues() construction rather than a for loop, for instance, is that I was not able to stop the loop started by the start button.

In this example, neither start nor stop function work. Using a for loop, I get the iteration to start but the stop button only "stops" the process at the end of the iteration. Constructions with observeEvent(input$stop, { break }) within a for loop do not work. The reason is, I guess, that the event is only observed after execution of the for loop as the previous process is still active until then.

shinyApp(
  
  ui=fluidPage(
    actionButton("start", "Start"),
    actionButton("stop", "Stop"),
    actionButton("reset", "Reset"),
    verbatimTextOutput("text")
  ), 
  
  server=function(input, output, session) {
    
    r <- reactiveValues(animation = FALSE, year=2000) 
    
    observeEvent(input$start, {
      r$animation <- TRUE
    })
    
    observeEvent(input$stop, {
      r$animation <- FALSE
    })
    
    observeEvent(input$reset, {
      r$animation <- FALSE
      r$year <- 2000
    })
    
    observe({
      
      if(isTRUE(r$animation)) {
        
        r$year <- r$year + 1
        
        Sys.sleep(1)
        
        if(r$year==2005) {
          r$animation <- FALSE
          r$year <- 2000
        }
        
      } 
      
    })

    output$text <- renderText({ paste0("It is year ", r$year) })

    })

Upvotes: 2

Views: 430

Answers (1)

ismirsehregal
ismirsehregal

Reputation: 33550

This apporach is a little drifted away from your nonfunctioning example code however, I was wondering whether you are aware of sliderInput's animation capabilities.

I thought this might save you writing a lot of custom code:

library(shiny)

ui <- fluidPage(
  tags$head(tags$style(
    HTML(".slider-animate-button {
            opacity: 1;
          }
         ")
  )),
  titlePanel("Animation Slider Test"),
  sidebarLayout(
    sidebarPanel(
      sliderInput(
        inputId = "animation_slider",
        label = "Animation Slider",
        min = 2000L,
        max = 2020L,
        value = 2000L,
        step = 1L,
        round = FALSE,
        ticks = TRUE,
        animate = animationOptions(
          interval = 1000,
          loop = FALSE,
          playButton = actionButton(
            "play",
            "Play",
            icon = icon("play"),
            width = "100px",
            style = "margin-top: 10px; color: #fff; background-color: #337ab7; border-color: #2e6da4"
          ),
          pauseButton = actionButton(
            "pause",
            "Pause",
            icon = icon("pause"),
            width = "100px",
            style = "margin-top: 10px; color: #fff; background-color: #337ab7; border-color: #2e6da4"
          )
        ),
        width = NULL,
        sep = "",
        pre = "Year: ",
        post = NULL,
        timeFormat = NULL,
        timezone = NULL,
        dragRange = TRUE
      ),
      actionButton(
        "reset",
        "Reset",
        icon = icon("rotate-left"),
        width = "100px",
        style = "margin-top: -87px"
      )
    ),
    mainPanel(verbatimTextOutput("text"))
  )
)

server <- function(input, output, session) {
  observeEvent(input$reset, {
    updateSliderInput(
      session = session,
      inputId = "animation_slider",
      label = NULL,
      value = 2000L,
      min = NULL,
      max = NULL,
      step = NULL,
      timeFormat = NULL,
      timezone = NULL
    )
  })
  output$text <- renderText({
      paste("It is year", input$animation_slider)
    })
}

shinyApp(ui, server)

result

Upvotes: 1

Related Questions