Skip to content
Permalink
Browse files

Merge branch 'master' into v3.2.0-rc

  • Loading branch information...
thomasp85 committed Jun 17, 2019
2 parents f4c97e8 + b560662 commit 548e7d06c71451537421624c8fefc66a9a024a29
@@ -6,7 +6,7 @@ quickly as possible. The guide is divided into two main pieces:
1. Filing a bug report or feature request in an issue.
1. Suggesting a change via a pull request.

Please note that ggplot2 is released with a [Contributor Code of Conduct](.github/CODE_OF_CONDUCT.md). By contributing to this project,
Please note that ggplot2 is released with a [Contributor Code of Conduct](CODE_OF_CONDUCT.md). By contributing to this project,
you agree to abide by its terms.

## Issues
66 R/aes.r
@@ -8,8 +8,8 @@ NULL
#' [ggplot2()] and in individual layers.
#'
#' This function also standardises aesthetic names by converting `color` to `colour`
#' (also in substrings, e.g. `point_color` to `point_colour`) and translating old style
#' R names to ggplot names (eg. `pch` to `shape`, `cex` to `size`).
#' (also in substrings, e.g., `point_color` to `point_colour`) and translating old style
#' R names to ggplot names (e.g., `pch` to `shape` and `cex` to `size`).
#'
#' @section Quasiquotation:
#'
@@ -22,9 +22,13 @@ NULL
#' programming vignette](http://dplyr.tidyverse.org/articles/programming.html)
#' to learn more about these techniques.
#'
#' @param x,y,... List of name value pairs giving aesthetics to map to
#' variables. The names for x and y aesthetics are typically omitted because
#' they are so common; all other aesthetics must be named.
#' @param x,y,... List of name-value pairs in the form `aesthetic = variable`
#' describing which variables in the layer data should be mapped to which
#' aesthetics used by the paired geom/stat. The expression `variable` is
#' evaluated within the layer data, so there is no need to refer to
#' the original dataset (i.e., use `ggplot(df, aes(variable))`
#' instead of `ggplot(df, aes(df$variable))`). The names for x and y aesthetics
#' are typically omitted because they are so common; all other aesthetics must be named.
#' @seealso [vars()] for another quoting function designed for
#' faceting specifications.
#' @return A list with class `uneval`. Components of the list are either
@@ -334,3 +338,55 @@ mapped_aesthetics <- function(x) {
is_null <- vapply(x, is.null, logical(1))
names(x)[!is_null]
}


#' Check a mapping for discouraged usage
#'
#' Checks that `$` and `[[` are not used when the target *is* the data
#'
#' @param mapping A mapping created with [aes()]
#' @param data The data to be mapped from
#'
#' @noRd
warn_for_aes_extract_usage <- function(mapping, data) {
lapply(mapping, function(quosure) {
warn_for_aes_extract_usage_expr(get_expr(quosure), data, get_env(quosure))
})
}

warn_for_aes_extract_usage_expr <- function(x, data, env = emptyenv()) {
if (is_call(x, "[[") || is_call(x, "$")) {
if (extract_target_is_likely_data(x, data, env)) {
good_usage <- alternative_aes_extract_usage(x)
warning(
"Use of `", format(x), "` is discouraged. ",
"Use `", good_usage, "` instead.",
call. = FALSE
)
}
} else if (is.call(x)) {
lapply(x, warn_for_aes_extract_usage_expr, data, env)
}
}

alternative_aes_extract_usage <- function(x) {
if (is_call(x, "[[")) {
good_call <- call2("[[", quote(.data), x[[3]])
format(good_call)
} else if (is_call(x, "$")) {
as.character(x[[3]])
} else {
stop("Don't know how to get alternative usage for `", format(x), "`", call. = FALSE)
}
}

extract_target_is_likely_data <- function(x, data, env) {
if (!is.name(x[[2]])) {
return(FALSE)
}

tryCatch({
data_eval <- eval_tidy(x[[2]], data, env)
identical(data_eval, data)
}, error = function(err) FALSE)
}
@@ -158,9 +158,9 @@ expand_default <- function(scale, discrete = c(0, 0.6, 0, 0.6), continuous = c(0
# generated
render_axis <- function(panel_params, axis, scale, position, theme) {
if (axis == "primary") {
guide_axis(panel_params[[paste0(scale, ".major")]], panel_params[[paste0(scale, ".labels")]], position, theme)
draw_axis(panel_params[[paste0(scale, ".major")]], panel_params[[paste0(scale, ".labels")]], position, theme)
} else if (axis == "secondary" && !is.null(panel_params[[paste0(scale, ".sec.major")]])) {
guide_axis(panel_params[[paste0(scale, ".sec.major")]], panel_params[[paste0(scale, ".sec.labels")]], position, theme)
draw_axis(panel_params[[paste0(scale, ".sec.major")]], panel_params[[paste0(scale, ".sec.labels")]], position, theme)
} else {
zeroGrob()
}
@@ -289,8 +289,8 @@ CoordMap <- ggproto("CoordMap", Coord,
pos <- self$transform(x_intercept, panel_params)

axes <- list(
top = guide_axis(pos$x, panel_params$x.labels, "top", theme),
bottom = guide_axis(pos$x, panel_params$x.labels, "bottom", theme)
top = draw_axis(pos$x, panel_params$x.labels, "top", theme),
bottom = draw_axis(pos$x, panel_params$x.labels, "bottom", theme)
)
axes[[which(arrange == "secondary")]] <- zeroGrob()
axes
@@ -313,8 +313,8 @@ CoordMap <- ggproto("CoordMap", Coord,
pos <- self$transform(x_intercept, panel_params)

axes <- list(
left = guide_axis(pos$y, panel_params$y.labels, "left", theme),
right = guide_axis(pos$y, panel_params$y.labels, "right", theme)
left = draw_axis(pos$y, panel_params$y.labels, "left", theme),
right = draw_axis(pos$y, panel_params$y.labels, "right", theme)
)
axes[[which(arrange == "secondary")]] <- zeroGrob()
axes
@@ -190,7 +190,7 @@ CoordPolar <- ggproto("CoordPolar", Coord,
render_axis_h = function(panel_params, theme) {
list(
top = zeroGrob(),
bottom = guide_axis(NA, "", "bottom", theme)
bottom = draw_axis(NA, "", "bottom", theme)
)
},

@@ -243,10 +243,10 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
tick_labels <- c(ticks1$degree_label, ticks2$degree_label)

if (length(tick_positions) > 0) {
top <- guide_axis(
top <- draw_axis(
tick_positions,
tick_labels,
position = "top",
axis_position = "top",
theme = theme
)
} else {
@@ -279,10 +279,10 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
tick_labels <- c(ticks1$degree_label, ticks2$degree_label)

if (length(tick_positions) > 0) {
bottom <- guide_axis(
bottom <- draw_axis(
tick_positions,
tick_labels,
position = "bottom",
axis_position = "bottom",
theme = theme
)
} else {
@@ -321,10 +321,10 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
tick_labels <- c(ticks1$degree_label, ticks2$degree_label)

if (length(tick_positions) > 0) {
right <- guide_axis(
right <- draw_axis(
tick_positions,
tick_labels,
position = "right",
axis_position = "right",
theme = theme
)
} else {
@@ -357,10 +357,10 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
tick_labels <- c(ticks1$degree_label, ticks2$degree_label)

if (length(tick_positions) > 0) {
left <- guide_axis(
left <- draw_axis(
tick_positions,
tick_labels,
position = "left",
axis_position = "left",
theme = theme
)
} else {
@@ -563,7 +563,7 @@ combine_vars <- function(data, env = emptyenv(), vars = NULL, drop = TRUE) {
if (drop) {
new <- unique_combs(new)
}
base <- rbind(base, df.grid(old, new))
base <- unique(rbind(base, df.grid(old, new)))
}

if (empty(base)) {
@@ -76,21 +76,20 @@ geom_abline <- function(mapping = NULL, data = NULL,
show.legend = NA) {

# If nothing set, default to y = x
if (missing(mapping) && missing(slope) && missing(intercept)) {
if (is.null(mapping) && missing(slope) && missing(intercept)) {
slope <- 1
intercept <- 0
}

# Act like an annotation
if (!missing(slope) || !missing(intercept)) {

# Warn if supplied mapping is going to be overwritten
if (!missing(mapping)) {
warning(paste0("Using `intercept` and/or `slope` with `mapping` may",
" not have the desired result as mapping is overwritten",
" if either of these is specified\n"
)
)
# Warn if supplied mapping and/or data is going to be overwritten
if (!is.null(mapping)) {
warn_overwritten_args("geom_abline()", "mapping", c("slope", "intercept"))
}
if (!is.null(data)) {
warn_overwritten_args("geom_abline()", "data", c("slope", "intercept"))
}

if (missing(slope)) slope <- 1
@@ -141,3 +140,34 @@ GeomAbline <- ggproto("GeomAbline", Geom,

draw_key = draw_key_abline
)

warn_overwritten_args <- function(fun_name, overwritten_arg, provided_args, plural_join = " and/or ") {
overwritten_arg_text <- paste0("`", overwritten_arg, "`")

n_provided_args <- length(provided_args)
if (n_provided_args == 1) {
provided_arg_text <- paste0("`", provided_args, "`")
verb <- "was"
} else if (n_provided_args == 2) {
provided_arg_text <- paste0("`", provided_args, "`", collapse = plural_join)
verb <- "were"
} else {
provided_arg_text <- paste0(
paste0("`", provided_args[-n_provided_args], "`", collapse = ", "),
",", plural_join,
"`", provided_args[n_provided_args], "`"
)
verb <- "were"
}

warning(
sprintf(
"%s: Ignoring %s because %s %s provided.",
fun_name,
overwritten_arg_text,
provided_arg_text,
verb
),
call. = FALSE
)
}
@@ -11,14 +11,14 @@ geom_hline <- function(mapping = NULL, data = NULL,

# Act like an annotation
if (!missing(yintercept)) {
# Warn if supplied mapping is going to be overwritten
if (!missing(mapping)) {
warning(paste0("Using both `yintercept` and `mapping` may not have the",
" desired result as mapping is overwritten if",
" `yintercept` is specified\n"
)
)
# Warn if supplied mapping and/or data is going to be overwritten
if (!is.null(mapping)) {
warn_overwritten_args("geom_hline()", "mapping", "yintercept")
}
if (!is.null(data)) {
warn_overwritten_args("geom_hline()", "data", "yintercept")
}

data <- new_data_frame(list(yintercept = yintercept))
mapping <- aes(yintercept = yintercept)
show.legend <- FALSE
@@ -11,14 +11,14 @@ geom_vline <- function(mapping = NULL, data = NULL,

# Act like an annotation
if (!missing(xintercept)) {
# Warn if supplied mapping is going to be overwritten
if (!missing(mapping)) {
warning(paste0("Using both `xintercept` and `mapping` may not have the",
" desired result as mapping is overwritten if",
" `xintercept` is specified\n"
)
)
# Warn if supplied mapping and/or data is going to be overwritten
if (!is.null(mapping)) {
warn_overwritten_args("geom_vline()", "mapping", "xintercept")
}
if (!is.null(data)) {
warn_overwritten_args("geom_vline()", "data", "xintercept")
}

data <- new_data_frame(list(xintercept = xintercept))
mapping <- aes(xintercept = xintercept)
show.legend <- FALSE
@@ -238,10 +238,14 @@ Layer <- ggproto("Layer", NULL,

scales_add_defaults(plot$scales, data, aesthetics, plot$plot_env)

# Evaluate and check aesthetics
# Evaluate aesthetics
evaled <- lapply(aesthetics, eval_tidy, data = data)
evaled <- compact(evaled)

# Check for discouraged usage in mapping
warn_for_aes_extract_usage(aesthetics, data[setdiff(names(data), "PANEL")])

# Check aesthetic values
nondata_cols <- check_nondata_cols(evaled)
if (length(nondata_cols) > 0) {
msg <- paste0(
@@ -612,21 +612,38 @@ merge_element.element <- function(new, old) {
new
}

# Combine the properties of two elements
#
# @param e1 An element object
# @param e2 An element object which e1 inherits from
#' Combine the properties of two elements
#'
#' @param e1 An element object
#' @param e2 An element object from which e1 inherits
#'
#' @noRd
#'
combine_elements <- function(e1, e2) {

# If e2 is NULL, nothing to inherit
if (is.null(e2) || inherits(e1, "element_blank")) return(e1)
if (is.null(e2) || inherits(e1, "element_blank")) {
return(e1)
}

# If e1 is NULL inherit everything from e2
if (is.null(e1)) return(e2)
if (is.null(e1)) {
return(e2)
}

# If neither of e1 or e2 are element_* objects, return e1
if (!inherits(e1, "element") && !inherits(e2, "element")) {
return(e1)
}

# If e2 is element_blank, and e1 inherits blank inherit everything from e2,
# otherwise ignore e2
if (inherits(e2, "element_blank")) {
if (e1$inherit.blank) return(e2)
else return(e1)
if (e1$inherit.blank) {
return(e2)
} else {
return(e1)
}
}

# If e1 has any NULL properties, inherit them from e2

Some generated files are not rendered by default. Learn more.

0 comments on commit 548e7d0

Please sign in to comment.
You can’t perform that action at this time.