Fix unit-to-numeric coercion assumptions (#3098)

* More reliable check for "npc" unit

* Make sure units are not merged

* fix implicit unit->numeric coercion attempts when calculating dimensions for facet_wrap

Author: thomasp85

R/facet-.r

@@ -462,18 +462,25 @@ check_layout <- function(x) {
 #' Get the maximal width/length of a list of grobs
 #'
 #' @param grobs A list of grobs
+#' @param value_only Should the return value be a simple numeric vector giving
+#' the maximum in cm
 #'
-#' @return The largest value. measured in cm as a unit object
+#' @return The largest value. measured in cm as a unit object or a numeric
+#' vector depending on `value_only`
 #'
 #' @keywords internal
 #' @export
-max_height <- function(grobs) {
-  unit(max(unlist(lapply(grobs, height_cm))), "cm")
+max_height <- function(grobs, value_only = FALSE) {
+  height <- max(unlist(lapply(grobs, height_cm)))
+  if (!value_only) height <- unit(height, "cm")
+  height
 }
 #' @rdname max_height
 #' @export
-max_width <- function(grobs) {
-  unit(max(unlist(lapply(grobs, width_cm))), "cm")
+max_width <- function(grobs, value_only = FALSE) {
+  width <- max(unlist(lapply(grobs, width_cm)))
+  if (!value_only) width <- unit(width, "cm")
+  width
 }
 #' Find panels in a gtable
 #'

R/facet-wrap.r

@@ -281,10 +281,22 @@ FacetWrap <- ggproto("FacetWrap", Facet,
       axis_mat_y_left[, -1] <- list(zeroGrob())
       axis_mat_y_right[, -ncol] <- list(zeroGrob())
     }
-    axis_height_top <- unit(apply(axis_mat_x_top, 1, max_height), "cm")
-    axis_height_bottom <- unit(apply(axis_mat_x_bottom, 1, max_height), "cm")
-    axis_width_left <- unit(apply(axis_mat_y_left, 2, max_width), "cm")
-    axis_width_right <- unit(apply(axis_mat_y_right, 2, max_width), "cm")
+    axis_height_top <- unit(
+      apply(axis_mat_x_top, 1, max_height, value_only = TRUE),
+      "cm"
+    )
+    axis_height_bottom <- unit(
+      apply(axis_mat_x_bottom, 1, max_height, value_only = TRUE),
+      "cm"
+    )
+    axis_width_left <- unit(
+      apply(axis_mat_y_left, 2, max_width, value_only = TRUE),
+      "cm"
+    )
+    axis_width_right <- unit(
+      apply(axis_mat_y_right, 2, max_width, value_only = TRUE),
+      "cm"
+    )
     # Add back missing axes
     if (any(empties)) {
       first_row <- which(apply(empties, 1, any))[1] - 1
@@ -330,10 +342,10 @@ FacetWrap <- ggproto("FacetWrap", Facet,
         placement <- if (inside) 0 else 1
         strip_pad <- axis_height_bottom
       }
-      strip_height <- unit(apply(strip_mat, 1, max_height), "cm")
+      strip_height <- unit(apply(strip_mat, 1, max_height, value_only = TRUE), "cm")
       panel_table <- weave_tables_row(panel_table, strip_mat, placement, strip_height, strip_name, 2, coord$clip)
       if (!inside) {
-        strip_pad[unclass(strip_pad) != 0] <- strip_padding
+        strip_pad[as.numeric(strip_pad) != 0] <- strip_padding
         panel_table <- weave_tables_row(panel_table, row_shift = placement, row_height = strip_pad)
       }
     } else {
@@ -345,11 +357,11 @@ FacetWrap <- ggproto("FacetWrap", Facet,
         placement <- if (inside) 0 else 1
         strip_pad <- axis_width_right
       }
-      strip_pad[unclass(strip_pad) != 0] <- strip_padding
-      strip_width <- unit(apply(strip_mat, 2, max_width), "cm")
+      strip_pad[as.numeric(strip_pad) != 0] <- strip_padding
+      strip_width <- unit(apply(strip_mat, 2, max_width, value_only = TRUE), "cm")
       panel_table <- weave_tables_col(panel_table, strip_mat, placement, strip_width, strip_name, 2, coord$clip)
       if (!inside) {
-        strip_pad[unclass(strip_pad) != 0] <- strip_padding
+        strip_pad[as.numeric(strip_pad) != 0] <- strip_padding
         panel_table <- weave_tables_col(panel_table, col_shift = placement, col_width = strip_pad)
       }
     }

R/grob-dotstack.r

@@ -13,13 +13,15 @@ dotstackGrob <- function(
         y <- unit(y, default.units)
     if (!is.unit(dotdia))
         dotdia <- unit(dotdia, default.units)
-    if (attr(dotdia,"unit") != "npc")
+    if (!is_npc(dotdia))
         warning("Unit type of dotdia should be 'npc'")
 
     grob(x = x, y = y, stackaxis = stackaxis, dotdia = dotdia,
          stackposition = stackposition, stackratio = stackratio,
          name = name, gp = gp, vp = vp, cl = "dotstackGrob")
 }
+# Only cross-version reliable way to check the unit of a unit object
+is_npc <- function(x) isTRUE(grepl('^[^+^-^\\*]*[^s]npc$', as.character(x)))
 
 #' @export
 makeContext.dotstackGrob <- function(x, recording = TRUE) {

R/theme.r

@@ -424,7 +424,7 @@ add_theme <- function(t1, t2, t2name) {
     if (is.null(x) || inherits(x, "element_blank")) {
       # If x is NULL or element_blank, then just assign it y
       x <- y
-    } else if (is.null(y) || is.character(y) || is.numeric(y) ||
+    } else if (is.null(y) || is.character(y) || is.numeric(y) || is.unit(y) ||
                is.logical(y) || inherits(y, "element_blank")) {
       # If y is NULL, or a string or numeric vector, or is element_blank, just replace x
       x <- y