14
14
# ' @param axis.arrow A call to `arrow()` to specify arrows at the end of the
15
15
# ' axis line, thus showing an open interval.
16
16
# ' @param show.limits Logical. Should the limits of the scale be shown with
17
- # ' labels and ticks.
17
+ # ' labels and ticks. Default is `NULL` meaning it will take the value from the
18
+ # ' scale. This argument is ignored if `labels` is given as a vector of
19
+ # ' values. If one or both of the limits is also given in `breaks` it will be
20
+ # ' shown irrespective of the value of `show.limits`.
18
21
# '
19
22
# ' @section Use with discrete scale:
20
23
# ' This guide is intended to show binned data and work together with ggplot2's
@@ -137,15 +140,25 @@ guide_train.bins <- function(guide, scale, aesthetic = NULL) {
137
140
if (length(breaks ) == 0 || all(is.na(breaks ))) {
138
141
return ()
139
142
}
143
+ show_limits <- guide $ show.limits %|| % scale $ show.limits %|| % FALSE
144
+ if (show_limits && (is.character(scale $ labels ) || is.numeric(scale $ labels ))) {
145
+ cli :: cli_warn(c(
146
+ " {.arg show.limits} is ignored when {.arg labels} are given as a character vector" ,
147
+ " i" = " Either add the limits to {.arg breaks} or provide a function for {.arg labels}"
148
+ ))
149
+ show_limits <- FALSE
150
+ }
140
151
# in the key data frame, use either the aesthetic provided as
141
152
# argument to this function or, as a fall back, the first in the vector
142
153
# of possible aesthetics handled by the scale
143
154
aes_column_name <- aesthetic %|| % scale $ aesthetics [1 ]
144
155
145
156
if (is.numeric(breaks )) {
146
157
limits <- scale $ get_limits()
147
- breaks <- breaks [! breaks %in% limits ]
148
- all_breaks <- c(limits [1 ], breaks , limits [2 ])
158
+ if (! is.numeric(scale $ breaks )) {
159
+ breaks <- breaks [! breaks %in% limits ]
160
+ }
161
+ all_breaks <- unique(c(limits [1 ], breaks , limits [2 ]))
149
162
bin_at <- all_breaks [- 1 ] - diff(all_breaks ) / 2
150
163
} else {
151
164
# If the breaks are not numeric it is used with a discrete scale. We check
@@ -162,10 +175,29 @@ guide_train.bins <- function(guide, scale, aesthetic = NULL) {
162
175
))
163
176
}
164
177
all_breaks <- breaks [c(1 , seq_along(bin_at ) * 2 )]
178
+ limits <- all_breaks [c(1 , length(all_breaks ))]
179
+ breaks <- all_breaks [- c(1 , length(all_breaks ))]
165
180
}
166
181
key <- new_data_frame(setNames(list (c(scale $ map(bin_at ), NA )), aes_column_name ))
167
- key $ .label <- scale $ get_labels(all_breaks )
168
- guide $ show.limits <- guide $ show.limits %|| % scale $ show_limits %|| % FALSE
182
+ labels <- scale $ get_labels(breaks )
183
+ show_limits <- rep(show_limits , 2 )
184
+ if (is.character(scale $ labels ) || is.numeric(scale $ labels )) {
185
+ limit_lab <- c(NA , NA )
186
+ } else {
187
+ limit_lab <- scale $ get_labels(limits )
188
+ }
189
+ if (! breaks [1 ] %in% limits ) {
190
+ labels <- c(limit_lab [1 ], labels )
191
+ } else {
192
+ show_limits [1 ] <- TRUE
193
+ }
194
+ if (! breaks [length(breaks )] %in% limits ) {
195
+ labels <- c(labels , limit_lab [2 ])
196
+ } else {
197
+ show_limits [2 ] <- TRUE
198
+ }
199
+ key $ .label <- labels
200
+ guide $ show.limits <- show_limits
169
201
170
202
if (guide $ reverse ) {
171
203
key <- key [rev(seq_len(nrow(key ))), ]
@@ -245,9 +277,7 @@ guide_geom.bins <- function(guide, layers, default_mapping) {
245
277
246
278
# ' @export
247
279
guide_gengrob.bins <- function (guide , theme ) {
248
- if (! guide $ show.limits ) {
249
- guide $ key $ .label [c(1 , nrow(guide $ key ))] <- NA
250
- }
280
+ guide $ key $ .label [c(1 , nrow(guide $ key ))[! guide $ show.limits ]] <- NA
251
281
252
282
# default setting
253
283
if (guide $ direction == " horizontal" ) {
@@ -332,9 +362,7 @@ guide_gengrob.bins <- function(guide, theme) {
332
362
)
333
363
ggname(" guide.label" , g )
334
364
})
335
- if (! guide $ show.limits ) {
336
- grob.labels [c(1 , length(grob.labels ))] <- list (zeroGrob())
337
- }
365
+ grob.labels [c(1 , length(grob.labels ))[! guide $ show.limits ]] <- list (zeroGrob())
338
366
}
339
367
340
368
label_widths <- width_cm(grob.labels )
@@ -514,9 +542,8 @@ guide_gengrob.bins <- function(guide, theme) {
514
542
)
515
543
}
516
544
grob.ticks <- rep_len(list (grob.ticks ), length(grob.labels ))
517
- if (! guide $ show.limits ) {
518
- grob.ticks [c(1 , length(grob.ticks ))] <- list (zeroGrob())
519
- }
545
+ grob.ticks [c(1 , length(grob.ticks ))[! guide $ show.limits ]] <- list (zeroGrob())
546
+
520
547
# Create the gtable for the legend
521
548
gt <- gtable(widths = unit(widths , " cm" ), heights = unit(heights , " cm" ))
522
549
gt <- gtable_add_grob(
0 commit comments