Peformance: vec_unique_count (#5158)

teunbrand · web-flow · commit 4daadf722143 · 2023-02-21T18:19:36.000+01:00
* Use `is_unique()`

* Use `vec_unique_count()`
diff --git a/R/axis-secondary.R b/R/axis-secondary.R
@@ -193,7 +193,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL,
     full_range <- self$transform_range(old_range)
 
     # Test for monotonicity
-    if (length(unique0(sign(diff(full_range)))) != 1)
+    if (!is_unique(sign(diff(full_range))))
       cli::cli_abort("Transformation for secondary axes must be monotonic")
   },
 
diff --git a/R/facet-.r b/R/facet-.r
@@ -119,10 +119,10 @@ Facet <- ggproto("Facet", NULL,
     }
   },
   draw_back = function(data, layout, x_scales, y_scales, theme, params) {
-    rep(list(zeroGrob()), length(unique0(layout$PANEL)))
+    rep(list(zeroGrob()), vec_unique_count(layout$PANEL))
   },
   draw_front = function(data, layout, x_scales, y_scales, theme, params) {
-    rep(list(zeroGrob()), length(unique0(layout$PANEL)))
+    rep(list(zeroGrob()), vec_unique_count(layout$PANEL))
   },
   draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) {
     cli::cli_abort("Not implemented")
diff --git a/R/guides-axis.r b/R/guides-axis.r
@@ -440,7 +440,7 @@ warn_for_guide_position <- function(guide) {
     return()
   }
 
-  if (length(unique0(guide$key[[position_aes]][breaks_are_unique])) == 1) {
+  if (is_unique(guide$key[[position_aes]][breaks_are_unique])) {
     cli::cli_warn(c(
       "Position guide is perpendicular to the intended axis",
       "i" = "Did you mean to specify a different guide {.arg position}?"
diff --git a/R/position-collide.r b/R/position-collide.r
@@ -48,7 +48,7 @@ collide <- function(data, width = NULL, name, strategy,
   intervals <- as.numeric(t(unique0(data[c("xmin", "xmax")])))
   intervals <- intervals[!is.na(intervals)]
 
-  if (length(unique0(intervals)) > 1 & any(diff(scale(intervals)) < -1e-6)) {
+  if (vec_unique_count(intervals) > 1 & any(diff(scale(intervals)) < -1e-6)) {
     cli::cli_warn("{.fn {name}} requires non-overlapping {.field x} intervals")
     # This is where the algorithm from [L. Wilkinson. Dot plots.
     # The American Statistician, 1999.] should be used
diff --git a/R/position-dodge.r b/R/position-dodge.r
@@ -144,7 +144,7 @@ PositionDodge <- ggproto("PositionDodge", Position,
 # Assumes that each set has the same horizontal position.
 pos_dodge <- function(df, width, n = NULL) {
   if (is.null(n)) {
-    n <- length(unique0(df$group))
+    n <- vec_unique_count(df$group)
   }
 
   if (n == 1)
diff --git a/R/position-jitterdodge.R b/R/position-jitterdodge.R
@@ -53,7 +53,7 @@ PositionJitterdodge <- ggproto("PositionJitterdodge", Position,
       cli::cli_abort("{.fn position_jitterdodge} requires at least one aesthetic to dodge by")
     }
     ndodge    <- lapply(data[dodgecols], levels)  # returns NULL for numeric, i.e. non-dodge layers
-    ndodge    <- length(unique0(unlist(ndodge)))
+    ndodge    <- vec_unique_count(unlist(ndodge))
 
     list(
       dodge.width = self$dodge.width,
diff --git a/R/stat-.r b/R/stat-.r
@@ -143,7 +143,7 @@ Stat <- ggproto("Stat",
 
       # Then, check whether the rest of the columns have constant values (type 2)
       # or not (type 3).
-      non_constant <- vapply(old, function(x) length(unique0(x)) > 1, logical(1L))
+      non_constant <- vapply(old, vec_unique_count, integer(1)) > 1L
 
       # Record the non-constant columns.
       non_constant_columns <<- c(non_constant_columns, names(old)[non_constant])
diff --git a/R/stat-align.R b/R/stat-align.R
@@ -56,7 +56,7 @@ StatAlign <- ggproto("StatAlign", Stat,
 
   compute_group = function(data, scales, flipped_aes = NA, unique_loc = NULL, adjust = 0) {
     data <- flip_data(data, flipped_aes)
-    if (length(unique(data$x)) == 1) {
+    if (is_unique(data$x)) {
       # Not enough data to align
       return(new_data_frame())
     }
diff --git a/R/stat-boxplot.r b/R/stat-boxplot.r
@@ -108,7 +108,7 @@ StatBoxplot <- ggproto("StatBoxplot", Stat,
       stats[c(1, 5)] <- range(c(stats[2:4], data$y[!outliers]), na.rm = TRUE)
     }
 
-    if (length(unique0(data$x)) > 1)
+    if (vec_unique_count(data$x) > 1)
       width <- diff(range(data$x)) * 0.9
 
     df <- data_frame0(!!!as.list(stats))
diff --git a/R/stat-smooth.r b/R/stat-smooth.r
@@ -130,7 +130,7 @@ StatSmooth <- ggproto("StatSmooth", Stat,
                            xseq = NULL, level = 0.95, method.args = list(),
                            na.rm = FALSE, flipped_aes = NA) {
     data <- flip_data(data, flipped_aes)
-    if (length(unique0(data$x)) < 2) {
+    if (vec_unique_count(data$x) < 2) {
       # Not enough data to perform fit
       return(data_frame0())
     }
diff --git a/R/stat-ydensity.r b/R/stat-ydensity.r
@@ -87,7 +87,7 @@ StatYdensity <- ggproto("StatYdensity", Stat,
     dens$x <- mean(range(data$x))
 
     # Compute width if x has multiple values
-    if (length(unique0(data$x)) > 1) {
+    if (vec_unique_count(data$x) > 1) {
       width <- diff(range(data$x)) * 0.9
     }
     dens$width <- width
diff --git a/R/utilities.r b/R/utilities.r
@@ -61,7 +61,7 @@ clist <- function(l) {
 #
 # @keyword internal
 uniquecols <- function(df) {
-  df <- df[1, sapply(df, function(x) length(unique0(x)) == 1), drop = FALSE]
+  df <- df[1, sapply(df, is_unique), drop = FALSE]
   rownames(df) <- 1:nrow(df)
   df
 }
@@ -356,6 +356,9 @@ data_frame0 <- function(...) data_frame(..., .name_repair = "minimal")
 # Wrapping unique0() to accept NULL
 unique0 <- function(x, ...) if (is.null(x)) x else vec_unique(x, ...)
 
+# Code readability checking for uniqueness
+is_unique <- function(x) vec_unique_count(x) == 1L
+
 # Check inputs with tibble but allow column vectors (see #2609 and #2374)
 as_gg_data_frame <- function(x) {
   x <- lapply(x, validate_column_vec)
@@ -547,14 +550,14 @@ has_flipped_aes <- function(data, params = list(), main_is_orthogonal = NA,
   if (group_has_equal) {
     if (has_x) {
       if (length(x) == 1) return(FALSE)
-      x_groups <- vapply(split(data$x, data$group), function(x) length(unique0(x)), integer(1))
+      x_groups <- vapply(split(data$x, data$group), vec_unique_count, integer(1))
       if (all(x_groups == 1)) {
         return(FALSE)
       }
     }
     if (has_y) {
       if (length(y) == 1) return(TRUE)
-      y_groups <- vapply(split(data$y, data$group), function(x) length(unique0(x)), integer(1))
+      y_groups <- vapply(split(data$y, data$group), vec_unique_count, integer(1))
       if (all(y_groups == 1)) {
         return(TRUE)
       }
diff --git a/tests/testthat/test-aes-grouping.r b/tests/testthat/test-aes-grouping.r
@@ -5,7 +5,7 @@ df <- data_frame(
 )
 
 group <- function(x) as.vector(layer_data(x, 1)$group)
-groups <- function(x) length(unique(group(x)))
+groups <- function(x) vec_unique_count(group(x))
 
 
 test_that("one group per combination of discrete vars", {
diff --git a/tests/testthat/test-facet-.r b/tests/testthat/test-facet-.r
@@ -193,12 +193,12 @@ test_that("facets with free scales scale independently", {
   l2 <- p + facet_grid(. ~ z, scales = "free")
   d2 <- cdata(l2)[[1]]
   expect_true(sd(d2$x) < 1e-10)
-  expect_equal(length(unique(d2$y)), 3)
+  expect_length(unique(d2$y), 3)
 
   # LHS of facet_grid()
   l3 <- p + facet_grid(z ~ ., scales = "free")
   d3 <- cdata(l3)[[1]]
-  expect_equal(length(unique(d3$x)), 3)
+  expect_length(unique(d3$x), 3)
   expect_true(sd(d3$y) < 1e-10)
 })
 

Original file line number	Diff line number	Diff line change
`@@ -440,7 +440,7 @@ warn_for_guide_position <- function(guide) {`
`440`	`440`	`return()`
`441`	`441`	`}`
`442`	`442`
`443`		`- if (length(unique0(guide$key[[position_aes]][breaks_are_unique])) == 1) {`
	`443`	`+ if (is_unique(guide$key[[position_aes]][breaks_are_unique])) {`
`444`	`444`	`cli::cli_warn(c(`
`445`	`445`	`"Position guide is perpendicular to the intended axis",`
`446`	`446`	`"i" = "Did you mean to specify a different guide {.arg position}?"`
Original file line number	Diff line number	Diff line change
`@@ -144,7 +144,7 @@ PositionDodge <- ggproto("PositionDodge", Position,`
`144`	`144`	`# Assumes that each set has the same horizontal position.`
`145`	`145`	`pos_dodge <- function(df, width, n = NULL) {`
`146`	`146`	`if (is.null(n)) {`
`147`		`- n <- length(unique0(df$group))`
	`147`	`+ n <- vec_unique_count(df$group)`
`148`	`148`	`}`
`149`	`149`
`150`	`150`	`if (n == 1)`
Original file line number	Diff line number	Diff line change
`@@ -53,7 +53,7 @@ PositionJitterdodge <- ggproto("PositionJitterdodge", Position,`
`53`	`53`	`cli::cli_abort("{.fn position_jitterdodge} requires at least one aesthetic to dodge by")`
`54`	`54`	`}`
`55`	`55`	`ndodge <- lapply(data[dodgecols], levels) # returns NULL for numeric, i.e. non-dodge layers`
`56`		`- ndodge <- length(unique0(unlist(ndodge)))`
	`56`	`+ ndodge <- vec_unique_count(unlist(ndodge))`
`57`	`57`
`58`	`58`	`list(`
`59`	`59`	`dodge.width = self$dodge.width,`
Original file line number	Diff line number	Diff line change
`@@ -56,7 +56,7 @@ StatAlign <- ggproto("StatAlign", Stat,`
`56`	`56`
`57`	`57`	`compute_group = function(data, scales, flipped_aes = NA, unique_loc = NULL, adjust = 0) {`
`58`	`58`	`data <- flip_data(data, flipped_aes)`
`59`		`- if (length(unique(data$x)) == 1) {`
	`59`	`+ if (is_unique(data$x)) {`
`60`	`60`	`# Not enough data to align`
`61`	`61`	`return(new_data_frame())`
`62`	`62`	`}`
Original file line number	Diff line number	Diff line change
`@@ -108,7 +108,7 @@ StatBoxplot <- ggproto("StatBoxplot", Stat,`
`108`	`108`	`stats[c(1, 5)] <- range(c(stats[2:4], data$y[!outliers]), na.rm = TRUE)`
`109`	`109`	`}`
`110`	`110`
`111`		`- if (length(unique0(data$x)) > 1)`
	`111`	`+ if (vec_unique_count(data$x) > 1)`
`112`	`112`	`width <- diff(range(data$x)) * 0.9`
`113`	`113`
`114`	`114`	`df <- data_frame0(!!!as.list(stats))`
Original file line number	Diff line number	Diff line change
`@@ -130,7 +130,7 @@ StatSmooth <- ggproto("StatSmooth", Stat,`
`130`	`130`	`xseq = NULL, level = 0.95, method.args = list(),`
`131`	`131`	`na.rm = FALSE, flipped_aes = NA) {`
`132`	`132`	`data <- flip_data(data, flipped_aes)`
`133`		`- if (length(unique0(data$x)) < 2) {`
	`133`	`+ if (vec_unique_count(data$x) < 2) {`
`134`	`134`	`# Not enough data to perform fit`
`135`	`135`	`return(data_frame0())`
`136`	`136`	`}`