From e5abb05a8ae8a4268dbcffaa300fc82d353b59b1 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Thu, 14 Dec 2023 11:59:15 +0100
Subject: [PATCH 1/3] Arrow key size (#5565)

* adjust `draw_key_{v}path()`

* adjust derived keys

* Add news bullet
---
 NEWS.md         |  2 ++
 R/legend-draw.R | 36 +++++++++++++++++++++++++++++-------
 2 files changed, 31 insertions(+), 7 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 55dffd0401..96b0f65b80 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,7 @@
 # ggplot2 (development version)
 
+* Legend keys that can draw arrows have their size adjusted for arrows.
+
 * The `trans` argument in scales and secondary axes has been renamed to 
   `transform`. The `trans` argument itself is deprecated. To access the
   transformation from the scale, a new `get_transformation()` method is 
diff --git a/R/legend-draw.R b/R/legend-draw.R
index 8ee116f65c..a7b692a05f 100644
--- a/R/legend-draw.R
+++ b/R/legend-draw.R
@@ -160,8 +160,7 @@ draw_key_path <- function(data, params, size) {
   } else {
     data$linetype[is.na(data$linetype)] <- 0
   }
-
-  segmentsGrob(0.1, 0.5, 0.9, 0.5,
+  grob <- segmentsGrob(0.1, 0.5, 0.9, 0.5,
     gp = gpar(
       col = alpha(data$colour %||% data$fill %||% "black", data$alpha),
       fill = alpha(params$arrow.fill %||% data$colour
@@ -172,12 +171,19 @@ draw_key_path <- function(data, params, size) {
     ),
     arrow = params$arrow
   )
+  if (!is.null(params$arrow)) {
+    angle <- deg2rad(params$arrow$angle)
+    length <- convertUnit(params$arrow$length, "cm", valueOnly = TRUE)
+    attr(grob, "width")  <- cos(angle) * length * 1.25
+    attr(grob, "height") <- sin(angle) * length * 2
+  }
+  grob
 }
 
 #' @export
 #' @rdname draw_key
 draw_key_vpath <- function(data, params, size) {
-  segmentsGrob(0.5, 0.1, 0.5, 0.9,
+  grob <- segmentsGrob(0.5, 0.1, 0.5, 0.9,
     gp = gpar(
       col = alpha(data$colour %||% data$fill %||% "black", data$alpha),
       lwd = (data$linewidth %||% 0.5) * .pt,
@@ -186,6 +192,13 @@ draw_key_vpath <- function(data, params, size) {
     ),
     arrow = params$arrow
   )
+  if (!is.null(params$arrow)) {
+    angle <- deg2rad(params$arrow$angle)
+    length <- convertUnit(params$arrow$length, "cm", valueOnly = TRUE)
+    attr(grob, "width")  <- sin(angle) * length * 2
+    attr(grob, "height") <- cos(angle) * length * 1.25
+  }
+  grob
 }
 
 #' @export
@@ -215,10 +228,14 @@ draw_key_linerange <- function(data, params, size) {
 #' @export
 #' @rdname draw_key
 draw_key_pointrange <- function(data, params, size) {
-  grobTree(
-    draw_key_linerange(data, params, size),
+  linerange <- draw_key_linerange(data, params, size)
+  grob <- grobTree(
+    linerange,
     draw_key_point(transform(data, size = (data$size %||% 1.5) * 4), params)
   )
+  attr(grob, "width")  <- attr(linerange, "width")
+  attr(grob, "height") <- attr(linerange, "height")
+  grob
 }
 
 #' @export
@@ -227,10 +244,15 @@ draw_key_smooth <- function(data, params, size) {
   data$fill <- alpha(data$fill %||% "grey60", data$alpha)
   data$alpha <- 1
 
-  grobTree(
+  path <- draw_key_path(data, params, size)
+
+  grob <- grobTree(
     if (isTRUE(params$se)) rectGrob(gp = gpar(col = NA, fill = data$fill)),
-    draw_key_path(data, params, size)
+    path
   )
+  attr(grob, "width") <- attr(path, "width")
+  attr(grob, "height") <- attr(path, "height")
+  grob
 }
 
 #' @export

From aa41dcb686178ff89896efca6884947778974a0f Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Thu, 14 Dec 2023 12:58:57 +0100
Subject: [PATCH 2/3] `position_stack()` does not remove missing data (#5519)

* instead of removing, `position_stack()` sets incomplete data to missing

* adjust test

* Add news bullet

* add issue nr to bullet
---
 NEWS.md                        |  3 +++
 R/position-stack.R             |  9 ++++-----
 tests/testthat/test-geom-col.R |  4 ++--
 tests/testthat/test-scales.R   | 12 ++++++++----
 4 files changed, 17 insertions(+), 11 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 96b0f65b80..dbac0a777b 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,8 @@
 # ggplot2 (development version)
 
+* `position_stack()` no longer silently removes missing data, which is now
+  handled by the geom instead of position (#3532).
+
 * Legend keys that can draw arrows have their size adjusted for arrows.
 
 * The `trans` argument in scales and secondary axes has been renamed to 
diff --git a/R/position-stack.R b/R/position-stack.R
index 2aacb638bb..ac445be071 100644
--- a/R/position-stack.R
+++ b/R/position-stack.R
@@ -175,11 +175,10 @@ PositionStack <- ggproto("PositionStack", Position,
       ymax = as.numeric(ifelse(data$ymax == 0, data$ymin, data$ymax))
     )
 
-    data <- remove_missing(
-      data,
-      vars = c("x", "xmin", "xmax", "y"),
-      name = "position_stack"
-    )
+    vars <- intersect(c("x", "xmin", "xmax", "y"), names(data))
+    missing <- detect_missing(data, vars)
+    data[missing, vars] <- NA
+
     flip_data(data, params$flipped_aes)
   },
 
diff --git a/tests/testthat/test-geom-col.R b/tests/testthat/test-geom-col.R
index 456f03142f..17c61064d9 100644
--- a/tests/testthat/test-geom-col.R
+++ b/tests/testthat/test-geom-col.R
@@ -7,8 +7,8 @@ test_that("geom_col removes columns with parts outside the plot limits", {
     ggplotGrob(p + ylim(0.5, 4)),
     "Removed 3 rows containing missing values or values outside the scale range"
   )
-  expect_warning( # warning created at build stage
-    ggplot_build(p + ylim(0, 2.5)),
+  expect_warning( # warning created at render stage
+    ggplotGrob(p + ylim(0, 2.5)),
     "Removed 1 row containing missing values or values outside the scale range"
   )
 })
diff --git a/tests/testthat/test-scales.R b/tests/testthat/test-scales.R
index 4893caceb4..25c8cc58f9 100644
--- a/tests/testthat/test-scales.R
+++ b/tests/testthat/test-scales.R
@@ -111,10 +111,14 @@ test_that("oob affects position values", {
   }
   base + scale_y_continuous(limits = c(-0,5))
 
-  expect_warning(low_censor <- cdata(base + y_scale(c(0, 5), censor)),
+  low_censor <- cdata(base + y_scale(c(0, 5), censor))
+  mid_censor <- cdata(base + y_scale(c(3, 7), censor))
+  handle <- GeomBar$handle_na
+
+  expect_warning(low_censor[[1]] <- handle(low_censor[[1]], list(na.rm = FALSE)),
     "Removed 1 row containing missing values or values outside the scale range")
-  expect_warning(mid_censor <- cdata(base + y_scale(c(3, 7), censor)),
-    "Removed 2 rows containing missing values or values outside the scale range")
+  expect_warning(mid_censor[[1]] <- handle(mid_censor[[1]], list(na.rm = FALSE)),
+    "Removed 3 rows containing missing values or values outside the scale range")
 
   low_squish <- cdata(base + y_scale(c(0, 5), squish))
   mid_squish <- cdata(base + y_scale(c(3, 7), squish))
@@ -127,7 +131,7 @@ test_that("oob affects position values", {
 
   # Bars depend on limits and oob
   expect_equal(low_censor[[1]]$y, c(0.2, 1))
-  expect_equal(mid_censor[[1]]$y, c(0.5))
+  expect_equal(mid_censor[[1]]$y, numeric(0))
   expect_equal(low_squish[[1]]$y, c(0.2, 1, 1))
   expect_equal(mid_squish[[1]]$y, c(0, 0.5, 1))
 })

From abc70e280bf83c1e8cdbe53ba18fdf145d8dd33c Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Thu, 14 Dec 2023 13:21:35 +0100
Subject: [PATCH 3/3] `stat_count()` respects uniqueness of `x` (#5520)

* instead of removing, `position_stack()` sets incomplete data to missing

* adjust test

* add test

* Add news bullet
---
 NEWS.md                          |  3 +++
 R/stat-count.R                   |  3 +--
 tests/testthat/test-stat-count.R | 11 +++++++++++
 3 files changed, 15 insertions(+), 2 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index dbac0a777b..71f471a2fc 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,8 @@
 # ggplot2 (development version)
 
+* `stat_count()` treats `x` as unique in the same manner `unique()` does 
+  (#4609).
+
 * `position_stack()` no longer silently removes missing data, which is now
   handled by the geom instead of position (#3532).
 
diff --git a/R/stat-count.R b/R/stat-count.R
index 705e0f4226..81790d7aa1 100644
--- a/R/stat-count.R
+++ b/R/stat-count.R
@@ -75,8 +75,7 @@ StatCount <- ggproto("StatCount", Stat,
     x <- data$x
     weight <- data$weight %||% rep(1, length(x))
 
-    count <- as.numeric(tapply(weight, x, sum, na.rm = TRUE))
-    count[is.na(count)] <- 0
+    count <- as.vector(rowsum(weight, x, na.rm = TRUE))
 
     bars <- data_frame0(
       count = count,
diff --git a/tests/testthat/test-stat-count.R b/tests/testthat/test-stat-count.R
index 827ac9f109..7483becf94 100644
--- a/tests/testthat/test-stat-count.R
+++ b/tests/testthat/test-stat-count.R
@@ -4,3 +4,14 @@ test_that("stat_count() checks the aesthetics", {
   p <- ggplot(mtcars) + stat_count(aes(factor(gear), mpg))
   expect_snapshot_error(ggplot_build(p))
 })
+
+test_that("stat_count() respects uniqueness of `x`", {
+  # For #4609, converting x to factor loses smallest digits, so here we test
+  # if they are retained
+  df <- data_frame0(x = c(1, 2, 1, 2) + rep(c(0, 1.01 * .Machine$double.eps), each = 2))
+  p <- ggplot(df, aes(x)) + stat_count(position = "identity")
+  data <- layer_data(p)
+
+  expect_length(vec_unique(df$x), 4)
+  expect_equal(data$y, rep(1, 4))
+})