R/animate.R

In dgrtwo/gganimate: A Grammar of Animated Graphics

#' Render a gganim object
#'
#' This function takes a gganim object and renders it into an animation. The
#' nature of the animation is dependent on the renderer, but defaults to using
#' `gifski` to render it to a gif. The length and framerate is decided on render
#' time and can be any two combination of `nframes`, `fps`, and `duration`.
#' Rendering is happening in discrete time units. This means that any event in
#' the animation is rounded of to the nearest frame (e.g. entering will always
#' take a whole number of frames). This means that rounding artifacts are
#' possible when only rendering few frames. To avoid this you can increase the
#' `detail` argument. `detail` will get multiplied to `nframes` and the
#' resulting number of frames will get calculated, but only `nframes` evenly
#' spaced frames are rendered.
#'
#' @param plot,x A `gganim` object
#' @param nframes The number of frames to render (default `100`)
#' @param fps The framerate of the animation in frames/sec (default `10`)
#' @param duration The length of the animation in seconds (unset by default)
#' @param detail The number of additional frames to calculate, per frame (default `1`)
#' @param renderer The function used to render the generated frames into an
#' animation. Gets a vector of paths to images along with the framerate. (by
#' default it will use [gifski_renderer()] if gifski is installed. If not it
#' will use [magick_renderer()] if magick is installed and then [av_renderer()]
#' if av is installed. If all fails it will use the [file_renderer()])
#' @param device The device to use for rendering the single frames. Possible
#' values are `'png'`, `'ragg_png'` (requires the ragg package), `'jpeg'`,
#' `'tiff'`, `'bmp'`, `'svg'`, and `'svglite'` (requires the svglite package).
#' (default `'png'`)
#' @param ref_frame The frame to use for fixing dimensions of the plot, e.g. the
#' space available for axis text. Defaults to the first frame. Negative values
#' counts backwards (-1 is the last frame) (default `1`)
#' @param start_pause,end_pause Number of times to repeat the first and last
#' frame in the animation (default is `0` for both)
#' @param rewind Should the animation roll back in the end (default `FALSE`)
#' @param ... Arguments passed on to the device.
#' For available device arguments, see [grDevices::png()] or [grDevices::svg()]
#'
#' @return The return value of the [renderer][renderers] function
#'
#' @details  `print.gganim`()  is an alias for `animate()` in the same way as
#' `print.ggplot()` is an alias for `plot.ggplot()`. This ensures that gganimate
#' behaves ggplot2-like and produces the animation when the object is printed.
#' The `plot()` method is different and produces a single frame for inspection
#' (by default frame 50 out of 100).
#'
#' Animations can be saved to disk using [anim_save()] in much the same way
#' [ggsave()][ggplot2::ggsave] works for static plots.
#'
#' @section Defaults:
#' It is possible to overwrite the defaults used by gganimate for the animation
#' by setting them with [options()] (prefixed with `gganimate.`. As an example,
#' if you would like to change the default nframes to 50 you would call
#' `options(gganimate.nframes = 50)`. In order to set default device arguments
#' (those you would normally pass through with `...`) you should use the
#' `gganimate.dev_args` options and provide a list of arguments e.g.
#' `options(gganimate.dev_args = list(width = 800, height = 600))` Defaults set
#' this way can still be overridden by giving arguments directly to `animate()`.
#'
#' **knitr Support:** \cr
#' It is possible to specify the arguments to `animate()` in the chunk options
#' when using `gganimate` with `knitr`. Arguments specified in this way will
#' have precedence over defaults, but not over arguments specified directly in
#' `animate()`. The arguments should be provided as a list to the `gganimate`
#' chunk option, e.g. `{r, gganimate = list(nframes = 50, fps = 20)}`. A few
#' build-in knitr options have relevance for animation and will be used unless
#' given specifically in the `gganimate` list option. The native knitr options
#' supported are:
#'
#' - `dev`: will set `device`
#' - `dev.args`: will set additional arguments to the device (`...`)
#' - `fig.width`, `fig.height`, `fig.asp`, `fig.dim`: will set `width` and
#'   `height` of the device.
#'
#' @section Label variables:
#' All plots have a certain set of variables available for string literal
#' interpolation within plot labels. These are:
#'
#' - **frame** gives you the frame index for the current frame
#' - **nframes** gives you the total number of frames in the animation
#' - **progress** gives you the progress of the animation at the current frame
#'   (equal to `frame/nframes`)
#' - **data** gives you the layer data for the current frame (as a list of data
#'   frames)
#'
#' Further, the transition and view in use can also make variables available.
#' Consult the documentation for these for more detail.
#'
#' @importFrom grid grid.newpage grid.draw convertWidth convertHeight
#' @importFrom grDevices png jpeg tiff bmp svg dev.off
#' @importFrom progress progress_bar
#' @importFrom ggplot2 ggplot_gtable ggplot_build
#' @export
#'
#' @examples
#' anim <- ggplot(mtcars, aes(mpg, disp)) +
#'   geom_point(aes(color = gear)) +
#'   transition_states(gear, transition_length = 2, state_length = 1) +
#'   enter_fade() +
#'   exit_fade()
#'
#' \dontrun{
#' # Explicitly animate using default (same as just printing the animation)
#' animate(anim)
#'
#' # Change duration and framerate
#' animate(anim, fps = 20, duration = 15)
#'
#' # Make the animation pause at the end and then rewind
#' animate(anim, nframes = 100, end_pause = 10, rewind = TRUE)
#'
#' # Use a different renderer
#' animate(anim, renderer = file_renderer('~/animation/'))[1:6]
#'
#' # Specify device dimensions and/or resolution
#' animate(anim, height = 2, width = 3, units = "in", res = 150)
#' }
#'
animate <- function(plot, ...) {
  UseMethod('animate')
}
#' @export
animate.default <- function(plot, ...) {
  cli::cli_abort('animation of {.cls {class(plot)}} objects are not supported')
}
#' @rdname animate
#' @export
animate.gganim <- function(plot, nframes, fps, duration, detail, renderer, device, ref_frame, start_pause, end_pause, rewind, ...) {
  args <- prepare_args(
    nframes = nframes,
    fps = fps,
    duration = duration,
    detail = detail,
    renderer = renderer,
    device = device,
    ref_frame = ref_frame,
    start_pause = start_pause,
    end_pause = end_pause,
    rewind = rewind,
    ...
  )
  if (is_knitting() && identical(def_ren$renderer, args$renderer) && !def_ren$has_proper) {
    cli::cli_warn('No renderer available. Please install the {.or {.pkg {c("gifski", "av", "magick")}}} package to create animated output')
    return(invisible(NULL))
  }
  orig_nframes <- args$nframes
  args$nframes <- args$nframes - args$start_pause - args$end_pause
  if (args$rewind) {
    args$nframes <- ceiling((args$nframes - args$start_pause) / 2)
    args$end_pause <- ceiling(args$end_pause / 2)
  }
  nframes_total <- (args$nframes - 1) * args$detail + 1
  plot <- prerender(plot, nframes_total)
  nframes_final <- get_nframes(plot)

  frame_ind <- unique0(round(seq(1, nframes_final, length.out = args$nframes)))

  if (args$device == 'current') {
    frame_ind <- c(rep(frame_ind[1], args$start_pause), frame_ind, rep(frame_ind[length(frame_ind)], args$end_pause))
    if (args$rewind) frame_ind <- c(frame_ind, rev(frame_ind))
    if (args$ref_frame < 0) {
      args$ref_frame <- args$ref_frame - args$end_pause
    } else {
      args$ref_frame <- args$ref_frame + args$start_pause
    }
  }

  if (args$nframes != length(frame_ind)) {
    cli::cli_inform('{.arg nframes} and {.arg fps} adjusted to match transition')
    args$fps <- args$fps * length(frame_ind) / args$nframes
  }

  if (args$ref_frame < 0) args$ref_frame <- nframes_final + 1 + args$ref_frame

  frames_vars <- inject(draw_frames(plot = plot, frames = frame_ind, device = args$device, ref_frame = args$ref_frame, !!!args$dev_args))
  if (args$device == 'current') return(invisible(frames_vars))

  if (args$start_pause != 0) frames_vars <- vec_rbind0(frames_vars[rep(1, args$start_pause), , drop = FALSE], frames_vars)
  if (args$end_pause != 0) frames_vars <- vec_rbind0(frames_vars, frames_vars[rep(nrow(frames_vars), args$end_pause), , drop = FALSE])
  if (args$rewind) frames_vars <- vec_rbind0(frames_vars, frames_vars[rev(seq_len(orig_nframes - nrow(frames_vars))), , drop = FALSE])

  animation <- args$renderer(frames_vars$frame_source, args$fps)
  attr(animation, 'frame_vars') <- frames_vars
  set_last_animation(animation)
  animation
}

#' Catch attempt to use the old API
#'
#' @export
#' @keywords internal
gganimate <- function(...) {
  cli::cli_abort(c(
    'It appears that you are trying to use the old API, which has been deprecated.',
    i = 'Please update your code to the new API or install the old version of gganimate from {.url https://github.com/thomasp85/gganimate/releases/tag/v0.1.1}'
  ))
}
#' @rdname gganimate
#' @export
gg_animate <- gganimate

#' @importFrom utils modifyList
prepare_args <- function(nframes, fps, duration, detail, renderer, device, ref_frame, start_pause, end_pause, rewind, ...) {
  args <- list()
  chunk_args <- if (is_knitting()) get_knitr_options(knitr::opts_current$get(), unlist = FALSE) else list(dev_args = list())
  args$nframes <- nframes %?% chunk_args$nframes %||% getOption('gganimate.nframes', 100)
  args$fps <- fps %?% chunk_args$fps %||% getOption('gganimate.fps', 10)
  duration <- duration %?% chunk_args$duration %||% getOption('gganimate.duration', NULL)
  if (!is.null(duration)) {
    if (
      !missing(fps) ||
      is.null(args$nframes) ||
      (!is.null(getOption('gganimate.fps')) && is.null(getOption('gganimate.nframes')))
    ) args$nframes <- duration * args$fps
    else args$fps <- args$nframes / duration
  }
  if (is.null(args$nframes) || is.null(args$fps)) {
    cli::cli_abort("At least 2 of {.arg nframes}, {.arg fps}, and {.arg duration} must be given")
  }
  args$detail <- detail %?% chunk_args$detail %||% getOption('gganimate.detail', 1)
  args$renderer <- renderer %?% chunk_args$renderer %||% getOption('gganimate.renderer', def_ren$renderer)
  args$device <- tolower(device %?% chunk_args$device %||% getOption('gganimate.device', 'png'))
  if (args$device == 'svglite') {
    check_installed('svglite', 'to use the svglite device')
  }
  if (args$device == 'ragg_png') {
    check_installed('ragg', 'to use the ragg_png device')
  }
  args$ref_frame <- ref_frame %?% chunk_args$ref_frame %||% getOption('gganimate.ref_frame', 1)
  args$start_pause <- start_pause %?% chunk_args$start_pause %||% getOption('gganimate.start_pause', 0)
  args$end_pause <- end_pause %?% chunk_args$end_pause %||% getOption('gganimate.end_pause', 0)
  args$rewind <- rewind %?% chunk_args$rewind %||% getOption('gganimate.rewind', FALSE)

  args$dev_args <- modifyList(getOption('gganimate.dev_args', list()), chunk_args$dev_args)
  args$dev_args <- modifyList(args$dev_args, list(...))

  args
}
# Build plot for a specific number of frames
prerender <- function(plot, nframes) {
  plot <- set_nframes(plot, nframes)
  ggplot_build(plot)
}
# Draw each frame as an image based on a specified device
# Returns a data.frame of frame metadata with image location in frame_source
# column
draw_frames <- function(plot, frames, device, ref_frame, ...) {
  stream <- device == 'current'

  dims <- try_fetch(
    plot_dims(plot, ref_frame),
    error = function(e) {
      cli::cli_warn('Cannot get dimensions of plot table. Plot region might not be fixed', parent = e)
      list(widths = NULL, heights = NULL)
    }
  )

  dir <- tempfile(pattern = '')
  dir.create(dir, showWarnings = FALSE)
  files <- file.path(dir, sprintf('gganim_plot%04d', seq_along(frames)))
  files <- switch(
    tolower(device),
    ragg_png = ,
    png = paste0(files, '.png'),
    jpg = ,
    jpeg = paste0(files, '.jpg'),
    tif = ,
    tiff = paste0(files, '.tif'),
    bmp = paste0(files, '.bmp'),
    svglite = ,
    svg = paste0(files, '.svg'),
    current = files,
    cli::cli_abort('Unsupported device: {device}')
  )
  device <- switch(
    device,
    ragg_png = ragg::agg_png,
    png = png,
    jpg = ,
    jpeg = jpeg,
    tif = ,
    tiff = tiff,
    bmp = bmp,
    svg = svg,
    svglite = svglite::svglite
  )
  args <- list(...)
  args <- args[names(args) %in% names(formals(device))]

  pb <- progress_bar$new(
    'Rendering [:bar] at :fps fps ~ eta: :eta',
    total = length(frames)
  )
  start <- Sys.time()
  pb$tick(0)

  for (i in seq_along(frames)) {
    if (!stream) inject(device(files[i], !!!args))

    try_fetch(
      plot$scene$plot_frame(plot, frames[i], widths = dims$widths, heights = dims$heights),
      error = function(e) {
        cli::cli_warn('Failed to plot frame', parent = e)
      }
    )

    rate <- i/as.double(Sys.time() - start, units = 'secs')
    if (is.nan(rate)) rate <- 0
    rate <- format(rate, digits = 2)
    pb$tick(tokens = list(fps = rate))

    if (!stream) dev.off()
  }

  frame_vars <- plot$scene$frame_vars[frames, , drop = FALSE]
  if (!stream) frame_vars$frame_source <- files
  frame_vars
}
# Get dimensions of plot based on a reference frame
plot_dims <- function(plot, ref_frame) {
  tmpf <- tempfile()
  png(tmpf)
  on.exit({
    dev.off()
    unlink(tmpf)
  })
  frame <- plot$scene$get_frame(plot, ref_frame)
  frame <- ggplot_gtable(frame)
  widths_rel <- frame$widths
  widths <- convertWidth(widths_rel, 'mm')
  heights_rel <- frame$heights
  heights <- convertHeight(heights_rel, 'mm')
  if (is_list(widths)) { # New unit spec
    null_widths <- vapply(unclass(widths), `[[`, numeric(1), 1L) == 0
    null_heights <- vapply(unclass(heights), `[[`, numeric(1), 1L) == 0
  } else {
    null_widths <- as.numeric(widths) == 0
    null_heights <- as.numeric(heights) == 0
  }
  widths[null_widths] <- widths_rel[null_widths]
  heights[null_heights] <- heights_rel[null_heights]
  list(widths = widths, heights = heights)
}

is_knitting <- function() isTRUE(getOption("knitr.in.progress"))