diff --git a/NEWS.md b/NEWS.md index 8bd2b58702..c91420661f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,15 @@ * `guide_colourbar()` and `guide_coloursteps()` gain an `alpha` argument to set the transparency of the bar (#5085). + +* `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). + +* 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 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/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-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)) }) 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)) +})