R/axis_limits.R

In MiguelRodo/plotutils:

#' @title Manage axis limits
#'
#' @description Manage axis limits. Enforce certain points to be included (e.g. 0), and/or
#' force axis limits to be the same between x- and y-axes.
#'
#' @param p object of class 'ggplot'. Limits are adjusted for this plot.
#' @param limits_expand list. If not \code{NULL},
#' then it is (effectively) passed onto \code{ggplot2::limits_expand} to
#' ensure that certain values are included in the plot (such as, for example, 0
#' if that is the minimum value possible but it may not be plotted). If not named, then
#' must consist of one numeric vector that will then force all values in the numeric value
#' to be included in the plot. If named, then must have names \code{x} and/or \code{y},
#' with the elements again being numeric vectors that must be included in plot.
#' @param limits_equal logical. If \code{TRUE}, then the ranges on the x- and y-axes
#' must be equal. Effectively applied after expand_grid is applied. Default is \code{FALSE}.
#'
#' @export
#'
#' @import ggplot2
#'
#' @examples
#' data('cars', package = 'datasets')
#' library(ggplot2)
#' p <- ggplot(cars, aes(speed, dist)) +
#'   geom_point()
#'
#' axis_limits(
#'   p,
#'   limits_equal = TRUE)
#'
#' # both axes
#' axis_limits(
#'   p,
#'   limits_expand = list(200))
#' # x only
#' axis_limits(
#'   p,
#'   limits_expand = list(x = 75))
#' # y only
#' axis_limits(
#'   p,
#'   limits_expand = list(y = 200))
#' # lower and upper expansion
#' axis_limits(
#'   p,
#'   limits_expand = list(y = c(-50, 200),
#'                        x = c(-10, 75)))
#'
#' # note that when fixing range and expanding, range is fixed
#' # after expansions are applied, so effectively the larger expansions apply to both.
#' # compare the following output to the previous output:
#' axis_limits(
#'   p,
#'   limits_expand = list(y = c(-50, 200),
#'                        x = c(-10, 75)),
#'   limits_equal = TRUE)
axis_limits <- function(
  p,
  limits_expand = NULL,
  limits_equal = FALSE){

  # initial check
  # ------------------------

  if(!is.logical(limits_equal)){
    stop("limits_equal must be logical")
  }

  # do nothing
  if(is.null(limits_expand) && !limits_equal) return(p)

  # checks
  # ----------------------------

  if(!identical(class(p),
                c("gg", "ggplot"))){
    stop("p must be of class c('gg', 'ggplot')")
  }

  if(!is.null(limits_expand)){
    if(!is.list(limits_expand)){
      stop("limits_expand must be a list (if not NULL)")
    }
    if(length(limits_expand) == 2 && is.null(names(limits_expand))){
      stop("limits_expand must be named if of length 2")
    }
    if(length(limits_expand) > 2){
      stop("limits_expand must have length 1 or 2 (if not NULL)")
    }
    if(!is.null(names(limits_expand))){
      if(length(setdiff(names(limits_expand), c('x', 'y'))) > 0){
        stop("limits_expand must have names of 'x' and/or 'y' (if named)")
      }
    }
    class_input <- purrr::map_lgl(limits_expand, is.numeric) %>% all()
    if(!class_input){
      stop("input to limits_expand must be numeric (if limits_expand not NULL)")
    }
  }

  # prep
  # -------------------



  # ===================
  # adjustments
  # ===================

  # calc ranges in advance if needed
  # --------------------
  if(limits_equal){
    plot_tbl <- p$data
    x_var <- as.character(rlang::get_expr(p$mapping$x))
    y_var <- as.character(rlang::get_expr(p$mapping$y))
    range_x <- range(plot_tbl[[x_var]])
    range_y <- range(plot_tbl[[y_var]])
    range <- c(min(range_x[1], range_y[1]),
               c(max(range_x[2], range_y[2])))
  }

  # tidy limits_expand if provided
  # ------------------

  # ensure that limits_expand is named if
  # it's specified
  if(!is.null(limits_expand)){
    if(is.null(names(limits_expand))){
      limits_expand <- list(
        x = limits_expand[[1]],
        y = limits_expand[[1]]
      )
    }
    # ensure that limits_expand consists of
    # two sorted (not strictly) variables
    for(i in seq_along(limits_expand)){
      limits_expand[[i]] <- c(min(limits_expand[[i]]),
                              max(limits_expand[[i]]))
    }
  }

  # put limits_expand together with limits_equal,
  # if provided
  if(is.null(limits_expand)){
    # we know now that limits_equal is true
    limits_expand <- list(
      x = range,
      y = range
    )
  } else{
    # limits_equal may or may not be true
    if(limits_equal){
      limits_expand_all <- limits_expand %>%
        unlist()
      lims <- c(min(range, limits_expand_all),
                max(range, limits_expand_all))
      for(i in seq_along(limits_expand)){
        limits_expand[[i]] <- lims
      }
      if(length(limits_expand) == 1){
        nm <- setdiff(c('x', 'y'), names(limits_expand))
        limits_expand %<>%
          append(list(range) %>% setNames(nm))
      }
    }
  }

  limits_expand_arg <- purrr::map_chr(seq_along(limits_expand), function(i){
    vals <- paste0(limits_expand[[i]], collapse = ", ")
    paste0(names(limits_expand)[i], " = c(", vals, ")")
  }) %>%
    paste0(collapse = ", ")

  parse_text <- paste0("p <- p + expand_limits(", limits_expand_arg, ")")
  env <- environment()
  eval(parse(text = parse_text), envir = env)

  p


}