Permalink
Branch: master
Find file Copy path
496 lines (482 sloc) 17.7 KB
#' Renderers provided by gganimate
#'
#' The purpose of the renderer function is to take a list of image files and
#' assemble them into an animation. `gganimate` provide a range of renderers
#' but it is also possible to provide your own, if the supplied ones are lacking
#' in any way. A renderer is given as argument to [animate()]/print() and
#' receives the paths to the individual frames once they have been created.
#'
#' @details The `gifski_renderer()` is used unless otherwise specified in
#' [animate()] or in `options('gganimate.renderer')`. This renderer requires
#' both the `gifski` and `png` packages to be installed.
#'
#' Other possible renderers are:
#' - `magick_renderer()` which requires the `magick` package and produce a `gif`.
#' If `gifski` is not installed, the rendering will be much slower than using the
#' `gifski_renderer()` and can potentially result in system problems when many
#' frames need to be rendered (if `gifski` is installed `magick` will use it
#' under the hood)
#' - `av_renderer()` which requies the `av` package and uses ffmpeg to encode
#' the animation into a video file.
#' - `ffmpeg_renderer()` which requires that ffmpeg has been installed on your
#' computer. As with `av_renderer()` it will use ffmpeg to encode the animation
#' into a video
#' - `sprite_renderer()` which requires `magick` and will render the animation
#' into a spritesheet
#' - `file_renderer()` which has no dependencies and simply returns the
#' animation as a list of image files (one for each frame)
#'
#' It is possible to create your own renderer function providing that it
#' matches the required signature (`frames` and `fps` argument). The return
#' value of your provided function will be the return value ultimately given by
#' [animate()]
#'
#' @param loop Logical. Should the produced gif loop
#' @param file The animation file
#' @param dir The directory to copy the frames to
#' @param prefix The filename prefix to use for the image files
#' @param overwrite Logical. If TRUE, existing files will be overwritten.
#' @param width,height Dimensions of the animation in pixels. If `NULL` will
#' take the dimensions from the frame, otherwise it will rescale it.
#' @param vfilter A string defining an ffmpeg filter graph. This is the same
#' parameter as the `-vf` argument in the `ffmpeg` command line utility.
#' @param codec The name of the video codec. The default is `libx264` for most
#' formats, which usually the best choice. See the `av` documentation for more
#' information.
#' @param audio An optional file with sounds to add to the video
#' @param format The video format to encode the animation into
#' @param ffmpeg The location of the `ffmpeg` executable. If `NULL` it will be
#' assumed to be on the search path
#' @param options Either a character vector of command line options for ffmpeg
#' or a named list of option-value pairs that will be converted to command line
#' options automatically
#' @param ... arguments passed on to the selected renderer
#'
#' @return The provided renderers are factory functions that returns a new function
#' that take `frames` and `fps` as arguments, the former being a character
#' vector with file paths to the images holding the separate frames, in the
#' order they should appear, and the latter being the framerate to use for the
#' animation in frames-per-second.
#'
#' The return type of the different returned renderers are:
#' - **`gifski_renderer`**: Returns a [gif_image] object
#' - **`magick_renderer`**: Returns a `magick-image` object
#' - **`av_renderer`**: Returns a [video_file] object
#' - **`ffmpeg_renderer`**: Returns a [video_file] object
#' - **`file_renderer`**: Returns a vector of file paths
#'
#' @name renderers
#' @rdname renderers
#'
#' @examples
#' anim <- ggplot(mtcars, aes(mpg, disp)) +
#' transition_states(gear, transition_length = 2, state_length = 1) +
#' enter_fade() +
#' exit_fade()
#'
#' \dontrun{
#' # Renderers are specified in the `animate()` function
#' animate(anim, renderer = sprite_renderer())
#' }
#'
NULL
gifski_error <- new.env(parent = emptyenv())
gifski_error$first <- TRUE
#' @rdname renderers
#' @export
gifski_renderer <- function(file = tempfile(fileext = '.gif'), loop = TRUE, width = NULL, height = NULL) {
if (!requireNamespace('gifski', quietly = TRUE)) {
if (gifski_error$first) {
gifski_error$first <- FALSE
stop(
'The `gifski_renderer()` is selected by default but requires the gifski\n',
'package to be installed. Either install gifski or use another renderer.\n',
'See `?renderers` for a list of available ones.',
call. = FALSE
)
} else {
stop('The gifski package is required to use gifski_renderer', call. = FALSE)
}
}
if (!requireNamespace('png', quietly = TRUE)) {
stop('The png package is required to use gifski_renderer', call. = FALSE)
}
function(frames, fps) {
if (!all(grepl('.png$', frames))) {
stop('gifski only supports png files', call. = FALSE)
}
if (is.null(width) || is.null(height)) {
dims <- dim(png::readPNG(frames[1], native = TRUE))
height <- height %||% dims[1]
width <- width %||% dims[2]
}
progress <- interactive()
if (progress) message('')
gif <- gifski::gifski(frames, file, width, height, delay = 1/fps, loop, progress)
gif_file(gif)
}
}
#' @rdname renderers
#' @export
file_renderer <- function(dir = '.', prefix = 'gganim_plot', overwrite = FALSE) {
function(frames, fps) {
if (!dir.exists(dir)) dir.create(dir, showWarnings = FALSE, recursive = TRUE)
new_names <- file.path(dir, sub('gganim_plot', prefix, basename(frames)))
if (any(!file.copy(frames, new_names, overwrite = overwrite))) {
warning('file_renderer failed to copy frames to the destination directory', call. = FALSE)
}
invisible(new_names)
}
}
#' @rdname renderers
#' @export
av_renderer <- function(file = NULL, vfilter = "null", codec = NULL, audio = NULL) {
if (!requireNamespace('av', quietly = TRUE)) {
stop('The av package is required to use av_renderer', call. = FALSE)
}
if (is.null(file)) {
ext <- if (.Platform$GUI == "RStudio" && "libvpx" %in% av::av_encoders()$name) ".webm" else ".mp4"
file <- tempfile(fileext = ext)
}
function(frames, fps) {
progress <- interactive()
av::av_encode_video(input = frames, output = file, framerate = fps,
vfilter = vfilter, codec = codec, audio = audio,
verbose = progress)
video_file(file)
}
}
has_ffmpeg <- function(ffmpeg = 'ffmpeg') {
tryCatch(
{
suppressWarnings(system2(ffmpeg, '-version', stdout = FALSE, stderr = FALSE))
TRUE
},
error = function(e) {
FALSE
}
)
}
#' @rdname renderers
#' @export
ffmpeg_renderer <- function(format = 'auto', ffmpeg = NULL, options = list(pix_fmt = 'yuv420p')) {
ffmpeg <- ffmpeg %||% 'ffmpeg'
if (!has_ffmpeg(ffmpeg)) stop('The ffmpeg library is not available at the specified location', call. = FALSE)
if (format == 'auto') {
format <- if (.Platform$GUI == "RStudio" &&
any(grepl('--enable-libvpx', system2('ffmpeg', '-version', stdout = TRUE)))) {
"webm"
} else {
"mp4"
}
}
if (is.list(options)) {
if (is.null(names(options))) {
stop('options list must be named', call. = FALSE)
}
opt_name <- paste0('-', sub('^-', '', names(options)))
opts <- vapply(options, paste, character(1), collapse = ' ')
options <- paste(paste0(opt_name, ' ', opts), collapse = ' ')
}
stopifnot(is.character(options))
function(frames, fps) {
progress <- interactive()
output_file <- tempfile(fileext = paste0('.', sub('^\\.', '', format)))
frame_loc <- dirname(frames[1])
file_glob <- sub('^.*(\\..+$)', 'gganim_plot%4d\\1', basename(frames[1]))
file_glob <- file.path(frame_loc, file_glob)
system2(ffmpeg, c("-pattern_type sequence",
paste0('-i ', file_glob),
'-y',
'-loglevel ', if (progress) 'info' else 'quiet',
paste0('-framerate ', 1/fps),
'-hide_banner',
options,
output_file
))
if (!file.exists(output_file)) stop('Rendering with ffmpeg failed', call. = FALSE)
if (format == 'gif') {
gif_file(output_file)
} else {
video_file(output_file)
}
}
}
#' @rdname renderers
#' @export
magick_renderer <- function(loop = TRUE) {
if (!requireNamespace('magick', quietly = TRUE)) {
stop('The magick package is required to use magick_renderer', call. = FALSE)
}
function(frames, fps) {
anim <- if (grepl('.svg$', frames[1])) {
magick::image_read_svg(frames)
} else {
magick::image_read(frames)
}
anim <- magick::image_animate(anim, fps, loop = if (loop) 0 else 1)
anim
}
}
#' @rdname renderers
#' @export
sprite_renderer <- function() {
if (!requireNamespace('magick', quietly = TRUE)) {
stop('The magick package is required to use sprite_renderer', call. = FALSE)
}
function(frames, fps) {
sprite <- if (grepl('.svg$', frames[1])) {
magick::image_read_svg(frames)
} else {
magick::image_read(frames)
}
single_dim <- magick::image_info(sprite[1])
sprite <- magick::image_append(sprite)
full_dim <- magick::image_info(sprite)
file <- tempfile(fileext = '.png')
magick::image_write(sprite, file, 'png')
sprite_file(file, fps, width = single_dim$width, full_width = full_dim$width, height = single_dim$height)
}
}
# HELPERS -----------------------------------------------------------------
#' Wrap a gif file for easy handling
#'
#' This is a simple class for gif files that takes care printing the file
#' correctly in different environment (e.g. knitr, RStudio, etc.). If your
#' renderer produces a gif file you can wrap the final output in `gif_file` to
#' get all of these benefits for free.
#'
#' @param file The gif file to be wrapped
#' @param x A `gif_image` object
#' @inheritParams base::split
#' @param ... Arguments passed on
#'
#' @return `gif_file` returns a `gif_image` object. `split` returns a list of
#' `magick-image` objects and requires magick to work.
#'
#' @keywords internal
#' @export
#' @aliases gif_image
#'
gif_file <- function(file) {
stopifnot(length(file) == 1)
if (!grepl('.gif$', file)) stop('file must be a gif', call. = FALSE)
class(file) <- 'gif_image'
file
}
#' @rdname gif_file
#' @export
print.gif_image <- function(x, ...) {
viewer <- getOption("viewer", utils::browseURL)
if (is.function(viewer) && length(x)) {
viewer(x)
} else {
invisible()
}
}
#' @rdname gif_file
#' @export
knit_print.gif_image <- function(x, options, ...) {
knitr_path <- knitr::fig_path('.gif', options)
dir.create(dirname(knitr_path), showWarnings = FALSE, recursive = TRUE)
file.copy(x, knitr_path, overwrite = TRUE)
if (is.null(options$out.width)) {
options$out.width <- options$fig.width * options$dpi / (options$fig.retina %||% 1)
}
knitr::knit_print(knitr::include_graphics(knitr_path), options, ...)
}
#' @rdname gif_file
#' @export
split.gif_image <- function(x, f, drop = FALSE, ...) {
if (!requireNamespace('magick', quietly = TRUE)) {
stop('Splitting gifs require the magick package', call. = FALSE)
}
gif <- magick::image_read(x)
split(gif, f, drop = drop, ...)
}
#' Wrap a video file for easy handling
#'
#' This function is equivalent to [gif_file()] but works for arbitrary video
#' file formats. There are some caveats involved though, most notably it doesn't
#' currently supports splitting so you can't easily use this output together
#' with [split_animation()]. Graceful printing is contingent on the file format.
#' Only `mp4`, `webm`, and `ogg` is supported by the HTML format and can thus be
#' shown in the RStudio viewer and inside HTML documents created with knitr.
#' Other formats will be opened in their default OS-specific viewer.
#'
#' @param file A video file
#' @param x A `video_file` object
#' @param width The width the output should be scaled to
#' @param ... Arguments passed on
#'
#' @return `video_file` returns a `video_file` object which is a shallow wrapper
#' around the file path text string.
#'
#' @keywords internal
#' @export
#'
video_file <- function(file) {
stopifnot(length(file) == 1)
class(file) <- 'video_file'
file
}
#' @rdname video_file
#' @export
print.video_file <- function(x, width = NULL, ...) {
if (grepl('\\.(mp4)|(webm)|(ogg)$', x, ignore.case = TRUE)) {
if (grepl('\\.mp4$', x, ignore.case = TRUE) && .Platform$GUI == "RStudio") {
utils::browseURL(x)
} else {
print(htmltools::browsable(as_html_video(x, width)))
}
} else {
viewer <- getOption("viewer", utils::browseURL)
viewer(x)
}
}
#' @rdname video_file
#' @export
knit_print.video_file <- function(x, options, ...) {
if (grepl('\\.(mp4)|(webm)|(ogg)$', x, ignore.case = TRUE)) {
knitr::knit_print(htmltools::browsable(as_html_video(x, width = get_chunk_width(options))), options, ...)
} else {
warning('The video format doesn\'t support HTML', call. = FALSE)
invisible(NULL)
}
}
#' @export
split.video_file <- function(x, f, drop = FALSE, ...) {
stop('video_file objects does not support splitting', call. = FALSE)
}
as_html_video <- function(x, width = NULL) {
if (!requireNamespace("base64enc", quietly = TRUE)) {
stop('The base64enc package is required for showing video')
}
if (!requireNamespace("htmltools", quietly = TRUE)) {
stop('The htmltools package is required for showing video')
}
format <- tolower(sub('^.*\\.(.+)$', '\\1', x))
htmltools::HTML(paste0(
'<video controls autoplay',
if (is.null(width)) '' else paste0(' width="', width, '"'),
'><source src="data:video/',
format,
';base64,',
base64enc::base64encode(x),
'" type="video/mp4"></video>'
))
}
#' Wrap an image sprite for easy handling
#'
#' This function is equivalent to [gif_file()] but works for animations encoded
#' as a sprite. A sprite is a single image file where each frame of the
#' animation is stacked next to each other. The animation then happens by
#' changing what slice of the image is shown. The implementation used allow
#' users to click on the animation in order to toggle pause/play.
#'
#' @param file A png file with frames placed horizontally
#' @param fps The framerate for the sprite animation
#' @param width,height The dimension of a single frame
#' @param full_width The width of the whole image
#' @param x A `sprite_image` object
#' @param ... Arguments passed on
#'
#' @return `sprite_file` returns a `sprite_image` object which is a shallow wrapper
#' around the file path text string along with dimensions and fps used for
#' animating the sprite when printing.
#'
#' @keywords internal
#' @export
#'
sprite_file <- function(file, fps, width, full_width, height) {
stopifnot(length(file) == 1)
attributes(file) <- list(fps = fps, single_width = width, full_width = full_width, height = height)
class(file) <- 'sprite_image'
file
}
#' @rdname sprite_file
#' @export
print.sprite_image <- function(x, width = NULL, ...) {
print(htmltools::browsable(as_sprite_html(x, width = width)))
}
#' @rdname sprite_file
#' @export
knit_print.sprite_image <- function(x, options, ...) {
knitr::knit_print(htmltools::browsable(as_sprite_html(x, width = get_chunk_width(options))), options, ...)
}
#' @importFrom glue glue
as_sprite_html <- function(x, width = NULL, ...) {
if (!requireNamespace("base64enc", quietly = TRUE)) {
stop('The base64enc package is required for showing video')
}
if (!requireNamespace("htmltools", quietly = TRUE)) {
stop('The htmltools package is required for showing video')
}
# Sprite animation code inspired by https://medium.com/dailyjs/how-to-build-a-simple-sprite-animation-in-javascript-b764644244aa
sprite_id <- sample(1e6, 1)
css <- glue(
'
<style>
#sprite-%sprite_id% {
padding-bottom: %height%;
width: %width%;
background: url(data:image/png;base64,%img_encode%) 0px 0px;
background-size: %size%;
}
</style>
',
height = paste0(100*attr(x, 'height') / attr(x, 'single_width'), '%'),
width = width %||% paste0(attr(x, 'single_width'), 'px'),
size = paste0(100 * attr(x, 'full_width') / attr(x, 'single_width'), '%'),
img_encode = base64enc::base64encode(x),
.open = '%',
.close = '%'
)
html <- glue('<div class="gganimate-sprite"><div id="sprite-{sprite_id}" onclick="toggleAnimation_{sprite_id}()"></div></div>')
js <- glue(
'
<script>
var tID_%sprite_id%;
var running_%sprite_id% = true;
var position_%sprite_id% = %width%;
function toggleAnimation_%sprite_id%() {
if (running_%sprite_id%) {
clearInterval(tID_%sprite_id%);
} else {
animateScript_%sprite_id%();
}
running_%sprite_id% = !running_%sprite_id%;
}
function animateScript_%sprite_id%() {
const interval = 1/%fps% * 1000; //100 ms of interval for the setInterval()
const diff = %width%; //diff as a variable for position offset
tID_%sprite_id% = setInterval(() => {
document.getElementById("sprite-%sprite_id%").style.backgroundPosition = `${position_%sprite_id%}%% 0%%`;
if (position_%sprite_id% < 100) {
position_%sprite_id% = position_%sprite_id% + diff;
} else {
position_%sprite_id% = %width%;
}
}, interval);
}
animateScript_%sprite_id%()
</script>
',
width = 100 / (attr(x, 'full_width') / attr(x, 'single_width') - 1),
fps = attr(x, 'fps'),
.open = '%',
.close = '%'
)
full <- paste0(css, '\n', html, '\n', js)
htmltools::HTML(full)
}
#' @export
split.sprite_image <- function(x, f, drop = FALSE, ...) {
stop('sprite_image objects does not support splitting', call. = FALSE)
}
in_pkgdown <- function() {
identical(Sys.getenv("IN_PKGDOWN"), "true")
}
get_chunk_width <- function(options) {
options$out.width %||% paste0((options$fig.width / (options$fig.retina %||% 1)), 'px')
}