Merge pull request #2 from tidyverse/master

Bringing my repository up-to-date

Author: MaraAlexeev

DESCRIPTION

@@ -23,7 +23,6 @@ Imports:
     grDevices,
     grid,
     gtable (>= 0.1.1),
-    lazyeval,
     MASS,
     mgcv,
     reshape2,

NAMESPACE

@@ -426,6 +426,8 @@ export(scale_alpha_manual)
 export(scale_alpha_ordinal)
 export(scale_color_brewer)
 export(scale_color_continuous)
+export(scale_color_date)
+export(scale_color_datetime)
 export(scale_color_discrete)
 export(scale_color_distiller)
 export(scale_color_gradient)
@@ -435,6 +437,7 @@ export(scale_color_grey)
 export(scale_color_hue)
 export(scale_color_identity)
 export(scale_color_manual)
+export(scale_color_ordinal)
 export(scale_color_viridis_c)
 export(scale_color_viridis_d)
 export(scale_colour_brewer)
@@ -583,7 +586,6 @@ import(grid)
 import(gtable)
 import(rlang)
 import(scales)
-importFrom(lazyeval,f_eval)
 importFrom(stats,setNames)
 importFrom(tibble,tibble)
 importFrom(utils,.DollarNames)

NEWS.md

@@ -1,5 +1,12 @@
 # ggplot2 (development version)
 
+* `Geom` now gains a `setup_params()` method in line with the other ggproto
+  classes (@thomasp85, #3509)
+
+* `element_text()` now issues a warning when vectorized arguments are provided, as in
+  `colour = c("red", "green", "blue")`. Such use is discouraged and not officially supported
+   (@clauswilke, #3492).
+
 * stacking text when calculating the labels and the y axis with
   `stat_summary()` now works (@ikosmidis, #2709)
 
@@ -17,10 +24,15 @@
 
 * Changed `theme_grey()` setting for legend key so that it creates no 
   border (`NA`) rather than drawing a white one. (@annennenne, #3180)
+  
+* Themes have gained two new parameters, `plot.title.position` and 
+  `plot.caption.position`, that can be used to customize how plot
+  title/subtitle and plot caption are positioned relative to the overall plot
+  (@clauswilke, #3252).
 
 * Added function `ggplot_add.by()` for lists created with `by()` (#2734, @Maschette)
 
-* `ggdep()` was deprecated (@perezp44, #3382).
+* `gg_dep()` was deprecated (@perezp44, #3382).
 
 * Added weight aesthetic option to `stat_density()` and made scaling of 
   weights the default (@annennenne, #2902)
@@ -55,6 +67,10 @@
 
 * `stat_density2d()` can now take an `adjust` parameter to scale the default bandwidth. (#2860, @haleyjeppson)
 
+* `geom_sf()` now removes rows that contain missing `shape`/`size`/`colour` (#3483, @yutannihilation)
+
+* Fix a bug when `show.legend` is a named logical vector (#3461, @yutannihilation).
+
 # ggplot2 3.2.1
 
 This is a patch release fixing a few regressions introduced in 3.2.0 as well as

R/axis-secondary.R

@@ -120,8 +120,6 @@ derive <- function() {
 is.derived <- function(x) {
   inherits(x, "derived")
 }
-#' @importFrom lazyeval f_eval
-#'
 #' @rdname ggplot2-ggproto
 #' @format NULL
 #' @usage NULL

R/facet-.r

@@ -419,7 +419,7 @@ is_facets <- function(x) {
 # but that seems like a reasonable tradeoff.
 eval_facets <- function(facets, data, env = globalenv()) {
   vars <- compact(lapply(facets, eval_facet, data, env = env))
-  tibble::as_tibble(vars)
+  new_data_frame(tibble::as_tibble(vars))
 }
 eval_facet <- function(facet, data, env = emptyenv()) {
   if (quo_is_symbol(facet)) {

R/geom-.r

@@ -104,6 +104,8 @@ Geom <- ggproto("Geom",
     stop("Not implemented")
   },
 
+  setup_params = function(data, params) params,
+
   setup_data = function(data, params) data,
 
   # Combine data with defaults and set aesthetics from parameters

R/geom-sf.R

@@ -97,6 +97,8 @@ GeomSf <- ggproto("GeomSf", Geom,
                     stroke = 0.5
                   ),
 
+  non_missing_aes = c("size", "shape", "colour"),
+                  
   draw_panel = function(data, panel_params, coord, legend = NULL,
                         lineend = "butt", linejoin = "round", linemitre = 10) {
     if (!inherits(coord, "CoordSf")) {

R/guide-colorbar.r

@@ -244,10 +244,28 @@ guide_geom.colorbar <- function(guide, layers, default_mapping) {
   guide_layers <- lapply(layers, function(layer) {
     matched <- matched_aes(layer, guide, default_mapping)
 
-    if (length(matched) > 0 && (isTRUE(is.na(layer$show.legend)) || isTRUE(layer$show.legend))) {
+    if (length(matched) == 0) {
+      # This layer does not use this guide
+      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) {
       layer
     } else {
-      # This layer does not use this guide
       NULL
     }
   })

R/guide-legend.r

@@ -250,10 +250,14 @@ guide_geom.legend <- function(guide, layers, default_mapping) {
 
       # 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))) {
+      if (is_named(layer$show.legend)) {
         layer$show.legend <- rename_aes(layer$show.legend)
-        include <- is.na(layer$show.legend[matched]) ||
-          layer$show.legend[matched]
+        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)
       }

R/layer.r

@@ -340,8 +340,8 @@ Layer <- ggproto("Layer", NULL,
       c(names(data), names(self$aes_params)),
       snake_class(self$geom)
     )
-
-    self$geom$setup_data(data, c(self$geom_params, self$aes_params))
+    self$geom_params <- self$geom$setup_params(data, c(self$geom_params, self$aes_params))
+    self$geom$setup_data(data, self$geom_params)
   },
 
   compute_position = function(self, data, layout) {

R/margins.R

@@ -71,8 +71,8 @@ title_spec <- function(label, x, y, hjust, vjust, angle, gp = gpar(),
   # Use trigonometry to calculate grobheight and width for rotated grobs. This is only
   # exactly correct when vjust = 1. We need to take the absolute value so we don't make
   # the grob smaller when it's flipped over.
-  text_height <- unit(1, "grobheight", text_grob) + abs(cos(angle / 180 * pi)) * descent
-  text_width <- unit(1, "grobwidth", text_grob) + abs(sin(angle / 180 * pi)) * descent
+  text_height <- unit(1, "grobheight", text_grob) + abs(cos(angle[1] / 180 * pi)) * descent
+  text_width <- unit(1, "grobwidth", text_grob) + abs(sin(angle[1] / 180 * pi)) * descent
 
   if (isTRUE(debug)) {
     children <- gList(
@@ -333,29 +333,36 @@ rotate_just <- function(angle, hjust, vjust) {
   list(hjust = hnew, vjust = vnew)
 }
 descent_cache <- new.env(parent = emptyenv())
+# Important: This function is not vectorized. Do not use to look up multiple
+# font descents at once.
 font_descent <- function(family = "", face = "plain", size = 12, cex = 1) {
   cur_dev <- names(grDevices::dev.cur())
+  if (cur_dev == "null device") {
+    cache <- FALSE   # don't cache if no device open
+  } else {
+    cache <- TRUE
+  }
   key <- paste0(cur_dev, ':', family, ':', face, ":", size, ":", cex)
-  descents <- lapply(key, function(k) {
-    descent <- descent_cache[[k]]
-
-    if (is.null(descent)) {
-      descent <- convertHeight(grobDescent(textGrob(
-        label = "gjpqyQ",
-        gp = gpar(
-          fontsize = size,
-          cex = cex,
-          fontfamily = family,
-          fontface = face
-        )
-      )), 'inches')
-      descent_cache[[k]] <- descent
+  # we only look up the first result; this function is not vectorized
+  key <- key[1]
+
+  descent <- descent_cache[[key]]
+
+  if (is.null(descent)) {
+    descent <- convertHeight(grobDescent(textGrob(
+      label = "gjpqyQ",
+      gp = gpar(
+        fontsize = size,
+        cex = cex,
+        fontfamily = family,
+        fontface = face
+      )
+    )), 'inches')
+
+    if (cache) {
+      descent_cache[[key]] <- descent
     }
-    descent
-  })
-  if (length(descents) == 1) {
-    descents[[1]]
-  } else {
-    do.call(unit.c, descents)
   }
+
+  descent
 }

R/plot-build.r

@@ -261,20 +261,46 @@ ggplot_gtable.ggplot_built <- function(data) {
   caption <- element_render(theme, "plot.caption", plot$labels$caption, margin_y = TRUE)
   caption_height <- grobHeight(caption)
 
-  pans <- plot_table$layout[grepl("^panel", plot_table$layout$name), ,
-    drop = FALSE]
+  # positioning of title and subtitle is governed by plot.title.position
+  # positioning of caption is governed by plot.caption.position
+  #   "panel" means align to the panel(s)
+  #   "plot" means align to the entire plot (except margins and tag)
+  title_pos <- theme$plot.title.position %||% "panel"
+  if (!(title_pos %in% c("panel", "plot"))) {
+    stop('plot.title.position should be either "panel" or "plot".', call. = FALSE)
+  }
+  caption_pos <- theme$plot.caption.position %||% "panel"
+  if (!(caption_pos %in% c("panel", "plot"))) {
+    stop('plot.caption.position should be either "panel" or "plot".', call. = FALSE)
+  }
+
+  pans <- plot_table$layout[grepl("^panel", plot_table$layout$name), , drop = FALSE]
+  if (title_pos == "panel") {
+    title_l = min(pans$l)
+    title_r = max(pans$r)
+  } else {
+    title_l = 1
+    title_r = ncol(plot_table)
+  }
+  if (caption_pos == "panel") {
+    caption_l = min(pans$l)
+    caption_r = max(pans$r)
+  } else {
+    caption_l = 1
+    caption_r = ncol(plot_table)
+  }
 
   plot_table <- gtable_add_rows(plot_table, subtitle_height, pos = 0)
   plot_table <- gtable_add_grob(plot_table, subtitle, name = "subtitle",
-    t = 1, b = 1, l = min(pans$l), r = max(pans$r), clip = "off")
+    t = 1, b = 1, l = title_l, r = title_r, clip = "off")
 
   plot_table <- gtable_add_rows(plot_table, title_height, pos = 0)
   plot_table <- gtable_add_grob(plot_table, title, name = "title",
-    t = 1, b = 1, l = min(pans$l), r = max(pans$r), clip = "off")
+    t = 1, b = 1, l = title_l, r = title_r, clip = "off")
 
   plot_table <- gtable_add_rows(plot_table, caption_height, pos = -1)
   plot_table <- gtable_add_grob(plot_table, caption, name = "caption",
-    t = -1, b = -1, l = min(pans$l), r = max(pans$r), clip = "off")
+    t = -1, b = -1, l = caption_l, r = caption_r, clip = "off")
 
   plot_table <- gtable_add_rows(plot_table, unit(0, 'pt'), pos = 0)
   plot_table <- gtable_add_cols(plot_table, unit(0, 'pt'), pos = 0)

R/scale-discrete-.r

@@ -83,17 +83,18 @@ ScaleDiscretePosition <- ggproto("ScaleDiscretePosition", ScaleDiscrete,
   },
 
   get_limits = function(self) {
-      if (self$is_empty()) {
-          c(0, 1)
-      } else if (!is.null(self$limits) & !is.function(self$limits)){
-          self$limits
-      } else if (is.null(self$limits)) {
-          self$range$range
-      } else if (is.function(self$limits)) {
-          self$limits(self$range$range)
-      } else {
-          integer(0)
-      }
+    # if scale contains no information, return the default limit
+    if (self$is_empty()) {
+      return(c(0, 1))
+    }
+
+    # if self$limits is not NULL and is a function, apply it to range
+    if (is.function(self$limits)){
+      return(self$limits(self$range$range))
+    }
+
+    # self$range$range can be NULL because non-discrete values use self$range_c
+    self$limits %||% self$range$range %||% integer()
   },
 
   is_empty = function(self) {

R/theme-defaults.r

@@ -214,6 +214,7 @@ theme_grey <- function(base_size = 11, base_family = "",
                            hjust = 0, vjust = 1,
                            margin = margin(b = half_line)
                          ),
+    plot.title.position = "panel",
     plot.subtitle =      element_text( # font size "regular"
                            hjust = 0, vjust = 1,
                            margin = margin(b = half_line)
@@ -223,6 +224,7 @@ theme_grey <- function(base_size = 11, base_family = "",
                            hjust = 1, vjust = 1,
                            margin = margin(t = half_line)
                          ),
+    plot.caption.position = "panel",
     plot.tag =           element_text(
                            size = rel(1.2),
                            hjust = 0.5, vjust = 0.5
@@ -487,6 +489,7 @@ theme_void <- function(base_size = 11, base_family = "",
                            hjust = 0, vjust = 1,
                            margin = margin(t = half_line)
                          ),
+    plot.title.position = "panel",
     plot.subtitle =      element_text(
                            hjust = 0, vjust = 1,
                            margin = margin(t = half_line)
@@ -496,6 +499,7 @@ theme_void <- function(base_size = 11, base_family = "",
                            hjust = 1, vjust = 1,
                            margin = margin(t = half_line)
                          ),
+    plot.caption.position = "panel",
     plot.tag =           element_text(
                            size = rel(1.2),
                            hjust = 0.5, vjust = 0.5
@@ -615,6 +619,7 @@ theme_test <- function(base_size = 11, base_family = "",
                            hjust = 0, vjust = 1,
                            margin = margin(b = half_line)
                          ),
+    plot.title.position = "panel",
     plot.subtitle =      element_text(
                            hjust = 0, vjust = 1,
                            margin = margin(b = half_line)
@@ -624,6 +629,7 @@ theme_test <- function(base_size = 11, base_family = "",
                            hjust = 1, vjust = 1,
                            margin = margin(t = half_line)
                          ),
+    plot.caption.position = "panel",
     plot.tag =           element_text(
                            size = rel(1.2),
                            hjust = 0.5, vjust = 0.5

R/theme-elements.r

@@ -112,6 +112,20 @@ element_text <- function(family = NULL, face = NULL, colour = NULL,
   color = NULL, margin = NULL, debug = NULL, inherit.blank = FALSE) {
 
   if (!is.null(color))  colour <- color
+
+  n <- max(
+    length(family), length(face), length(colour), length(size),
+    length(hjust), length(vjust), length(angle), length(lineheight)
+  )
+  if (n > 1) {
+    warning(
+      "Vectorized input to `element_text()` is not officially supported.\n",
+      "Results may be unexpected or may change in future versions of ggplot2.",
+      call. = FALSE
+    )
+  }
+
+
   structure(
     list(family = family, face = face, colour = colour, size = size,
       hjust = hjust, vjust = vjust, angle = angle, lineheight = lineheight,
@@ -356,8 +370,10 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) {
 
   plot.background     = el_def("element_rect", "rect"),
   plot.title          = el_def("element_text", "title"),
+  plot.title.position = el_def("character"),
   plot.subtitle       = el_def("element_text", "title"),
   plot.caption        = el_def("element_text", "title"),
+  plot.caption.position = el_def("character"),
   plot.tag            = el_def("element_text", "title"),
   plot.tag.position   = el_def("character"),  # Need to also accept numbers
   plot.margin         = el_def("margin"),