ggplot2 aes函数map到data笔记

.all_aesthetics <- c("adj", "alpha", "angle", "bg", "cex", "col", "color",  "colour", "fg", "fill", "group", "hjust", "label", "linetype", "lower",
                     "lty", "lwd", "max", "middle", "min", "pch", "radius", "sample", "shape","size", "srt", "upper", "vjust", "weight", "width", "x", "xend", "xmax",
                     "xmin", "xintercept", "y", "yend", "ymax", "ymin", "yintercept", "z")

.base_to_ggplot <- c(
  "col"   = "colour",
  "color" = "colour",
  "pch"   = "shape",
  "cex"   = "size",
  "lty"   = "linetype",
  "lwd"   = "size",
  "srt"   = "angle",
  "adj"   = "hjust",
  "bg"    = "fill",
  "fg"    = "colour",
  "min"   = "ymin",
  "max"   = "ymax"
)


aes <- function(x, y, ...) {
  aes <- structure(as.list(match.call()[-1]), class = "uneval")
  rename_aes(aes)
}

#' @export
print.uneval <- function(x, ...) {
  values <- vapply(x, deparse2, character(1))
  bullets <- paste0("* ", format(names(x)), " -> ", values, "\n")
  
  cat(bullets, sep = "")
}


# Rename American or old-style aesthetics name
rename_aes <- function(x) {
  # Convert prefixes to full names
  full <- match(names(x), .all_aesthetics)
  names(x)[!is.na(full)] <- .all_aesthetics[full[!is.na(full)]]
  
  plyr::rename(x, .base_to_ggplot, warn_missing = FALSE)
}


deparse2 <- function(x) {
  y <- deparse(x, backtick = TRUE)
  if (length(y) == 1) {
    y
  } else {
    paste0(y[[1]], "...")
  }
}

#map to data (just an example)
data <- lapply(aes(x=mpg, y=cyl, color=cyl),eval, env=mtcars)  #from compute_aesthetics function
data

结果

$x
 [1] 21.0 21.0 22.8 21.4 18.7 18.1 14.3 24.4 22.8 19.2 17.8 16.4 17.3 15.2 10.4 10.4 14.7 32.4 30.4 33.9 21.5 15.5 15.2 13.3 19.2 27.3 26.0 30.4
[29] 15.8 19.7 15.0 21.4

$y
 [1] 6 6 4 6 8 6 8 4 4 6 6 8 8 8 8 8 8 4 4 4 4 8 8 8 8 4 4 4 8 6 8 4

$colour
 [1] 6 6 4 6 8 6 8 4 4 6 6 8 8 8 8 8 8 4 4 4 4 8 8 8 8 4 4 4 8 6 8 4

参考资料

ggplot2源代码