From 8bcdd5ffd56748dc61788d96525da7388d4c3345 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 7 Jun 2024 15:48:56 +0200 Subject: [PATCH 1/5] fix and vectorise `find_x_overlaps()` --- R/position-dodge2.R | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/R/position-dodge2.R b/R/position-dodge2.R index a4c5fdc8ba..75fd6bf96c 100644 --- a/R/position-dodge2.R +++ b/R/position-dodge2.R @@ -134,14 +134,17 @@ pos_dodge2 <- function(df, width, n = NULL, padding = 0.1) { # Find groups of overlapping elements that need to be dodged from one another find_x_overlaps <- function(df) { - overlaps <- numeric(nrow(df)) - overlaps[1] <- counter <- 1 - for (i in seq_asc(2, nrow(df))) { - if (is.na(df$xmin[i]) || is.na(df$xmax[i - 1]) || df$xmin[i] >= df$xmax[i - 1]) { - counter <- counter + 1 - } - overlaps[i] <- counter - } - overlaps + start <- df$xmin + nonzero <- df$xmax != df$xmin + missing <- is.na(df$xmin) | is.na(df$xmax) + + # For end we take largest end seen so far of previous observation + end <- cummax(c(df$xmax[1], df$xmax[-nrow(df)])) + # Start new group when 'start >= end' for non zero-width ranges + # For zero-width ranges, start must be strictly larger than end + overlaps <- cumsum(start > end | (start == end & nonzero)) + # Missing ranges always get separate group + overlaps[missing] <- seq_len(sum(missing)) + max(overlaps, na.rm = TRUE) + match(overlaps, unique0(overlaps)) } From a5aa12ee99c450e6bbf7bb13573b8b761c0a0913 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 7 Jun 2024 15:56:40 +0200 Subject: [PATCH 2/5] add news bullet --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index 583017fc33..1f970c7063 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* Fixed bug in `position_dodge2()`'s identification of range overlaps + (@teunbrand, #5938, #4327). * `position_dodge(preserve = "single")` now handles multi-row geoms better, such as `geom_violin()` (@teunbrand based on @clauswilke's work, #2801). * `position_jitterdodge()` now dodges by `group` (@teunbrand, #3656) From 9ae8a557e675a01893bffcbfa47ecc65ed740b81 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 7 Jun 2024 15:57:59 +0200 Subject: [PATCH 3/5] add test --- tests/testthat/test-position-dodge2.R | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/tests/testthat/test-position-dodge2.R b/tests/testthat/test-position-dodge2.R index d1e54a37fc..5377f14b2d 100644 --- a/tests/testthat/test-position-dodge2.R +++ b/tests/testthat/test-position-dodge2.R @@ -118,3 +118,11 @@ test_that("groups are different when two blocks have externall touching point",{ ) expect_equal(find_x_overlaps(df1), seq_len(2)) }) + +test_that("overlaps are identified correctly", { + df <- data.frame( + xmin = c(1, 2, 3, 5), + xmax = c(4, 3, 4, 6) + ) + expect_equal(find_x_overlaps(df), c(1, 1, 1, 2)) +}) From 4a98ed981eb0146bfc09164eec6b4f89720d9c63 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 7 Jun 2024 16:15:09 +0200 Subject: [PATCH 4/5] deal with `NA`s more properly --- R/position-dodge2.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/position-dodge2.R b/R/position-dodge2.R index 75fd6bf96c..21f8cfe741 100644 --- a/R/position-dodge2.R +++ b/R/position-dodge2.R @@ -138,6 +138,8 @@ find_x_overlaps <- function(df) { start <- df$xmin nonzero <- df$xmax != df$xmin missing <- is.na(df$xmin) | is.na(df$xmax) + start <- vec_fill_missing(start, "downup") + end <- vec_fill_missing(df$xmax, "downup") # For end we take largest end seen so far of previous observation end <- cummax(c(df$xmax[1], df$xmax[-nrow(df)])) From e97e1bdcf396474540de977966e20fdae2cc6ad8 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 7 Jun 2024 16:23:56 +0200 Subject: [PATCH 5/5] pass `end` correctly --- R/position-dodge2.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/position-dodge2.R b/R/position-dodge2.R index 21f8cfe741..1c81ddb47f 100644 --- a/R/position-dodge2.R +++ b/R/position-dodge2.R @@ -142,7 +142,7 @@ find_x_overlaps <- function(df) { end <- vec_fill_missing(df$xmax, "downup") # For end we take largest end seen so far of previous observation - end <- cummax(c(df$xmax[1], df$xmax[-nrow(df)])) + end <- cummax(c(end[1], end[-nrow(df)])) # Start new group when 'start >= end' for non zero-width ranges # For zero-width ranges, start must be strictly larger than end overlaps <- cumsum(start > end | (start == end & nonzero))