refactor show.legend code (#3652)

* refactor show.legend code

* code cleanup and simplifiation

* eliminate unnecessary return()

Author: clauswilke

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

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

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

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)
+}

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