diff --git a/R/guide-bins.R b/R/guide-bins.R index e6ad111ffa..2e5b25cf79 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -161,38 +161,21 @@ guide_geom.bins <- function(guide, layers, default_mapping) { guide$geoms <- lapply(layers, function(layer) { matched <- matched_aes(layer, guide, default_mapping) - if (length(matched) > 0) { - # This layer contributes to the legend - - # check if this layer should be included, different behaviour depending on - # if show.legend is a logical or a named logical vector - if (!is.null(names(layer$show.legend))) { - layer$show.legend <- rename_aes(layer$show.legend) - include <- is.na(layer$show.legend[matched]) || - layer$show.legend[matched] - } else { - include <- is.na(layer$show.legend) || layer$show.legend - } + # check if this layer should be included + include <- include_layer_in_guide(layer, matched) - if (include) { - # Default is to include it + if (!include) { + return(NULL) + } - # Filter out set aesthetics that can't be applied to the legend - n <- vapply(layer$aes_params, length, integer(1)) - params <- layer$aes_params[n == 1] + if (length(matched) > 0) { + # Filter out set aesthetics that can't be applied to the legend + n <- vapply(layer$aes_params, length, integer(1)) + params <- layer$aes_params[n == 1] - data <- layer$geom$use_defaults(guide$key[matched], params) - } else { - return(NULL) - } + data <- layer$geom$use_defaults(guide$key[matched], params) } else { - # This layer does not contribute to the legend - if (is.na(layer$show.legend) || !layer$show.legend) { - # Default is to exclude it - return(NULL) - } else { - data <- layer$geom$use_defaults(NULL, layer$aes_params)[rep(1, nrow(guide$key)), ] - } + data <- layer$geom$use_defaults(NULL, layer$aes_params)[rep(1, nrow(guide$key)), ] } # override.aes in guide_legend manually changes the geom diff --git a/R/guide-colorbar.r b/R/guide-colorbar.r index 95e62297e4..b75f3dc187 100644 --- a/R/guide-colorbar.r +++ b/R/guide-colorbar.r @@ -249,21 +249,8 @@ guide_geom.colorbar <- function(guide, layers, default_mapping) { return(NULL) } - # check if this layer should be included, different behaviour depending on - # if show.legend is a logical or a named logical vector - if (is_named(layer$show.legend)) { - layer$show.legend <- rename_aes(layer$show.legend) - show_legend <- layer$show.legend[matched] - # we cannot use `isTRUE(is.na(show_legend))` here because - # 1. show_legend can be multiple NAs - # 2. isTRUE() was not tolerant for a named TRUE - show_legend <- show_legend[!is.na(show_legend)] - include <- length(show_legend) == 0 || any(show_legend) - } else { - include <- isTRUE(is.na(layer$show.legend)) || isTRUE(layer$show.legend) - } - - if (include) { + # check if this layer should be included + if (include_layer_in_guide(layer, matched)) { layer } else { NULL diff --git a/R/guide-legend.r b/R/guide-legend.r index 77ba2f67c0..a7a6de653d 100644 --- a/R/guide-legend.r +++ b/R/guide-legend.r @@ -246,42 +246,21 @@ guide_geom.legend <- function(guide, layers, default_mapping) { guide$geoms <- lapply(layers, function(layer) { matched <- matched_aes(layer, guide, default_mapping) + # check if this layer should be included + include <- include_layer_in_guide(layer, matched) + + if (!include) { + return(NULL) + } + if (length(matched) > 0) { - # This layer contributes to the legend - - # check if this layer should be included, different behaviour depending on - # if show.legend is a logical or a named logical vector - if (is_named(layer$show.legend)) { - layer$show.legend <- rename_aes(layer$show.legend) - show_legend <- layer$show.legend[matched] - # we cannot use `isTRUE(is.na(show_legend))` here because - # 1. show_legend can be multiple NAs - # 2. isTRUE() was not tolerant for a named TRUE - show_legend <- show_legend[!is.na(show_legend)] - include <- length(show_legend) == 0 || any(show_legend) - } else { - include <- isTRUE(is.na(layer$show.legend)) || isTRUE(layer$show.legend) - } - - if (include) { - # Default is to include it - - # Filter out set aesthetics that can't be applied to the legend - n <- vapply(layer$aes_params, length, integer(1)) - params <- layer$aes_params[n == 1] - - data <- layer$geom$use_defaults(guide$key[matched], params) - } else { - return(NULL) - } + # Filter out set aesthetics that can't be applied to the legend + n <- vapply(layer$aes_params, length, integer(1)) + params <- layer$aes_params[n == 1] + + data <- layer$geom$use_defaults(guide$key[matched], params) } else { - # This layer does not contribute to the legend - if (isTRUE(is.na(layer$show.legend)) || !isTRUE(layer$show.legend)) { - # Default is to exclude it - return(NULL) - } else { - data <- layer$geom$use_defaults(NULL, layer$aes_params)[rep(1, nrow(guide$key)), ] - } + data <- layer$geom$use_defaults(NULL, layer$aes_params)[rep(1, nrow(guide$key)), ] } # override.aes in guide_legend manually changes the geom diff --git a/R/guides-.r b/R/guides-.r index 40284afa00..061317227b 100644 --- a/R/guides-.r +++ b/R/guides-.r @@ -363,3 +363,35 @@ matched_aes <- function(layer, guide, defaults) { matched <- setdiff(matched, names(layer$geom_params)) setdiff(matched, names(layer$aes_params)) } + +# This function is used by guides in guide_geom.* to determine whether +# a given layer should be included in the guide +# `matched` is the set of aesthetics that match between the layer and the guide +include_layer_in_guide <- function(layer, matched) { + if (!is.logical(layer$show.legend)) { + warning("`show.legend` must be a logical vector.", call. = FALSE) + layer$show.legend <- FALSE # save back to layer so we don't issue this warning more than once + return(FALSE) + } + + if (length(matched) > 0) { + # This layer contributes to the legend + + # check if this layer should be included, different behaviour depending on + # if show.legend is a logical or a named logical vector + if (is_named(layer$show.legend)) { + layer$show.legend <- rename_aes(layer$show.legend) + show_legend <- layer$show.legend[matched] + # we cannot use `isTRUE(is.na(show_legend))` here because + # 1. show_legend can be multiple NAs + # 2. isTRUE() was not tolerant for a named TRUE + show_legend <- show_legend[!is.na(show_legend)] + return(length(show_legend) == 0 || any(show_legend)) + } + return(all(is.na(layer$show.legend)) || isTRUE(layer$show.legend)) + } + + # This layer does not contribute to the legend. + # Default is to exclude it, except if it is explicitly turned on + isTRUE(layer$show.legend) +} diff --git a/R/layer.r b/R/layer.r index 633fe195a4..858c41b111 100644 --- a/R/layer.r +++ b/R/layer.r @@ -80,10 +80,6 @@ layer <- function(geom = NULL, stat = NULL, show.legend <- params$show_guide params$show_guide <- NULL } - if (!is.logical(show.legend)) { - warning("`show.legend` must be a logical vector.", call. = FALSE) - show.legend <- FALSE - } # we validate mapping before data because in geoms and stats # the mapping is listed before the data argument; this causes