R/animate.R

In fdschneider/caspr: Cellular Automata for Spatial Pressure in R

#' Create animated gif or video from simulation result. 
#'
#' @param x A ca_result object (generated by \code{ca()}) 
#' @param filename A character value specifying relative path and filename. File endings will be ignored and replaced by value in \code{type}.   
#' @param type A character value specifying the type of output. Either "gif" (tiny animated gif), "mp4", "wmv", or "avi". 
#' @param speed A numeric value specifying the relative speed of the output (defaults to 1). 
#' @param directory A character string specifying the absolute or relative target path. Defaults to current working directory. 
#' @param ... further parameters will be handed to the function saveGIF or saveVIDEO. 
#'
#' @return Returns an animated gif or video. 
#' 
#' @details This requires R-package \link{[animation]} and the additional software \href{http://imagemagick.org/}{ImageMagick} (for animated .gif) and \href{https://ffmpeg.org/download.html}{FFMPEG} (for .mpeg videos). 
#' 
#' @seealso \link{animate.ca_model}
#' @export
#' @import animation
#' 
#' @examples
#' 
#' # 1. run simulation and save full landsape at each timestep. create animated gif.
#' 
#' l <- init_landscape(c("1","0"), c(0.6,0.4), 100)
#' r <- ca(l, model = life, t_max = 500)
#' ca_animate(r, "life01.gif")

ca_animate <- function(x, filename, type = "gif",  speed = 1, directory = getwd() , ...) {
  
  #get root of filename
  
  filename <- sub(".avi|.gif|.mpg|.mp4", "", filename)
  
  if(Sys.info()[['sysname']] == "Linux") X11.options(antialias = "none") #for Linux Systems to enable pixel-wise plotting in (animated) gif-files. 
  if(Sys.info()[['sysname']] == "Windows") windows.options(antialias = "none") #for Windows Systems to enable pixel-wise plotting in (animated) gif-files. 
  
  if("gif" %in% type) {
    
    animation::saveGIF( 
      for(i in 1:length(x$landscapes) ) {
        par(mar = c(0,0,0,0))
        plot(x$landscapes[[i]], cols = x$model$cols, grid = FALSE, ani = TRUE)       }, 
      movie.name = paste0(filename, ".gif"), 
      img.name = "landscape", 
      #convert = "convert", 
      interval = 0.1/speed,
      clean = FALSE, 
      ani.width = x$landscapes[[1]]$dim[1], 
      ani.height = x$landscapes[[1]]$dim[2], 
      outdir = directory,
      ...
      )
  } 
  if("mp4" %in% type) {
    animation::saveVideo( 
      for(i in 1:length(x$landscapes) ) {
          par(mar = c(0,0,0,0))
          plot(x$landscapes[[i]], cols = x$model$cols, grid = FALSE, ani = TRUE) 
        }, 
      video.name = paste0(filename, ".mp4"), 
      img.name = "landscape", 
      convert = "convert", 
      interval = 0.1/speed,
      cmd.fun = system, 
      clean = TRUE, 
      ani.width = x$landscapes[[1]]$dim[1]*5, 
      ani.height = x$landscapes[[1]]$dim[2]*5, 
      outdir = directory,
      ...
    )
  }
  if("avi" %in% type) {
    animation::saveVideo( 
      for(i in 1:length(x$landscapes) ) {
        par(mar = c(0,0,0,0))
        plot(x$landscapes[[i]], cols = x$model$cols, grid = FALSE, ani = TRUE) 
      }
      , 
      video.name = paste0(filename, ".avi"), 
      img.name = "landscape", 
      convert = "convert", 
      interval = 0.1/speed,
      cmd.fun = system, 
      clean = TRUE, 
      ani.width = x$landscapes[[1]]$dim[1]*5, 
      ani.height = x$landscapes[[1]]$dim[2]*5, 
      outdir = directory,
      ...
    )
  }
  if("wmv" %in% type) {
    animation::saveVideo( 
      for(i in 1:length(x$landscapes) ) {
        par(mar = c(0,0,0,0))
        plot(x$landscapes[[i]], cols = x$model$cols, grid = FALSE, ani = TRUE) 
      }
      , 
      video.name = paste0(filename, ".wmv"), 
      img.name = "landscape", 
      convert = "convert", 
      interval = 0.1/speed,
      cmd.fun = system, 
      clean = TRUE, 
      ani.width = x$landscapes[[1]]$dim[1]*5, 
      ani.height = x$landscapes[[1]]$dim[2]*5, 
      outdir = directory,
      ...
    )
  }
}


#' @export
animate <- ca_animate