Proof-of concept support for unit() throughout ggplot2

DESCRIPTION

@@ -171,6 +171,7 @@ Collate:
     'geom-violin.R'
     'geom-vline.R'
     'ggplot2-package.R'
+    'ggunit.R'
     'grob-absolute.R'
     'grob-dotstack.R'
     'grob-null.R'
@@ -280,5 +281,6 @@ Collate:
     'utilities-patterns.R'
     'utilities-resolution.R'
     'utilities-tidy-eval.R'
+    'utilities-unit.R'
     'zxx.R'
     'zzz.R'

NAMESPACE

@@ -5,18 +5,24 @@ S3method("$",ggproto_parent)
 S3method("$",theme)
 S3method("$<-",uneval)
 S3method("+",gg)
+S3method("[",ggunit)
 S3method("[",mapped_discrete)
 S3method("[",uneval)
+S3method("[<-",ggunit)
 S3method("[<-",mapped_discrete)
 S3method("[<-",uneval)
 S3method("[[",ggproto)
+S3method("[[<-",ggunit)
 S3method("[[<-",uneval)
 S3method(.DollarNames,ggproto)
+S3method(Ops,ggunit)
+S3method(Summary,ggunit)
 S3method(as.data.frame,mapped_discrete)
 S3method(as.list,ggproto)
 S3method(autolayer,default)
 S3method(autoplot,default)
 S3method(c,mapped_discrete)
+S3method(chooseOpsMethod,ggunit)
 S3method(drawDetails,zeroGrob)
 S3method(element_grob,element_blank)
 S3method(element_grob,element_line)
@@ -85,13 +91,17 @@ S3method(heightDetails,titleGrob)
 S3method(heightDetails,zeroGrob)
 S3method(interleave,default)
 S3method(interleave,unit)
+S3method(is.finite,ggunit)
+S3method(is.infinite,ggunit)
+S3method(is.na,ggunit)
 S3method(limits,Date)
 S3method(limits,POSIXct)
 S3method(limits,POSIXlt)
 S3method(limits,character)
 S3method(limits,factor)
 S3method(limits,numeric)
 S3method(makeContext,dotstackGrob)
+S3method(makeContext,ggplot2_pointsGrob)
 S3method(merge_element,default)
 S3method(merge_element,element)
 S3method(merge_element,element_blank)
@@ -109,9 +119,11 @@ S3method(print,ggplot)
 S3method(print,ggplot2_bins)
 S3method(print,ggproto)
 S3method(print,ggproto_method)
+S3method(print,ggunit)
 S3method(print,rel)
 S3method(print,theme)
 S3method(print,uneval)
+S3method(rescale,unit)
 S3method(scale_type,AsIs)
 S3method(scale_type,Date)
 S3method(scale_type,POSIXt)
@@ -126,27 +138,63 @@ S3method(scale_type,logical)
 S3method(scale_type,numeric)
 S3method(scale_type,ordered)
 S3method(scale_type,sfc)
+S3method(scale_type,unit)
+S3method(sign,ggunit)
 S3method(single_value,default)
 S3method(single_value,factor)
 S3method(summary,ggplot)
 S3method(vec_cast,character.mapped_discrete)
+S3method(vec_cast,double.ggunit)
 S3method(vec_cast,double.mapped_discrete)
 S3method(vec_cast,factor.mapped_discrete)
+S3method(vec_cast,ggunit.character)
+S3method(vec_cast,ggunit.double)
+S3method(vec_cast,ggunit.ggunit)
+S3method(vec_cast,ggunit.integer)
+S3method(vec_cast,ggunit.list)
+S3method(vec_cast,ggunit.logical)
+S3method(vec_cast,ggunit.mapped_discrete)
+S3method(vec_cast,ggunit.simpleUnit)
+S3method(vec_cast,ggunit.unit)
+S3method(vec_cast,integer.ggunit)
 S3method(vec_cast,integer.mapped_discrete)
+S3method(vec_cast,logical.ggunit)
 S3method(vec_cast,mapped_discrete.double)
 S3method(vec_cast,mapped_discrete.factor)
+S3method(vec_cast,mapped_discrete.ggunit)
 S3method(vec_cast,mapped_discrete.integer)
 S3method(vec_cast,mapped_discrete.logical)
 S3method(vec_cast,mapped_discrete.mapped_discrete)
+S3method(vec_cast,simpleUnit.ggunit)
+S3method(vec_cast,simpleUnit.unit)
+S3method(vec_cast,unit.ggunit)
+S3method(vec_cast,unit.simpleUnit)
+S3method(vec_cast,unit.unit)
+S3method(vec_proxy,simpleUnit)
+S3method(vec_proxy,unit)
 S3method(vec_ptype2,character.mapped_discrete)
+S3method(vec_ptype2,double.ggunit)
 S3method(vec_ptype2,double.mapped_discrete)
 S3method(vec_ptype2,factor.mapped_discrete)
+S3method(vec_ptype2,ggunit.double)
+S3method(vec_ptype2,ggunit.ggunit)
+S3method(vec_ptype2,ggunit.integer)
+S3method(vec_ptype2,ggunit.simpleUnit)
+S3method(vec_ptype2,ggunit.unit)
+S3method(vec_ptype2,integer.ggunit)
 S3method(vec_ptype2,integer.mapped_discrete)
 S3method(vec_ptype2,mapped_discrete.character)
 S3method(vec_ptype2,mapped_discrete.double)
 S3method(vec_ptype2,mapped_discrete.factor)
 S3method(vec_ptype2,mapped_discrete.integer)
 S3method(vec_ptype2,mapped_discrete.mapped_discrete)
+S3method(vec_ptype2,simpleUnit.ggunit)
+S3method(vec_ptype2,simpleUnit.unit)
+S3method(vec_ptype2,unit.ggunit)
+S3method(vec_ptype2,unit.simpleUnit)
+S3method(vec_ptype2,unit.unit)
+S3method(vec_restore,ggunit)
+S3method(vec_restore,unit)
 S3method(widthDetails,titleGrob)
 S3method(widthDetails,zeroGrob)
 export("%+%")

R/coord-.R

@@ -170,7 +170,11 @@ Coord <- ggproto("Coord",
     panel_params
   },
 
-  transform = function(data, range) NULL,
+  transform = function(self, data, range) {
+    .expose_units(self$transform_native(.ignore_units(data), range))
+  },
+
+  transform_native = function(data, range) NULL,
 
   distance = function(x, y, panel_params) NULL,
 

R/coord-cartesian-.R

@@ -93,7 +93,7 @@ CoordCartesian <- ggproto("CoordCartesian", Coord,
     self$range(panel_params)
   },
 
-  transform = function(data, panel_params) {
+  transform_native = function(data, panel_params) {
     data <- transform_position(data, panel_params$x$rescale, panel_params$y$rescale)
     transform_position(data, squish_infinite, squish_infinite)
   },

R/coord-flip.R

@@ -59,7 +59,7 @@ coord_flip <- function(xlim = NULL, ylim = NULL, expand = TRUE, clip = "on") {
 #' @export
 CoordFlip <- ggproto("CoordFlip", CoordCartesian,
 
-  transform = function(data, panel_params) {
+  transform_native = function(data, panel_params) {
     data <- flip_axis_labels(data)
     CoordCartesian$transform(data, panel_params)
   },

R/coord-map.R

@@ -153,7 +153,7 @@ coord_map <- function(projection="mercator", ..., parameters = NULL, orientation
 #' @export
 CoordMap <- ggproto("CoordMap", Coord,
 
-  transform = function(self, data, panel_params) {
+  transform_native = function(self, data, panel_params) {
     trans <- mproject(self, data$x, data$y, panel_params$orientation)
     out <- cunion(trans[c("x", "y")], data)
 

R/coord-munch.R

@@ -15,6 +15,8 @@
 coord_munch <- function(coord, data, range, segment_length = 0.01, is_closed = FALSE) {
   if (coord$is_linear()) return(coord$transform(data, range))
 
+  data <- .ignore_units(data)
+
   if (is_closed) {
     data <- close_poly(data)
   }
@@ -44,7 +46,7 @@ coord_munch <- function(coord, data, range, segment_length = 0.01, is_closed = F
     runs <- vec_run_sizes(munched[, group_cols, drop = FALSE])
     munched <- vec_slice(munched, -(cumsum(runs)))
   }
-  coord$transform(munched, range)
+  coord$transform(.expose_units(munched), range)
 }
 
 # For munching, only grobs are lines and polygons: everything else is

R/coord-polar.R

@@ -167,7 +167,7 @@ CoordPolar <- ggproto("CoordPolar", Coord,
     panel_params
   },
 
-  transform = function(self, data, panel_params) {
+  transform_native = function(self, data, panel_params) {
     arc  <- self$start + c(0, 2 * pi)
     dir  <- self$direction
     data <- rename_data(self, data)
@@ -316,15 +316,15 @@ rename_data <- function(coord, data) {
 }
 
 theta_rescale_no_clip <- function(x, range, arc = c(0, 2 * pi), direction = 1) {
-  rescale(x, to = arc, from = range) * direction
+  transform_native_units(x, function(x) rescale(x, to = arc, from = range) * direction)
 }
 
 theta_rescale <- function(x, range, arc = c(0, 2 * pi), direction = 1) {
   x <- squish_infinite(x, range)
-  rescale(x, to = arc, from = range) %% (2 * pi) * direction
+  transform_native_units(x, function(x) rescale(x, to = arc, from = range) %% (2 * pi) * direction)
 }
 
 r_rescale <- function(x, range, donut = c(0, 0.4)) {
   x <- squish_infinite(x, range)
-  rescale(x, donut, range)
+  transform_native_units(x, function(x) rescale(x, donut, range))
 }

R/coord-radial.R

@@ -219,7 +219,7 @@ CoordRadial <- ggproto("CoordRadial", Coord,
     panel_params
   },
 
-  transform = function(self, data, panel_params) {
+  transform_native = function(self, data, panel_params) {
     data <- rename_data(self, data)
     bbox <- panel_params$bbox %||% list(x = c(0, 1), y = c(0, 1))
     arc  <- panel_params$arc  %||% c(0, 2 * pi)

R/coord-sf.R

@@ -78,7 +78,7 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
     self$params$bbox <- bbox
   },
 
-  transform = function(self, data, panel_params) {
+  transform_native = function(self, data, panel_params) {
     # we need to transform all non-sf data into the correct coordinate system
     source_crs <- panel_params$default_crs
     target_crs <- panel_params$crs

R/coord-transform.R

@@ -127,7 +127,7 @@ CoordTrans <- ggproto("CoordTrans", Coord,
     )
   },
 
-  transform = function(self, data, panel_params) {
+  transform_native = function(self, data, panel_params) {
     # trans_x() and trans_y() needs to keep Inf values because this can be called
     # in guide_transform.axis()
     trans_x <- function(data) {

R/fortify-map.R

@@ -37,7 +37,7 @@ fortify.map <- function(model, data, ...) {
   names <- inject(rbind(!!!names))
   df$region <- names[df$group, 1]
   df$subregion <- names[df$group, 2]
-  df[stats::complete.cases(df$lat, df$long), ]
+  df[vec_detect_complete(df$lat, df$long), ]
 }
 
 #' Create a data frame of map data

R/geom-path.R

@@ -138,7 +138,7 @@ GeomPath <- ggproto("GeomPath", Geom,
     # Drop missing values at the start or end of a line - can't drop in the
     # middle since you expect those to be shown by a break in the line
     aesthetics <- c(self$required_aes, self$non_missing_aes)
-    complete <- stats::complete.cases(data[names(data) %in% aesthetics])
+    complete <- vec_detect_complete(data[names(data) %in% aesthetics])
     kept <- stats::ave(complete, data$group, FUN = keep_mid_true)
     data <- data[kept, ]
 

R/geom-point.R

@@ -121,28 +121,60 @@ GeomPoint <- ggproto("GeomPoint", Geom,
     if (is.character(data$shape)) {
       data$shape <- translate_shape_string(data$shape)
     }
-
     coords <- coord$transform(data, panel_params)
+
     stroke_size <- coords$stroke
-    stroke_size[is.na(stroke_size)] <- 0
+    if (!is.unit(stroke_size)) stroke_size <- unit(stroke_size * .stroke, "pt")
+    native_units(stroke_size) <- rescale(native_units(stroke_size), from = c(0, diff(coord$range(panel_params)$x)))
+    stroke_size[is.na(stroke_size)] <- unit(0, "pt")
+
+    font_size <- coords$size
+    if (!is.unit(font_size)) font_size <- unit(font_size * .pt, "pt")
+    native_units(font_size) <- rescale(native_units(font_size), from = c(0, diff(coord$range(panel_params)$x)))
+
     ggname("geom_point",
-      pointsGrob(
+      ggplot2_pointsGrob(
         coords$x, coords$y,
         pch = coords$shape,
-        gp = gpar(
-          col = alpha(coords$colour, coords$alpha),
-          fill = fill_alpha(coords$fill, coords$alpha),
-          # Stroke is added around the outside of the point
-          fontsize = coords$size * .pt + stroke_size * .stroke / 2,
-          lwd = coords$stroke * .stroke / 2
-        )
+        col = alpha(coords$colour, coords$alpha),
+        fill = fill_alpha(coords$fill, coords$alpha),
+        # Stroke is added around the outside of the point
+        fontsize = font_size + stroke_size / 2,
+        lwd = stroke_size / 2
       )
     )
   },
 
   draw_key = draw_key_point
 )
 
+ggplot2_pointsGrob <- function(
+  x, y, pch = 1, vp = NULL,
+  fontsize = 12, lwd = 1, col = "black", fill = "white"
+) {
+  grob(
+    x = x, y = y, pch = pch, vp = vp,
+    fontsize = fontsize, lwd = lwd, col = col, fill = fill,
+    cl = "ggplot2_pointsGrob"
+  )
+}
+
+#' @export
+makeContext.ggplot2_pointsGrob <- function(x) {
+  pointsGrob(
+    x$x,
+    x$y,
+    pch = x$pch,
+    gp = gpar(
+      col = x$col,
+      fill = x$fill,
+      # Stroke is added around the outside of the point
+      fontsize = convertUnit(x$fontsize + x$lwd, unitTo = "pt", valueOnly = TRUE),
+      lwd = convertUnit(x$lwd, unitTo = "pt", valueOnly = TRUE)
+    )
+  )
+}
+
 #' Translating shape strings
 #'
 #' `translate_shape_string()` is a helper function for translating point shapes

R/geom-ribbon.R

@@ -131,7 +131,7 @@ GeomRibbon <- ggproto("GeomRibbon", Geom,
                         flipped_aes = FALSE, outline.type = "both") {
     data <- check_linewidth(data, snake_class(self))
     data <- flip_data(data, flipped_aes)
-    if (na.rm) data <- data[stats::complete.cases(data[c("x", "ymin", "ymax")]), ]
+    if (na.rm) data <- data[vec_detect_complete(data[c("x", "ymin", "ymax")]), ]
     data <- data[order(data$group), ]
 
     # Check that aesthetics are constant
@@ -148,7 +148,7 @@ GeomRibbon <- ggproto("GeomRibbon", Geom,
     # has distinct polygon numbers for sequences of non-NA values and NA
     # for NA values in the original data.  Example: c(NA, 2, 2, 2, NA, NA,
     # 4, 4, 4, NA)
-    missing_pos <- !stats::complete.cases(data[c("x", "ymin", "ymax")])
+    missing_pos <- !vec_detect_complete(data[c("x", "ymin", "ymax")])
     ids <- cumsum(missing_pos) + 1
     ids[missing_pos] <- NA