Search code examples
javascriptrshinyshinywidgets

Problems with sliderTextInput and javasript "animation"

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)
Solution

  • 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)

    result

    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)

    result

    Also check:

    https://shiny.posit.co/r/articles/build/communicating-with-js/

    https://github.com/yonicd/slickR

    https://github.com/juba/shinyglide/