R/tmap_animation.R

In r-tmap/tmap: Thematic Maps

#' Create animation
#' 
#' Create a gif animation or video from a tmap plot.
#' 
#' @param tm tmap or a list of tmap objects. If `tm` is a tmap object,
#'   facets should be created, where `nrow` and `ncol` in [tm_facets()] have to
#'   be set to 1 in order to create one map per frame.
#' @param filename filename. If omitted (default), the animation will be shown
#'   in the viewer or browser. If specified, it should be a gif file or a video
#'   file (i.e. mp4). The package `gifski` is required to create a gif animation.
#'   The package `av` (which uses the `FFmpeg` library) is required for video formats.
#'   The mp4 format is recommended but many other video formats are supported,
#'   such as wmv, avi, and mkv.
#' @param width,height Dimensions of the animation file (in pixels).
#'   Required when `tm` is a list, and recommended to specify in advance when
#'   `tm` is a `tmap` object. If not specified in the latter case, it will be
#'   determined by the aspect ratio of the map.
#' @param dpi dots per inch. By default 100, but this can be set with the option
#'   `output.dpi.animation` in [tmap_options()].
#' @param delay delay time between images (in 1/100th of a second). See also `fps`
#' @param fps frames per second, calculated as `100 / delay`. If `fps` is specified,
#'   the `delay` will be set to `100/fps`.
#' @param loop logical that determined whether the animation is looped, or an
#'   integer value that determines how many times the animation is looped.
#' @param outer.margins (passed on to [tmap_save()]) overrides the outer.margins
#'   argument of `tm_layout()` (unless set to `NA`)
#' @param asp (passed on to [tmap_save()]) if specified, it overrides the `asp`
#'   argument of `tm_layout()`. Tip: set to `0` if map frame should be placed on
#'   the edges of the image.
#' @param scale (passed on to [tmap_save()]) overrides the scale argument of
#'   [tm_layout()] (unless set to `NA`)
#' @param restart.delay not used anymore.
#' @param ... arguments passed on to [av::av_encode_video()]
#' @note Not only tmap plots are supported, but any series of R plots.
#' @concept animation
#' @example ./examples/tmap_animation.R
#' @import tmaptools
#' @importFrom utils browseURL
#' @export
tmap_animation <- function(tm, filename = NULL, width = NA, height = NA, dpi = NA, delay = 40, fps = NA, loop = TRUE, outer.margins = NA, asp = NULL, scale = NA, restart.delay = NULL, ...) {
	.tmapOptions <- get("tmapOptions", envir = .TMAP)
	
	showAni = missing(filename)
	if (showAni) filename = tempfile(fileext = ".gif")
	
	progress = .tmapOptions$show.messages
	
	if (!is.numeric(delay) || !(length(delay) == 1L)) stop("delay must be a numeric value", call. = FALSE)
	if ((!is.numeric(loop) && !is.logical(loop)) || !(length(loop) == 1L)) stop("loop must be a logical or numeric value", call. = FALSE)
	#if (!is.numeric(restart.delay) || !(length(restart.delay) == 1L)) stop("restart.delay must be a numeric value", call. = FALSE)
	
	if (!is.na(fps)) delay = 100 / fps
	
	gif = substr(filename, nchar(filename) - 2, nchar(filename)) == "gif"
	
	#syscall <- if (.Platform$OS.type == "unix") system else shell ## macOS == unix
	
	# check system requirements
	if (gif) {
		rlang::check_installed("gifski", reason = "for creating gif animations.")
	} else {
		rlang::check_installed("av", reason = "for ffmpeg animations")
	}
	
	if (is.na(dpi)) dpi <- .tmapOptions$output.dpi.animation
	
	# create plots
	d <- paste(tempdir(), "/tmap_plots", sep="/")
	dir.create(d, showWarnings = FALSE)
	
	if (progress) cat("Creating frames\n")
	
	even = if (gif) round else {
		function(x) round(x / 2) *2
	} # av requires height to be divisible by 2
	
	
	if (inherits(tm, "tmap_arrange") || (is.list(tm) && !inherits(tm, "tmap"))) {
		
		if (progress) pb = txtProgressBar()
		
		if (is.na(width) || is.na(height)) stop("The arguments width and height need to be specified both.")
		for (i in 1:length(tm)) {
			if (progress) setTxtProgressBar(pb, i/length(tm))
			tmi = tm[[i]]
			if (!inherits(tmi, "tmap")) stop("List item ", i, " of tm is not a tmap object.")
			suppressMessages(tmap_save(tm[[i]], filename = paste0(d, "/plot", sprintf("%03d", i), ".png"), width=width, height=height, dpi=dpi, outer.margins=outer.margins, asp=asp, scale=scale))
		}
	} else if (inherits(tm, "tmap")) {
		if (is.na(width) || is.na(height)) {
			sasp <- get_asp_ratio(tm, width = 700, height = 700, res = dpi)	
			
			if (is.na(width) && is.na(height)) {
				height <- even(sqrt(.tmapOptions$output.size / sasp) * dpi)
				width <- round(height * sasp)
			} else if (is.na(width)) {
				width = round(height * sasp)
			} else {
				height = even(width / sasp)
			}
		}
		if (!gif) height = even(height)
		
		suppressMessages(tmap_save(tm, filename = paste(d, "plot%03d.png", sep="/"), width=width, height=height, dpi=dpi, outer.margins=outer.margins, asp=asp, scale=scale))
	} else {
		stop("tm should be a tmap object or a list of tmap objects")
	}
	
	files <- list.files(path = d, pattern = "^plot[0-9]{3}\\.png$")
	k <- length(files)
	
	if (progress) cat("\nCreating animation\n")
	
	if (gif) {
		gifski::gifski(file.path(d, files), 
					   delay = delay / 100, 
					   width = width, height = height,
					   gif_file  = filename,
					   progress = progress,
					   loop = loop)
	} else {
		args = list(...)
		if (!("verbose" %in% names(args))) args$verbose = FALSE
		do.call(av::av_encode_video,
				c(list(file.path(d, files), 
					   output = filename,
					   framerate = 100/delay),
				  args))
	}
	
	
	# cleaning up plots
	unlink(d, recursive = TRUE)
	
	if (showAni) {
		viewer = getOption("viewer", utils::browseURL)
		if (is.function(viewer)) {
			viewer(filename)
		} else {
			if (progress) cat("Unable to open animation in viewer nor browser. Animation saved to", suppressWarnings(normalizePath(filename)), "\n")
			invisible()	
		}
	} else {
		if (progress) cat("Animation saved to", suppressWarnings(normalizePath(filename)), "\n")
		invisible()	
	}
	
}