Merge pull request #3 from tidyverse/master

update to tidyverse edition 20191118

Author: microly

.Rbuildignore

@@ -26,3 +26,4 @@ visual_test
 ^\.github$
 ^vignettes/profilings
 ^cran-comments\.md$
+^LICENSE\.md$

DESCRIPTION

@@ -14,6 +14,7 @@ Authors@R: c(
     person("Claus", "Wilke", role = "aut"),
     person("Kara", "Woo", role = "aut"),
     person("Hiroaki", "Yutani", role = "aut"),
+    person("Dewey", "Dunnington", role = "aut"),
     person("RStudio", role = c("cph"))
     )
 Depends:
@@ -23,22 +24,21 @@ Imports:
     grDevices,
     grid,
     gtable (>= 0.1.1),
+    isoband,
     MASS,
     mgcv,
     reshape2,
     rlang (>= 0.3.0),
     scales (>= 0.5.0),
     stats,
     tibble,
-    viridisLite,
     withr (>= 2.0.0)
 Suggests:
     covr,
     dplyr,
     ggplot2movies,
     hexbin,
     Hmisc,
-    isoband,
     knitr,
     lattice,
     mapproj,

GOVERNANCE.md

@@ -43,6 +43,7 @@ The core developers of ggplot2 are:
 * [Claus Wilke](https://github.com/clauswilke)
 * [Kara Woo](https://github.com/karawoo)
 * [Hiroaki Yutani](https://github.com/yutannihilation)
+* [Dewey Dunnington](https://github.com/paleolimbot)
 
 All core developers are bound by the [code of conduct](CODE_OF_CONDUCT.md).
 

LICENSE.md

@@ -45,6 +45,7 @@ S3method(fortify,tbl_df)
 S3method(ggplot,"function")
 S3method(ggplot,default)
 S3method(ggplot_add,"NULL")
+S3method(ggplot_add,"function")
 S3method(ggplot_add,Coord)
 S3method(ggplot_add,Facet)
 S3method(ggplot_add,Layer)
@@ -105,6 +106,7 @@ S3method(makeContent,labelgrob)
 S3method(makeContext,dotstackGrob)
 S3method(merge_element,default)
 S3method(merge_element,element)
+S3method(merge_element,element_blank)
 S3method(plot,ggplot)
 S3method(predictdf,default)
 S3method(predictdf,glm)
@@ -297,10 +299,12 @@ export(draw_key_timeseries)
 export(draw_key_vline)
 export(draw_key_vpath)
 export(dup_axis)
+export(el_def)
 export(element_blank)
 export(element_grob)
 export(element_line)
 export(element_rect)
+export(element_render)
 export(element_text)
 export(enexpr)
 export(enexprs)

NAMESPACE

@@ -1,5 +1,11 @@
 # ggplot2 (development version)
 
+* `scale_x_continuous()` and `scale_y_continuous()` gains an `n.breaks` argument
+  guiding the number of automatic generated breaks (@thomasp85, #3102)
+  
+* `geom_sf()` now removes rows that can't be plotted due to `NA` aesthetics 
+  (#3546, @thomasp85)
+
 * A new scale type has been added, that allows binning of aesthetics at the 
   scale level. It has versions for both position and non-position aesthetics and
   comes with two new guides (`guide_bins` and `guide_coloursteps`) (@thomasp85, #3096)
@@ -14,6 +20,10 @@
 * `Geom` now gains a `setup_params()` method in line with the other ggproto
   classes (@thomasp85, #3509)
 
+* Themes can now modify the theme element tree, via the
+  `element_tree` argument. This allows extension packages to add functionality that
+  alters the element tree (@clauswilke, #2540).
+
 * `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).
@@ -82,12 +92,12 @@
 
 * `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).
 
 * Increase the default `nbin` of `guide_colourbar()` to place the ticks more precisely (#3508, @yutannihilation).
 
+* `geom_sf()` now applies alpha to linestring geometries (#3589, @yutannihilation).
+
 # ggplot2 3.2.1
 
 This is a patch release fixing a few regressions introduced in 3.2.0 as well as

NEWS.md

@@ -42,6 +42,8 @@ is_calculated <- function(x) {
     FALSE
   } else if (is.symbol(x)) {
     is_dotted_var(as.character(x))
+  } else if (is_quosure(x)) {
+    is_calculated(quo_get_expr(x))
   } else if (is.call(x)) {
     if (identical(x[[1]], quote(stat))) {
       TRUE
@@ -66,6 +68,12 @@ strip_dots <- function(expr) {
     } else {
       expr
     }
+  } else if (is_quosure(expr)) {
+    # strip dots from quosure and reconstruct the quosure
+    expr <- new_quosure(
+      strip_dots(quo_get_expr(expr)),
+      quo_get_env(expr)
+    )
   } else if (is.call(expr)) {
     if (identical(expr[[1]], quote(stat))) {
       strip_dots(expr[[2]])

R/aes-calculated.r

@@ -87,7 +87,11 @@ bin_breaks_width <- function(x_range, width = NULL, center = NULL,
   max_x <- x_range[2] + (1 - 1e-08) * width
   breaks <- seq(origin, max_x, width)
 
-  if (length(breaks) > 1e6) {
+  if (length(breaks) == 1) {
+    # In exceptionally rare cases, the above can fail and produce only a
+    # single break (see issue #3606). We fix this by adding a second break.
+    breaks <- c(breaks, breaks + width)
+  } else if (length(breaks) > 1e6) {
     stop("The number of histogram bins must be less than 1,000,000.\nDid you make `binwidth` too small?", call. = FALSE)
   }
 

R/bin.R

@@ -34,7 +34,7 @@
 #' @inheritParams geom_point
 #' @param stackdir which direction to stack the dots. "up" (default),
 #'   "down", "center", "centerwhole" (centered, but with dots aligned)
-#' @param stackratio how close to stack the dots. Default is 1, where dots just
+#' @param stackratio how close to stack the dots. Default is 1, where dots
 #'   just touch. Use smaller values for closer, overlapping dots.
 #' @param dotsize The diameter of the dots relative to `binwidth`, default 1.
 #' @param stackgroups should dots be stacked across groups? This has the effect

R/geom-dotplot.r

@@ -30,8 +30,9 @@
 #' h + geom_ribbon(aes(ymin=0, ymax=level))
 #' h + geom_area(aes(y = level))
 #'
-#' # Change orientation be switching the mapping
-#' h + geom_area(aes(x = level, y = year))
+#' # Orientation cannot be deduced by mapping, so must be given explicitly for
+#' # flipped orientation
+#' h + geom_area(aes(x = level, y = year), orientation = "y")
 #'
 #' # Add aesthetic mappings
 #' h +

R/geom-ribbon.r

@@ -86,28 +86,27 @@ NULL
 #' @usage NULL
 #' @format NULL
 GeomSf <- ggproto("GeomSf", Geom,
-                  required_aes = "geometry",
-                  default_aes = aes(
-                    shape = NULL,
-                    colour = NULL,
-                    fill = NULL,
-                    size = NULL,
-                    linetype = 1,
-                    alpha = NA,
-                    stroke = 0.5
-                  ),
+  required_aes = "geometry",
+  default_aes = aes(
+    shape = NULL,
+    colour = NULL,
+    fill = NULL,
+    size = NULL,
+    linetype = 1,
+    alpha = NA,
+    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) {
+                        lineend = "butt", linejoin = "round", linemitre = 10,
+                        na.rm = TRUE) {
     if (!inherits(coord, "CoordSf")) {
       stop("geom_sf() must be used with coord_sf()", call. = FALSE)
     }
 
     # Need to refactor this to generate one grob per geometry type
     coord <- coord$transform(data, panel_params)
-    sf_grob(coord, lineend = lineend, linejoin = linejoin, linemitre = linemitre)
+    sf_grob(coord, lineend = lineend, linejoin = linejoin, linemitre = linemitre, na.rm = na.rm)
   },
 
   draw_key = function(data, params, size) {
@@ -132,37 +131,57 @@ default_aesthetics <- function(type) {
   }
 }
 
-sf_grob <- function(x, lineend = "butt", linejoin = "round", linemitre = 10) {
-  # Need to extract geometry out of corresponding list column
-  geometry <- x$geometry
-  type <- sf_types[sf::st_geometry_type(geometry)]
-  is_point <- type %in% "point"
-  type_ind <- match(type, c("point", "line", "other"))
+sf_grob <- function(x, lineend = "butt", linejoin = "round", linemitre = 10, na.rm = TRUE) {
+  type <- sf_types[sf::st_geometry_type(x$geometry)]
+  is_point <- type == "point"
+  is_line <- type == "line"
+  is_other <- type == "other"
+  is_collection <- type == "collection"
+  type_ind <- match(type, c("point", "line", "other", "collection"))
+  remove <- rep_len(FALSE, nrow(x))
+  remove[is_point] <- detect_missing(x, c(GeomPoint$required_aes, GeomPoint$non_missing_aes))[is_point]
+  remove[is_line] <- detect_missing(x, c(GeomPath$required_aes, GeomPath$non_missing_aes))[is_line]
+  remove[is_other] <- detect_missing(x, c(GeomPolygon$required_aes, GeomPolygon$non_missing_aes))[is_other]
+  if (any(remove)) {
+    if (!na.rm) {
+      warning_wrap(
+        "Removed ", sum(remove), " rows containing missing values (geom_sf)."
+      )
+    }
+    x <- x[!remove, , drop = FALSE]
+    type_ind <- type_ind[!remove]
+    is_collection <- is_collection[!remove]
+  }
   defaults <- list(
     GeomPoint$default_aes,
     GeomLine$default_aes,
     modify_list(GeomPolygon$default_aes, list(fill = "grey90", colour = "grey35"))
   )
+  defaults[[4]] <- modify_list(
+    defaults[[3]],
+    rename(GeomPoint$default_aes, c(size = "point_size", fill = "point_fill"))
+  )
   default_names <- unique(unlist(lapply(defaults, names)))
   defaults <- lapply(setNames(default_names, default_names), function(n) {
     unlist(lapply(defaults, function(def) def[[n]] %||% NA))
   })
   alpha <- x$alpha %||% defaults$alpha[type_ind]
   col <- x$colour %||% defaults$colour[type_ind]
-  col[is_point] <- alpha(col[is_point], alpha[is_point])
+  col[is_point | is_line] <- alpha(col[is_point | is_line], alpha[is_point | is_line])
   fill <- x$fill %||% defaults$fill[type_ind]
   fill <- alpha(fill, alpha)
   size <- x$size %||% defaults$size[type_ind]
+  point_size <- ifelse(is_collection, x$size %||% defaults$point_size[type_ind], size)
   stroke <- (x$stroke %||% defaults$stroke[1]) * .stroke / 2
-  fontsize <- size * .pt + stroke
+  fontsize <- point_size * .pt + stroke
   lwd <- ifelse(is_point, stroke, size * .pt)
   pch <- x$shape %||% defaults$shape[type_ind]
   lty <- x$linetype %||% defaults$linetype[type_ind]
   gp <- gpar(
     col = col, fill = fill, fontsize = fontsize, lwd = lwd, lty = lty,
     lineend = lineend, linejoin = linejoin, linemitre = linemitre
   )
-  sf::st_as_grob(geometry, pch = pch, gp = gp)
+  sf::st_as_grob(x$geometry, pch = pch, gp = gp)
 }
 
 #' @export
@@ -280,7 +299,7 @@ geom_sf_text <- function(mapping = aes(), data = NULL,
 
 sf_types <- c(GEOMETRY = "other", POINT = "point", LINESTRING = "line",
               POLYGON = "other", MULTIPOINT = "point", MULTILINESTRING = "line",
-              MULTIPOLYGON = "other", GEOMETRYCOLLECTION = "other",
+              MULTIPOLYGON = "other", GEOMETRYCOLLECTION = "collection",
               CIRCULARSTRING = "line", COMPOUNDCURVE = "other", CURVEPOLYGON = "other",
               MULTICURVE = "other", MULTISURFACE = "other", CURVE = "other",
               SURFACE = "other", POLYHEDRALSURFACE = "other", TIN = "other",

R/geom-sf.R

@@ -320,10 +320,14 @@ guide_gengrob.bins <- function(guide, theme) {
 
   key_size_mat <- do.call("cbind",
     lapply(guide$geoms, function(g) g$data$size / 10)
-  )[seq_len(n_keys), , drop = FALSE]
+  )
 
+  # key_size_mat can be an empty matrix (e.g. the data doesn't contain size
+  # column), so subset it only when it has any rows and columns.
   if (nrow(key_size_mat) == 0 || ncol(key_size_mat) == 0) {
     key_size_mat <- matrix(0, ncol = 1, nrow = n_keys)
+  } else {
+    key_size_mat <- key_size_mat[seq_len(n_keys), , drop = FALSE]
   }
   key_sizes <- apply(key_size_mat, 1, max)
 

R/guide-bins.R

@@ -230,7 +230,8 @@ guide_train.legend <- function(guide, scale, aesthetic = NULL) {
 
 #' @export
 guide_merge.legend <- function(guide, new_guide) {
-  guide$key <- merge(guide$key, new_guide$key, sort = FALSE)
+  new_guide$key$.label <- NULL
+  guide$key <- cbind(guide$key, new_guide$key)
   guide$override.aes <- c(guide$override.aes, new_guide$override.aes)
   if (any(duplicated(names(guide$override.aes)))) {
     warning("Duplicated override.aes is ignored.")

R/guide-legend.r

@@ -93,7 +93,7 @@ guide_train.axis <- function(guide, scale, aesthetic = NULL) {
       }
     }
 
-    guide$key <- ticks
+    guide$key <- ticks[is.finite(ticks[[aesthetic]]), ]
   }
 
   guide$name <- paste0(guide$name, "_", aesthetic)

R/guides-axis.r

@@ -88,7 +88,7 @@ ggplot_add <- function(object, plot, object_name) {
 }
 #' @export
 ggplot_add.default <- function(object, plot, object_name) {
-  stop("Don't know how to add ", object_name, " to a plot", call. = FALSE)
+  stop("Can't add `", object_name, "` to a ggplot object.", call. = FALSE)
 }
 #' @export
 ggplot_add.NULL <- function(object, plot, object_name) {
@@ -100,6 +100,14 @@ ggplot_add.data.frame <- function(object, plot, object_name) {
   plot
 }
 #' @export
+ggplot_add.function <- function(object, plot, object_name) {
+  stop(
+    "Can't add `", object_name, "` to a ggplot object.\n",
+    "Did you forget to add parentheses, as in `",
+    object_name, "()`?", call. = FALSE
+  )
+}
+#' @export
 ggplot_add.theme <- function(object, plot, object_name) {
   plot$theme <- add_theme(plot$theme, object)
   plot