Reputation: 307
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
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)
Upvotes: 1