1context("Scales: breaks and labels") 2 3test_that("labels match breaks, even when outside limits", { 4 sc <- scale_y_continuous(breaks = 1:4, labels = 1:4, limits = c(1, 3)) 5 6 expect_equal(sc$get_breaks(), c(1:3, NA)) 7 expect_equal(sc$get_labels(), 1:4) 8 expect_equal(sc$get_breaks_minor(), c(1, 1.5, 2, 2.5, 3)) 9}) 10 11test_that("labels match breaks", { 12 expect_error(scale_x_discrete(breaks = 1:3, labels = 1:2), 13 "must have the same length") 14 expect_error(scale_x_continuous(breaks = 1:3, labels = 1:2), 15 "must have the same length") 16}) 17 18test_that("labels don't have to match null breaks", { 19 expect_true(check_breaks_labels(breaks = 1:3, labels = NULL)) 20 expect_true(check_breaks_labels(breaks = NULL, labels = 1:2)) 21}) 22 23test_that("labels don't have extra spaces", { 24 labels <- c("a", "abc", "abcdef") 25 26 sc1 <- scale_x_discrete(limits = labels) 27 sc2 <- scale_fill_discrete(limits = labels) 28 29 expect_equal(sc1$get_labels(), labels) 30 expect_equal(sc2$get_labels(), labels) 31}) 32 33test_that("out-of-range breaks are dropped", { 34 35 # Limits are explicitly specified, automatic labels 36 sc <- scale_x_continuous(breaks = 1:5, limits = c(2, 4)) 37 bi <- sc$break_info() 38 expect_equal(bi$labels, as.character(2:4)) 39 expect_equal(bi$major, c(0, 0.5, 1)) 40 expect_equal(bi$major_source, 2:4) 41 42 # Limits and labels are explicitly specified 43 sc <- scale_x_continuous(breaks = 1:5, labels = letters[1:5], limits = c(2, 4)) 44 bi <- sc$break_info() 45 expect_equal(bi$labels, letters[2:4]) 46 expect_equal(bi$major, c(0, 0.5, 1)) 47 expect_equal(bi$major_source, 2:4) 48 49 # Limits are specified, and all breaks are out of range 50 sc <- scale_x_continuous(breaks = c(1,5), labels = letters[c(1,5)], limits = c(2, 4)) 51 bi <- sc$break_info() 52 expect_equal(length(bi$labels), 0) 53 expect_equal(length(bi$major), 0) 54 expect_equal(length(bi$major_source), 0) 55 56 # limits aren't specified, automatic labels 57 # limits are set by the data 58 sc <- scale_x_continuous(breaks = 1:5) 59 sc$train_df(data_frame(x = 2:4)) 60 bi <- sc$break_info() 61 expect_equal(bi$labels, as.character(2:4)) 62 expect_equal(bi$major_source, 2:4) 63 expect_equal(bi$major, c(0, 0.5, 1)) 64 65 # Limits and labels are specified 66 sc <- scale_x_continuous(breaks = 1:5, labels = letters[1:5]) 67 sc$train_df(data_frame(x = 2:4)) 68 bi <- sc$break_info() 69 expect_equal(bi$labels, letters[2:4]) 70 expect_equal(bi$major_source, 2:4) 71 expect_equal(bi$major, c(0, 0.5, 1)) 72 73 # Limits aren't specified, and all breaks are out of range of data 74 sc <- scale_x_continuous(breaks = c(1,5), labels = letters[c(1,5)]) 75 sc$train_df(data_frame(x = 2:4)) 76 bi <- sc$break_info() 77 expect_equal(length(bi$labels), 0) 78 expect_equal(length(bi$major), 0) 79 expect_equal(length(bi$major_source), 0) 80}) 81 82test_that("no minor breaks when only one break", { 83 sc1 <- scale_x_discrete(limits = "a") 84 sc2 <- scale_x_continuous(limits = 1) 85 86 expect_equal(length(sc1$get_breaks_minor()), 0) 87 expect_equal(length(sc2$get_breaks_minor()), 0) 88}) 89 90init_scale <- function(...) { 91 sc <- scale_x_discrete(...) 92 sc$train(factor(1:100)) 93 expect_equal(length(sc$get_limits()), 100) 94 sc 95} 96 97test_that("discrete labels match breaks", { 98 99 sc <- init_scale(breaks = 0:5 * 10) 100 expect_equal(length(sc$get_breaks()), 5) 101 expect_equal(length(sc$get_labels()), 5) 102 expect_equivalent(sc$get_labels(), sc$get_breaks()) 103 104 sc <- init_scale(breaks = 0:5 * 10, labels = letters[1:6]) 105 expect_equal(length(sc$get_breaks()), 5) 106 expect_equal(length(sc$get_labels()), 5) 107 expect_equal(sc$get_labels(), letters[2:6]) 108 109 sc <- init_scale(breaks = 0:5 * 10, labels = 110 function(x) paste(x, "-", sep = "")) 111 expect_equal(sc$get_labels(), c("10-", "20-", "30-", "40-", "50-")) 112 113 pick_5 <- function(x) sample(x, 5) 114 sc <- init_scale(breaks = pick_5) 115 expect_equal(length(sc$get_breaks()), 5) 116 expect_equal(length(sc$get_labels()), 5) 117}) 118 119test_that("scale breaks work with numeric log transformation", { 120 sc <- scale_x_continuous(limits = c(1, 1e5), trans = log10_trans()) 121 expect_equal(sc$get_breaks(), c(0, 2, 4)) # 1, 100, 10000 122 expect_equal(sc$get_breaks_minor(), c(0, 1, 2, 3, 4, 5)) 123}) 124 125test_that("continuous scales with no data have no breaks or labels", { 126 sc <- scale_x_continuous() 127 128 expect_equal(sc$get_breaks(), numeric()) 129 expect_equal(sc$get_labels(), character()) 130 expect_equal(sc$get_limits(), c(0, 1)) 131}) 132 133test_that("discrete scales with no data have no breaks or labels", { 134 sc <- scale_x_discrete() 135 136 expect_equal(sc$get_breaks(), numeric()) 137 expect_equal(sc$get_labels(), character()) 138 expect_equal(sc$get_limits(), c(0, 1)) 139}) 140 141test_that("passing continuous limits to a discrete scale generates a warning", { 142 expect_warning(scale_x_discrete(limits = 1:3), "Continuous limits supplied to discrete scale") 143}) 144 145test_that("suppressing breaks, minor_breask, and labels works", { 146 expect_equal(scale_x_continuous(breaks = NULL, limits = c(1, 3))$get_breaks(), NULL) 147 expect_equal(scale_x_discrete(breaks = NULL, limits = c("one", "three"))$get_breaks(), NULL) 148 expect_equal(scale_x_continuous(minor_breaks = NULL, limits = c(1, 3))$get_breaks_minor(), NULL) 149 150 expect_equal(scale_x_continuous(labels = NULL, limits = c(1, 3))$get_labels(), NULL) 151 expect_equal(scale_x_discrete(labels = NULL, limits = c("one", "three"))$get_labels(), NULL) 152 153 # date, datetime 154 lims <- as.Date(c("2000/1/1", "2000/2/1")) 155 expect_equal(scale_x_date(breaks = NULL, limits = lims)$get_breaks(), NULL) 156 # NA is defunct, should throw error 157 expect_error(scale_x_date(breaks = NA, limits = lims)$get_breaks()) 158 expect_equal(scale_x_date(labels = NULL, limits = lims)$get_labels(), NULL) 159 expect_error(scale_x_date(labels = NA, limits = lims)$get_labels()) 160 expect_equal(scale_x_date(minor_breaks = NULL, limits = lims)$get_breaks_minor(), NULL) 161 expect_error(scale_x_date(minor_breaks = NA, limits = lims)$get_breaks_minor()) 162 163 # date, datetime 164 lims <- as.POSIXct(c("2000/1/1 0:0:0", "2010/1/1 0:0:0")) 165 expect_equal(scale_x_datetime(breaks = NULL, limits = lims)$get_breaks(), NULL) 166 expect_error(scale_x_datetime(breaks = NA, limits = lims)$get_breaks()) 167 expect_equal(scale_x_datetime(labels = NULL, limits = lims)$get_labels(), NULL) 168 expect_error(scale_x_datetime(labels = NA, limits = lims)$get_labels()) 169 expect_equal(scale_x_datetime(minor_breaks = NULL, limits = lims)$get_breaks_minor(), NULL) 170 expect_error(scale_x_datetime(minor_breaks = NA, limits = lims)$get_breaks_minor()) 171}) 172 173test_that("scale_breaks with explicit NA options (deprecated)", { 174 # NA is defunct, should throw error 175 176 # X 177 sxc <- scale_x_continuous(breaks = NA) 178 sxc$train(1:3) 179 expect_error(sxc$get_breaks()) 180 expect_error(sxc$get_breaks_minor()) 181 182 # Y 183 syc <- scale_y_continuous(breaks = NA) 184 syc$train(1:3) 185 expect_error(syc$get_breaks()) 186 expect_error(syc$get_breaks_minor()) 187 188 # Alpha 189 sac <- scale_alpha_continuous(breaks = NA) 190 sac$train(1:3) 191 expect_error(sac$get_breaks()) 192 193 # Size 194 ssc <- scale_size_continuous(breaks = NA) 195 ssc$train(1:3) 196 expect_error(ssc$get_breaks()) 197 198 # Fill 199 sfc <- scale_fill_continuous(breaks = NA) 200 sfc$train(1:3) 201 expect_error(sfc$get_breaks()) 202 203 # Colour 204 scc <- scale_colour_continuous(breaks = NA) 205 scc$train(1:3) 206 expect_error(scc$get_breaks()) 207}) 208 209test_that("breaks can be specified by names of labels", { 210 labels <- setNames(LETTERS[1:4], letters[1:4]) 211 212 s <- scale_x_discrete(limits = letters[1:4], labels = labels) 213 expect_equal(as.vector(s$get_breaks()), letters[1:4]) 214 expect_equal(as.vector(s$get_labels()), LETTERS[1:4]) 215 216 s <- scale_x_discrete(limits = letters[1:4], labels = rev(labels)) 217 expect_equal(as.vector(s$get_breaks()), letters[1:4]) 218 expect_equal(as.vector(s$get_labels()), LETTERS[1:4]) 219 220 s <- scale_x_discrete(limits = letters[1:4], labels = labels[1:2]) 221 expect_equal(as.vector(s$get_breaks()), letters[1:4]) 222 expect_equal(as.vector(s$get_labels()), c("A", "B", "c", "d")) 223 224 s <- scale_x_discrete(limits = letters[1:4], labels = labels[3:4]) 225 expect_equal(as.vector(s$get_breaks()), letters[1:4]) 226 expect_equal(as.vector(s$get_labels()), c("a", "b", "C", "D")) 227 228 s <- scale_x_discrete(limits = letters[1:3], labels = labels) 229 expect_equal(as.vector(s$get_breaks()), letters[1:3]) 230 expect_equal(as.vector(s$get_labels()), LETTERS[1:3]) 231}) 232 233test_that("only finite or NA values for breaks for transformed scales (#871)", { 234 sc <- scale_y_continuous(limits = c(0.01, 0.99), trans = "probit", 235 breaks = seq(0, 1, 0.2)) 236 breaks <- sc$get_breaks() 237 expect_true(all(is.finite(breaks) | is.na(breaks))) 238}) 239 240test_that("minor breaks are transformed by scales", { 241 sc <- scale_y_continuous(limits = c(1, 100), trans = "log10", 242 minor_breaks = c(1, 10, 100)) 243 244 expect_equal(sc$get_breaks_minor(), c(0, 1, 2)) 245}) 246 247test_that("continuous limits accepts functions", { 248 p <- ggplot(mpg, aes(class, hwy)) + 249 scale_y_continuous(limits = function(lims) (c(lims[1] - 10, lims[2] + 100))) 250 251 expect_equal(layer_scales(p)$y$get_limits(), c(range(mpg$hwy)[1] - 10, range(mpg$hwy)[2] + 100)) 252}) 253 254test_that("equal length breaks and labels can be passed to ViewScales with limits", { 255 256 test_scale <- scale_x_continuous( 257 breaks = c(0, 20, 40), 258 labels = c("0", "20", "40"), 259 limits = c(10, 30) 260 ) 261 262 expect_identical(test_scale$get_breaks(), c(NA, 20, NA)) 263 expect_identical(test_scale$get_labels(), c(c("0", "20", "40"))) 264 265 test_view_scale <- view_scale_primary(test_scale) 266 expect_identical(test_view_scale$get_breaks(), c(NA, 20, NA)) 267 expect_identical(test_view_scale$get_labels(), c(c("0", "20", "40"))) 268 269 # ViewScale accepts the limits in the opposite order (#3952) 270 test_view_scale_rev <- view_scale_primary(test_scale, limits = rev(test_scale$get_limits())) 271 expect_identical(test_view_scale_rev$get_breaks(), c(NA, 20, NA)) 272 expect_identical(test_view_scale_rev$get_labels(), c(c("0", "20", "40"))) 273}) 274 275# Visual tests ------------------------------------------------------------ 276 277test_that("minor breaks draw correctly", { 278 df <- data_frame( 279 x_num = c(1, 3), 280 x_chr = c("a", "b"), 281 x_date = as.Date("2012-2-29") + c(0, 100), 282 x_log = c(1, 1e4), 283 y = c(1, 3) 284 ) 285 theme <- theme_test() + 286 theme( 287 panel.grid.major = element_line(colour = "grey30", size = 0.5), 288 panel.grid.minor = element_line(colour = "grey70") 289 ) 290 291 p <- ggplot(df, aes(x_num, y)) + 292 geom_blank() + 293 scale_x_continuous(breaks = 1:3, minor_breaks = c(1.25, 2.75)) + 294 scale_y_continuous(breaks = 1:3, minor_breaks = c(1.25, 2.75)) + 295 labs(x = NULL, y = NULL) + 296 theme 297 expect_doppelganger("numeric", p) 298 expect_doppelganger("numeric-polar", p + coord_polar()) 299 300 expect_doppelganger("numeric-log", 301 ggplot(df, aes(x_log, x_log)) + 302 scale_x_continuous(trans = log2_trans()) + 303 scale_y_log10() + 304 labs(x = NULL, y = NULL) + 305 theme 306 ) 307 expect_doppelganger("numeric-exp", 308 ggplot(df, aes(x_num, x_num)) + 309 scale_x_continuous(trans = exp_trans(2)) + 310 scale_y_continuous(trans = exp_trans(2)) + 311 labs(x = NULL, y = NULL) + 312 theme 313 ) 314 315 expect_doppelganger("character", 316 ggplot(df, aes(x_chr, y)) + 317 geom_blank() + 318 labs(x = NULL, y = NULL) + 319 theme 320 ) 321 322 expect_doppelganger("date", 323 ggplot(df, aes(x_date, y)) + 324 geom_blank() + 325 scale_x_date( 326 labels = scales::date_format("%m/%d"), 327 breaks = scales::date_breaks("month"), 328 minor_breaks = scales::date_breaks("week") 329 ) + 330 labs(x = NULL, y = NULL) + 331 theme 332 ) 333}) 334 335test_that("scale breaks can be removed", { 336 dat <- data_frame(x = 1:3, y = 1:3) 337 338 expect_doppelganger("no x breaks", 339 ggplot(dat, aes(x = x, y = y)) + geom_point() + scale_x_continuous(breaks = NULL) 340 ) 341 expect_doppelganger("no y breaks", 342 ggplot(dat, aes(x = x, y = y)) + geom_point() + scale_y_continuous(breaks = NULL) 343 ) 344 expect_doppelganger("no alpha breaks (no legend)", 345 ggplot(dat, aes(x = 1, y = y, alpha = x)) + geom_point() + scale_alpha_continuous(breaks = NULL) 346 ) 347 expect_doppelganger("no size breaks (no legend)", 348 ggplot(dat, aes(x = 1, y = y, size = x)) + geom_point() + scale_size_continuous(breaks = NULL) 349 ) 350 expect_doppelganger("no fill breaks (no legend)", 351 ggplot(dat, aes(x = 1, y = y, fill = x)) + geom_point(shape = 21) + scale_fill_continuous(breaks = NULL) 352 ) 353 expect_doppelganger("no colour breaks (no legend)", 354 ggplot(dat, aes(x = 1, y = y, colour = x)) + geom_point() + scale_colour_continuous(breaks = NULL) 355 ) 356}) 357 358test_that("functional limits work for continuous scales", { 359 limiter <- function(by) { 360 function(limits) { 361 low <- floor(limits[1] / by) * by 362 high <- ceiling(limits[2] / by) * by 363 c(low, high) 364 } 365 } 366 367 expect_doppelganger( 368 "functional limits", 369 ggplot(mpg, aes(class)) + geom_bar(aes(fill = drv)) + scale_y_continuous(limits = limiter(50)) 370 ) 371}) 372