R/leg_comp.R

In maplegend: Legends for Maps

#' @title Compose a map legend
#' @description Compose a map legend with several elements.
#' The "type" argument defines the
#' legend type.
#' Please note that some arguments are available for all types of legend and
#' some others are only relevant for specific legend types.
#'
#' @md
#' @param leg legend object
#' @param type type of legend:
#' * **prop** for proportional symbols,
#' * **choro** for choropleth maps,
#' * **cont** for continuous maps (e.g. raster),
#' * **typo** for typology maps,
#' * **symb** for symbols maps,
#' * **prop_line** for proportional lines maps,
#' * **grad_line** for graduated lines maps,
#' * **histo** for histograms,
#' * **choro_point** for choropleth points maps,
#' * **choro_line** for choropleth lines maps,
#' * **choro_symb** for choropleth on symbols maps
#' * **typo_line** for typology lines maps.
#' @param val
#' vector of value(s) (for "prop" and "prop_line", at least c(min, max)
#' for "cont"),
#' vector of categories (for "symb", "typo", "typo_line"),
#' break labels (for "choro", "choro_point", "choro_line", "choro_symb",
#' and "grad_line"),
#' histogram parameters (for "histo").
#' @param pal a color palette name or a vector of colors
#' @param alpha opacity, in the range \[0,1\]
#' @param inches size of the largest symbol (radius for circles, half width
#' for squares) in inches
#' @param val_max maximum value corresponding to the largest symbol or line
#' @param border symbol border color(s)
#' @param symbol type of symbols, 'circle' or 'square'
#' @param self_adjust if TRUE values are self-adjusted to keep min, max and
#' intermediate rounded values
#' @param title title of the legend
#' @param val_rnd number of decimal places of the values in
#' the legend
#' @param val_dec decimal separator
#' @param val_big thousands separator
#' @param no_data if TRUE a "missing value" box is plotted
#' @param no_data_txt label for missing values
#' @param box_border border color of legend boxes
#' @param box_cex width and height size expansion for boxes, histogram or lines
#' @param col color of the symbols (for "prop") or color of the lines (for
#' "prop_line" and "grad_line")
#' @param lwd width(s) of the symbols borders (for "prop", "symb",
#' "choro_point", "choro_symb"),
#' width of the largest line (for "prop_line"), line width (for "choro_line"
#' and "typo_line"), vector of line widths (for "grad_line")
#' @param cex size(s) of the symbols
#' @param pch type(s) of the symbols (0:25)
#' @param col_na color for missing values
#' @param cex_na size of the symbols for missing values
#' @param pch_na type of the symbols for missing values
#' @param horiz if TRUE plot an horizontal legend
#' @return A list of legends parameters is returned.
#' @export
#' @examples
#' # minimal example
#' plot.new()
#' plot.window(xlim = c(0, 1), ylim = c(0, 1), asp = 1)
#' box()
#' leg_comp(type = "prop", val = c(10, 50, 100)) |>
#'   leg_comp(type = "typo", val = c("A", "B", "C")) |>
#'   leg_draw()
leg_comp <- function(leg,
                     type,
                     val,
                     pal = "Inferno",
                     alpha = NULL,
                     col = "tomato4",
                     inches = .3,
                     val_max = NULL,
                     symbol = "circle",
                     self_adjust = FALSE,
                     lwd = 0.7,
                     border = "#333333",
                     pch = 1:seq_along(val),
                     cex = rep(1, length(val)),
                     title = "Legend Title",
                     val_rnd = 0,
                     val_dec = ".",
                     val_big = "",
                     col_na = "white",
                     cex_na = 1,
                     pch_na = 4,
                     no_data = FALSE,
                     no_data_txt = "No Data",
                     box_border = "333333",
                     box_cex = c(1, 1),
                     horiz = FALSE) {
  res <- as.list(match.call()[-1])
  res <- lapply(res, eval)

  res <- clean_input(res, type = type)
  if (missing(leg)) {
    leg <- list()
  }
  leg$layers[[length(leg$layers) + 1]] <- res
  return(leg)
}


clean_input <- function(res, type) {
  res <- res[unlist(lapply(
    X = res,
    FUN = function(x) {
      !is.name(x)
    }
  ))]
  res$leg <- NULL
  res$type <- type
  res
}