I want to use multiple pngs to create an animation or gif with pause button and input slider. As I found no package which is capable of providing a pause button and input slider I decided to do the animation directly in shiny using javascript.
It works well if the input slider just consists of the numbers, but I would like to introduce to have full years in the input slider, so I used "sliderTextInput" but something is not working now. I am not good with javascript so it is hard for me to find the problem.
This is the code:
Create some pngs:
# create random images
num_images <- 23
for (i in 1:num_images) {
n <- formatC(as.numeric(i), width = 3, format = "d", flag = "0")
# Define the filename
file_name <- paste0(n, "_random_plot", ".png")
# Open a PNG device
png(filename = file_name, width = 800, height = 600)
# Generate a random plot
plot(runif(100), runif(100), main = paste("Year:", 2000+i-1))
# Close the PNG device
dev.off()
}
Then the shiny app with "sliderTextInput" (does not work):
# create animation
library(shiny)
library(shinyWidgets)
# List of PNG files
png_files <- list.files( full.names = TRUE)
total_frames <- length(png_files)
years <- 2000:2022
# Define UI
ui <- fluidPage(
titlePanel("Image Sequence Viewer with Play/Pause and Slider"),
sidebarLayout(
sidebarPanel(
sliderTextInput("frameSlider", "Year:", choices = as.character(years), selected = "2000", grid = TRUE, animate = FALSE),
actionButton("playPause", "Play")
),
mainPanel(
imageOutput("image", height = "auto", width = "auto")
)
),
tags$script(HTML('
var isPlaying = false;
var frameDelay = 1000; // Delay in milliseconds
var years = ['), paste(years, collapse = ', '), HTML('];
var totalFrames = years.length;
var interval;
function startSlideshow() {
interval = setInterval(function() {
var slider = $("#frameSlider");
var currentValue = parseInt(slider.val());
var currentIndex = years.indexOf(currentValue);
if (currentIndex >= 0 && currentIndex < totalFrames - 1) {
var nextYear = years[currentIndex + 1];
slider.val(nextYear).trigger("change");
} else {
clearInterval(interval);
$("#playPause").text("Play");
isPlaying = false;
}
}, frameDelay);
}
$("#playPause").click(function() {
if (isPlaying) {
clearInterval(interval);
$(this).text("Play");
} else {
startSlideshow();
$(this).text("Pause");
}
isPlaying = !isPlaying;
});
$(document).ready(function() {
$("#frameSlider").val(years[0]).trigger("change");
});
'))
)
# Define server logic
server <- function(input, output, session) {
# Render the image based on the current slider value
output$image <- renderImage({
# Map the year to the corresponding frame index
year <- as.numeric(input$frameSlider)
frame_index <- match(year, years)
if (is.na(frame_index) || frame_index < 1 || frame_index > total_frames) {
frame_index <- 1
}
list(src = png_files[frame_index], contentType = 'image/png', alt = "Plot", width = 700, height = 700)
}, deleteFile = FALSE)
# Observe changes to the frameSlider input
observe({
# Ensure the slider reflects the current value
updateSliderTextInput(session, "frameSlider", selected = input$frameSlider)
})
}
# Run the application
shinyApp(ui = ui, server = server)
#-----------------------------------------------------
shiny app with normal SliderInput (does work):
# with sliderInput
png_files <- list.files( full.names = TRUE)
total_frames <- length(png_files)
# Define UI
ui <- fluidPage(
titlePanel("Image Sequence Viewer with Play/Pause and Slider"),
sidebarLayout(
sidebarPanel(
sliderInput("frameSlider", "Frame:", min = 1, max = total_frames, value = 1, step = 1),
actionButton("playPause", "Pause")
),
mainPanel(
imageOutput("image", height = "auto", width = "auto")
)
),
tags$script(HTML('
var isPlaying = true;
var frameDelay = 1000; // Delay in milliseconds
var totalFrames = '), total_frames, HTML(';
var interval;
function startSlideshow() {
interval = setInterval(function() {
var slider = document.getElementById("frameSlider");
var newValue = parseInt(slider.value) + 1;
if (newValue <= totalFrames) {
Shiny.setInputValue("frameSlider", newValue, {priority: "event"});
} else {
clearInterval(interval);
document.getElementById("playPause").innerText = "Play";
isPlaying = false;
}
}, frameDelay);
}
document.getElementById("playPause").onclick = function() {
if (isPlaying) {
clearInterval(interval);
this.innerText = "Play";
} else {
startSlideshow();
this.innerText = "Pause";
}
isPlaying = !isPlaying;
};
$(document).ready(function() {
startSlideshow();
document.getElementById("playPause").innerText = "Pause";
});
'))
)
# Define server logic
server <- function(input, output, session) {
# Render the image based on the current slider value
output$image <- renderImage({
# Ensure slider value is within the valid range
frame_index <- as.numeric(input$frameSlider)
if (is.na(frame_index) || frame_index < 1 || frame_index > total_frames) {
frame_index <- 1
}
list(src = png_files[frame_index], contentType = 'image/png', alt = "Plot", width = 700, height = 700)
}, deleteFile = FALSE)
# Observe the frameSlider input and update the slider input accordingly
observe({
updateSliderInput(session, "frameSlider", value = input$frameSlider)
})
}
# Run the application
shinyApp(ui = ui, server = server)
This is an approach using shinyWidgets::sliderTextInput
's animate parameter. It is based on my earlier answers here and here.
Using shinyWidgets::sliderTextInput
:
library(shiny)
library(shinyWidgets)
imgNames = paste0(1:23, ".png")
if(!dir.exists("images")){
dir.create("images")
}
for(imgName in imgNames){
png(file = paste0("images/", imgName), bg = "lightgreen")
par(mar = c(0,0,0,0))
plot(c(0, 1), c(0, 1), ann = F, bty = 'n', type = 'n', xaxt = 'n', yaxt = 'n')
text(x = 0.5, y = 0.5, imgName,
cex = 1.6, col = "black")
dev.off()
}
addResourcePath(prefix = "img", directoryPath = "images")
ui <- basicPage(
tags$head(
# Listen for img-src messages
tags$script("
Shiny.addCustomMessageHandler('img-src', function(source) {
document.getElementById('myimage').src = source;
});
")),
sliderTextInput(
inputId = "mysliderinput",
label = "My sliderInput",
choices = imgNames,
animate = TRUE
),
tags$img(id = "myimage", src = "")
# slower alternative
# uiOutput("image")
)
server <- function(input, output, session) {
observeEvent(input$mysliderinput, {
# print(imgNames[input$mysliderinput+1L])
session$sendCustomMessage("img-src", paste0("img/", input$mysliderinput))
})
# slower alternative
# output$image <- renderUI({
# tags$img(src = paste0("img/", input$mysliderinput))
# })
}
shinyApp(ui = ui, server = server)
Using shiny::sliderInput
library(shiny)
library(htmltools)
imgNames = paste0(1:23, ".png")
if(!dir.exists("images")){
dir.create("images")
}
for(imgName in imgNames){
png(file = paste0("images/", imgName), bg = "lightgreen")
par(mar = c(0,0,0,0))
plot(c(0, 1), c(0, 1), ann = F, bty = 'n', type = 'n', xaxt = 'n', yaxt = 'n')
text(x = 0.5, y = 0.5, imgName,
cex = 1.6, col = "black")
dev.off()
}
addResourcePath(prefix = "img", directoryPath = "images")
ui <- basicPage(
tags$head(
# Listen for img-src messages
tags$script("
Shiny.addCustomMessageHandler('img-src', function(source) {
document.getElementById('myimage').src = source;
});
")),
h1("Custom sliderInput ticks"),
{
customTicks <- seq_len(length(imgNames))
customSlider <- sliderInput(
inputId = "mysliderinput",
label = "My sliderInput",
min = 0L,
max = length(imgNames)-1,
value = 0L,
step = 1L,
ticks = TRUE,
animate = TRUE
)
tagQuery(customSlider)$find("input")$addAttrs("data-values" = paste0(imgNames, collapse = ", "))$allTags()
},
tags$img(id = "myimage", src = "")
# slower alternative
# uiOutput("image")
)
server <- function(input, output, session) {
observeEvent(input$mysliderinput, {
# print(imgNames[input$mysliderinput+1L])
session$sendCustomMessage("img-src", paste0("img/", imgNames[input$mysliderinput+1L]))
})
# slower alternative
# output$image <- renderUI({
# tags$img(src = paste0("img/", imgNames[input$mysliderinput+1L]))
# })
}
shinyApp(ui = ui, server = server)
Also check:
https://shiny.posit.co/r/articles/build/communicating-with-js/