R/save_ggmap.R

In arnaudgallou/toolkit: Helpers Functions

#' @title Save maps produced with ggplot with appropriate aspect ratio
#' @description Wrapper around [`ggsave()`][ggplot2::ggsave()] to save maps produced with ggplot with appropriate aspect ratio.
#' @param filename File name to create on disk.
#' @param plot Plot to save, defaults to last plot displayed.
#' @param width,height Plot size in units ("in", "cm", or "mm"). If not supplied, uses the size of current graphics device.
#' @param ... Other arguments passed on to [`ggsave()`][ggplot2::ggsave()].
#' @examples
#' \dontrun{
#' world <- rnaturalearth::ne_countries(returnclass = "sf")
#'
#' ggplot() +
#'   geom_sf(data = world) +
#'   coord_sf(expand = FALSE) +
#'   theme_void()
#'
#' save_ggmap("world.svg", width = 8)
#' }
#' @export
save_ggmap <- function(filename, plot = last_plot(), width = NA, height = NA, ...) {
  geometry <- ggplot_build(plot)$data[[1]]$geometry
  asp <- get_aspect_ratio(geometry)
  if (is.na(width) && !is.na(height)) {
    width <- height * asp
  } else if (is.na(height) && !is.na(width)) {
    height <- width / asp
  }
  ggsave(filename, plot, width = width, height = height, ...)
}


# based on https://github.com/r-tmap/tmaptools/blob/master/R/get_asp_ratio.R
get_aspect_ratio <- function(geometry) {
  if (!inherits(geometry, c("Spatial", "Raster", "sf", "sfc"))) {
    stop('"geometry" must be of class "Spatial", "Raster", "sf" or "sfc".')
  }
  bbox <- st_bbox(geometry)
  xlim <- bbox[c(1, 3)]
  ylim <- bbox[c(2, 4)]
  xdeg <- diff(xlim)
  ydeg <- diff(ylim)
  if (xdeg == 0 || ydeg == 0) {
    asp <- 1
  } else {
    is_lon_lat <- st_is_longlat(geometry)
    lat_coef <- ifelse(is_lon_lat, cos(deg_to_rad(ylim)), 1)
    asp <- unname((xdeg / ydeg) * lat_coef)
  }
  asp
}


deg_to_rad <- function(x) {
  (mean(x) * pi) / 180
}