.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
ggplot2源代码
原文:https://www.cnblogs.com/ywliao/p/9265446.html