Skip to content

Commit 12da45e

Browse files
teunbrandteunbrand
authored
Merge branch 'main' into ecdf_scale_transform
2 parents fde123f + 9468b69 commit 12da45e

File tree

5 files changed

+113
-47
lines changed

5 files changed

+113
-47
lines changed

‎NEWS.md

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,12 @@
22

33
* Renamed computed aesthetic in `stat_ecdf()` to `ecdf`, to prevent incorrect
44
scale transformations (@teunbrand, #5113 and #5112).
5+
* Fixed misbehaviour of `draw_key_boxplot()` and `draw_key_crossbar()` with
6+
skewed key aspect ratio (@teunbrand, #5082).
7+
* `scale_*_binned()` handles zero-range limits more gracefully (@teunbrand,
8+
#5066)
9+
* Binned scales are now compatible with `trans = "date"` and `trans = "time"`
10+
(@teunbrand, #4217).
511
* `ggsave()` warns when multiple `filename`s are given, and only writes to the
612
first file (@teunbrand, #5114)
713
* Fixed a regression in `geom_hex()` where aesthetics were replicated across
@@ -12,7 +18,7 @@
1218
(@teunbrand based on @clauswilke's suggestion #5051).
1319
* Fixed a regression in `Coord$train_panel_guides()` where names of guides were
1420
dropped (@maxsutton, #5063)
15-
21+
1622
# ggplot2 3.4.0
1723
This is a minor release focusing on tightening up the internals and ironing out
1824
some inconsistencies in the API. The biggest change is the addition of the

‎R/legend-draw.r

Lines changed: 45 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -98,39 +98,58 @@ draw_key_blank <- function(data, params, size) {
9898
#' @export
9999
#' @rdname draw_key
100100
draw_key_boxplot <- function(data, params, size) {
101-
grobTree(
102-
linesGrob(0.5, c(0.1, 0.25)),
103-
linesGrob(0.5, c(0.75, 0.9)),
104-
rectGrob(height = 0.5, width = 0.75),
105-
linesGrob(c(0.125, 0.875), 0.5),
106-
gp = gpar(
107-
col = data$colour %||% "grey20",
108-
fill = alpha(data$fill %||% "white", data$alpha),
109-
lwd = (data$linewidth %||% 0.5) * .pt,
110-
lty = data$linetype %||% 1,
111-
lineend = params$lineend %||% "butt",
112-
linejoin = params$linejoin %||% "mitre"
113-
),
114-
vp = if (isTRUE(params$flipped_aes)) viewport(angle = -90)
101+
gp <- gpar(
102+
col = data$colour %||% "grey20",
103+
fill = alpha(data$fill %||% "white", data$alpha),
104+
lwd = (data$linewidth %||% 0.5) * .pt,
105+
lty = data$linetype %||% 1,
106+
lineend = params$lineend %||% "butt",
107+
linejoin = params$linejoin %||% "mitre"
115108
)
109+
110+
if (isTRUE(params$flipped_aes)) {
111+
grobTree(
112+
linesGrob(c(0.1, 0.25), 0.5),
113+
linesGrob(c(0.75, 0.9), 0.5),
114+
rectGrob(width = 0.5, height = 0.75),
115+
linesGrob(0.5, c(0.125, 0.875)),
116+
gp = gp
117+
)
118+
} else {
119+
grobTree(
120+
linesGrob(0.5, c(0.1, 0.25)),
121+
linesGrob(0.5, c(0.75, 0.9)),
122+
rectGrob(height = 0.5, width = 0.75),
123+
linesGrob(c(0.125, 0.875), 0.5),
124+
gp = gp
125+
)
126+
}
116127
}
117128

118129
#' @export
119130
#' @rdname draw_key
120131
draw_key_crossbar <- function(data, params, size) {
121-
grobTree(
122-
rectGrob(height = 0.5, width = 0.75),
123-
linesGrob(c(0.125, 0.875), 0.5),
124-
gp = gpar(
125-
col = data$colour %||% "grey20",
126-
fill = alpha(data$fill %||% "white", data$alpha),
127-
lwd = (data$linewidth %||% 0.5) * .pt,
128-
lty = data$linetype %||% 1,
129-
lineend = params$lineend %||% "butt",
130-
linejoin = params$linejoin %||% "mitre"
131-
),
132-
vp = if (isTRUE(params$flipped_aes)) viewport(angle = -90)
132+
gp <- gpar(
133+
col = data$colour %||% "grey20",
134+
fill = alpha(data$fill %||% "white", data$alpha),
135+
lwd = (data$linewidth %||% 0.5) * .pt,
136+
lty = data$linetype %||% 1,
137+
lineend = params$lineend %||% "butt",
138+
linejoin = params$linejoin %||% "mitre"
133139
)
140+
if (isTRUE(params$flipped_aes)) {
141+
grobTree(
142+
rectGrob(height = 0.75, width = 0.5),
143+
linesGrob(0.5, c(0.125, 0.875)),
144+
gp = gp
145+
)
146+
} else {
147+
grobTree(
148+
rectGrob(height = 0.5, width = 0.75),
149+
linesGrob(c(0.125, 0.875), 0.5),
150+
gp = gp
151+
)
152+
}
134153
}
135154

136155
#' @export

‎R/scale-.r

Lines changed: 17 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1021,16 +1021,22 @@ ScaleBinned <- ggproto("ScaleBinned", Scale,
10211021
x <- self$rescale(self$oob(x, range = limits), limits)
10221022
breaks <- self$rescale(breaks, limits)
10231023

1024-
x_binned <- cut(x, breaks,
1025-
labels = FALSE,
1026-
include.lowest = TRUE,
1027-
right = self$right
1028-
)
1024+
if (length(breaks) > 1) {
1025+
x_binned <- cut(x, breaks,
1026+
labels = FALSE,
1027+
include.lowest = TRUE,
1028+
right = self$right
1029+
)
1030+
midpoints <- breaks[-1] - diff(breaks) / 2
1031+
} else {
1032+
x_binned <- 1L
1033+
midpoints <- 0.5
1034+
}
10291035

10301036
if (!is.null(self$palette.cache)) {
10311037
pal <- self$palette.cache
10321038
} else {
1033-
pal <- self$palette(breaks[-1] - diff(breaks) / 2)
1039+
pal <- self$palette(midpoints)
10341040
self$palette.cache <- pal
10351041
}
10361042

@@ -1075,10 +1081,13 @@ ScaleBinned <- ggproto("ScaleBinned", Scale,
10751081
# Ensure terminal bins are same width if limits not set
10761082
if (is.null(self$limits)) {
10771083
# Remove calculated breaks if they coincide with limits
1078-
breaks <- setdiff(breaks, limits)
1084+
breaks <- breaks[!breaks %in% limits]
10791085
nbreaks <- length(breaks)
10801086
if (nbreaks >= 2) {
1081-
new_limits <- c(2 * breaks[1] - breaks[2], 2 * breaks[nbreaks] - breaks[nbreaks - 1])
1087+
new_limits <- c(
1088+
breaks[1] + (breaks[1] - breaks[2]),
1089+
breaks[nbreaks] + (breaks[nbreaks] - breaks[nbreaks - 1])
1090+
)
10821091
if (breaks[nbreaks] > limits[2]) {
10831092
new_limits[2] <- breaks[nbreaks]
10841093
breaks <- breaks[-nbreaks]

‎tests/testthat/_snaps/draw-key/horizontal-boxplot-and-crossbar.svg

Lines changed: 8 additions & 12 deletions
Loading

‎tests/testthat/test-scale-binned.R

Lines changed: 36 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,3 +4,39 @@ test_that("binned scales only support continuous data", {
44
p <- ggplot(mtcars) + geom_point(aes(disp, mpg, colour = as.character(gear))) + scale_color_binned()
55
expect_snapshot_error(ggplot_build(p))
66
})
7+
8+
test_that('binned scales can calculate breaks on dates', {
9+
10+
data <- seq(as.Date("2000-01-01"), as.Date("2020-01-01"), length.out = 100)
11+
12+
scale <- scale_x_binned(trans = "date")
13+
scale$train(scale$transform(data))
14+
breaks <- scale$trans$inverse(scale$get_breaks())
15+
16+
expect_s3_class(breaks, "Date")
17+
expect_equal(
18+
unname(breaks),
19+
as.Date(paste0(seq(2002, 2018, by = 2), "-01-01"))
20+
)
21+
})
22+
23+
test_that('binned scales can calculate breaks on date-times', {
24+
data <- seq(
25+
strptime("2000-01-01", "%Y-%m-%d"),
26+
strptime("2020-01-01", "%Y-%m-%d"),
27+
length.out = 100
28+
)
29+
30+
scale <- scale_x_binned(trans = "time")
31+
scale$train(scale$transform(data))
32+
breaks <- scale$trans$inverse(scale$get_breaks())
33+
34+
expect_s3_class(breaks, "POSIXct")
35+
expect_equal(
36+
unname(unclass(breaks)),
37+
unclass(as.POSIXct(strptime(
38+
paste0(seq(2002, 2018, by = 2), "-01-01"),
39+
"%Y-%m-%d"
40+
)))
41+
)
42+
})

0 commit comments

Comments
 (0)