tests/testthat/test-cookbook-axes.R

In ropensci/plotly: Create Interactive Web Graphics via 'plotly.js'

expect_traces <- function(gg, n.traces, name) {
  stopifnot(is.numeric(n.traces))
  L <- expect_doppelganger_built(gg, paste0("cookbook-axes-", name))
  all.traces <- L$data
  no.data <- sapply(all.traces, function(tr) {
    is.null(tr[["x"]]) && is.null(tr[["y"]])
  })
  has.data <- all.traces[!no.data]
  expect_equivalent(length(has.data), n.traces)
  list(data = has.data, layout = L$layout)
}

bp <- ggplot(PlantGrowth, aes(x = group, y = weight)) +
  geom_boxplot()

# Reverse the order of a discrete-valued axis
# Get the levels of the factor
flevels <- levels(PlantGrowth$group)
# "ctrl" "trt1" "trt2"
# Reverse the order
flevels <- rev(flevels)
# "trt2" "trt1" "ctrl"
bp.flevels <- bp + scale_x_discrete(limits = flevels)

test_that("factor levels determine tick order", {
  info <- expect_traces(bp.flevels, 1, "flevels")
  expect_equivalent(info$layout$xaxis$ticktext, c("trt2", "trt1", "ctrl"))
})

## These two do the same thing; all data points outside the graphing
## range are dropped, resulting in a misleading box plot.
bp.ylim.hide <- bp + ylim(5, 7.5)
test_that("ylim hides points", {
  info <- expect_warning(expect_traces(bp.ylim.hide, 1, "ylim.hide"), 
                         regexp = "non-finite")
})

bp.scale.hide <- bp + scale_y_continuous(limits = c(5, 7.5))
test_that("scale_y(limits) hides points", {
  info <- expect_warning(expect_traces(bp.scale.hide, 1, "scale.hide"), 
                         regexp = "non-finite")
  expect_equivalent(range(info$layout$yaxis$tickvals), c(5, 7.5))
  y <- unlist(lapply(info$data, "[[", "y"))
  expect_true(all(5 <= y & y <= 7.5, na.rm = TRUE))
})

bp.coord <- bp + coord_cartesian(ylim = c(5, 7.5))
test_that("Using coord_cartesian zooms into the area", {
  info <- expect_traces(bp.coord, 1, "coord-ylim")
  expect_equivalent(range(info$layout$yaxis$tickvals), c(5, 7.5))
  y <- unlist(lapply(info$data, "[[", "y"))
  expect_false(all(5 <= y & y <= 7.5))
})

# Create some noisy exponentially-distributed data
dat <- data.frame(
  xval = c(0.26932812,-0.05341404,0.36977717,0.91504712,0.46329006,0.37956526, 0.93290644,0.75558976,0.67633497,0.48655293,0.79478162,0.55109982, 0.51681398,0.81073512,0.49406579,0.93919618,0.90472008,0.98732256, 0.94379876,0.95790909,0.54614241,1.13356941,1.13299144,1.18159277, 1.16428407,1.22955005,1.21030897,1.23314811,1.53822718,1.53674330, 1.80020468,1.40774011,1.74573515,1.26651625,2.06607711,1.50237263, 1.38480531,1.83625381,2.35275649,1.99004291,2.80396442,2.20863240, 2.42998876,2.12801180,2.26290348,2.38185989,2.14936036,2.66587947, 2.64586596,2.44240603,2.39266452,3.11831215,2.70258927,2.65529134, 2.65634690,2.95984290,2.71058076,2.87919480,3.07739358,2.66841935, 3.10792706,3.17134285,3.98070271,3.55497279,3.36831009,3.31390892, 3.32753965,2.86981968,3.22741000,3.78806438,3.74434536,3.56928928, 3.83783177,3.24485807,4.05766233,4.13619455,4.26888054,3.47546258, 3.93045819,3.77620080,4.66676431,3.88059240,4.54694485,4.03915767, 4.25556093,4.39251819,4.42692029,4.23262929,4.44890758,4.84981161, 4.51104252,4.33004508,5.06350705,4.89714069,4.21599077,4.55457578, 5.04044393,4.89111297,5.03105215,4.64113164), 
  yval = c(1.177512e+01,7.303113e+00,6.109053e+00,2.545169e+01,3.366341e+01,1.042255e+01,2.703767e+01,1.178223e+01,4.495965e+01,1.614609e+01,4.003015e+01,1.038442e+02,4.024992e+01,4.163942e+01,9.108197e+01,3.116299e+01,2.558871e+02,7.482977e+01,2.502789e+01,5.923683e+01,3.967814e+01,9.207318e+01,1.298618e+02,1.138197e+02,1.804303e+02,3.363494e+02,3.197204e+02,4.968737e+02,1.783433e+02,4.765546e+02,4.486885e+02,6.736079e+02,4.289288e+02,3.433946e+02,5.658634e+02,4.667053e+02,5.257803e+02,3.401038e+02,6.131335e+02,5.928647e+02,7.838524e+02,7.987915e+02,3.348470e+03,1.704767e+03,1.264169e+03,2.690011e+03,2.738240e+03,1.663862e+03,5.377442e+03,3.883820e+03,6.673624e+03,1.857346e+03,6.683962e+03,1.213027e+03,1.742885e+03,2.146094e+03,4.597174e+03,4.357154e+03,8.413851e+03,8.194194e+03,7.076611e+03,1.554628e+04,6.984783e+03,1.027392e+04,1.158795e+04,9.193111e+03,3.226748e+04,3.955445e+04,2.978953e+04,1.926420e+04,7.610544e+04,2.129694e+04,1.438764e+04,7.908876e+04,2.676003e+04,1.791758e+05,3.978871e+04,9.411120e+04,4.486940e+04,1.270526e+05,1.587331e+05,1.616173e+05,3.351522e+05,3.001782e+05,2.527824e+05,2.745851e+05,3.446376e+05,1.544497e+05,1.318314e+05,8.334336e+05,2.464391e+05,8.694818e+05,2.747323e+05,6.373497e+05,2.918690e+05,9.505114e+05,7.835278e+05,3.775567e+05,1.795523e+06,1.568159e+06)
)

sp <- ggplot(dat, aes(xval, yval)) + geom_point()

test_that("A scatterplot with regular (linear) axis scaling", {
  info <- expect_traces(sp, 1, "linear-axes")
})

library(scales)
sp.log2.scale <- sp + scale_y_continuous(trans = log2_trans())

test_that("log2 scaling of the y axis (with visually-equal spacing)", {
  info <- expect_traces(sp.log2.scale, 1, "log2-scale")
})

sp.log2.coord <- sp + coord_trans(y = "log2")

test_that("log2 coordinate transformation with visually-diminishing spacing", {
  info <- expect_traces(sp.log2.coord, 1, "log2-coord")
})

sp.labels <- sp +
  scale_y_continuous(trans = log2_trans(),
                     breaks = trans_breaks("log2", function(x) 2^x),
                     labels = trans_format("log2", math_format(2^.x)))

test_that("log2 transform with labels", {
  info <- expect_traces(sp.labels, 1, "log2-labels")
})

sp.log10 <- sp + scale_y_log10()

test_that("scale_y_log10", {
  info <- expect_traces(sp.log10, 1, "scale_y_log10")
})

sp.log10.labels <- sp +
  scale_y_log10(breaks = trans_breaks("log10", function(x) 10^x),
                labels = trans_format("log10", math_format(10^.x)))

test_that("log10 with exponents on tick labels", {
  info <- expect_traces(sp.log10.labels, 1, "scale_y_log10-labels")
})

no.x.title <- bp +
  theme(axis.title.x = element_blank()) +   # Remove x-axis label
  ylab("Weight (Kg)")                    # Set y-axis label

test_that("coord_fixed(ratio)", {
  info <- expect_traces(no.x.title, 1, "no-x-title")
  expect_identical(info$layout$xaxis$title$text, "")
})

# Also possible to set the axis label with the scale
# Note that vertical space is still reserved for x"s label

bp.scale.name <- bp + scale_x_discrete(name="") +
  scale_y_continuous(name="Weight (Kg)")

test_that("scale(name)", {
  info <- expect_traces(bp.scale.name, 1, "scale-name")
})

# Change font options:
# X-axis label: bold, red, and 20 points
# X-axis tick marks: rotate 90 degrees CCW, move to the left a bit (using vjust,
#   since the labels are rotated), and 16 points

bp.fonts <- bp +
  theme(
    axis.title.x = element_text(face = "bold", colour = "#990000", size = 20),
    axis.text.x  = element_text(angle = 90, vjust = 0.5, size = 16)
  )

test_that("element_text face, colour, size, angle, vjust, size", {
  info <- expect_traces(bp.fonts, 1, "fonts")
  expect_equivalent(info$layout$xaxis$tickangle, -90)
  expect_match(info$layout$xaxis$title$text, "<b>", fixed = TRUE)
  expect_match(info$layout$xaxis$title$text, "</b>", fixed = TRUE)
})

# Label formatters
library(scales)   # Need the scales package

label.funs <- bp +
  scale_y_continuous(labels = percent) +
  scale_x_discrete(labels = abbreviate)

test_that("In this particular case, x scale has no effect", {
  info <- expect_traces(label.funs, 1, "label-funs")
})

# Self-defined formatting function for times.
timeHMS_formatter <- function(x) {
  h <- floor(x/60)
  m <- floor(x %% 60)
  s <- round(60*(x %% 1))                   # Round to nearest second
  lab <- sprintf("%02d:%02d:%02d", h, m, s) # Format the strings as HH:MM:SS
  lab <- gsub("^00:", "", lab)              # Remove leading 00: if present
  lab <- gsub("^0", "", lab)                # Remove leading 0 if present
}

custom.formatter <- bp + scale_y_continuous(label = timeHMS_formatter)

test_that("custom HMS formatter function", {
  info <- expect_traces(custom.formatter, 1, "custom-formatter")
})

blank.minor.major <- bp +
  theme(panel.grid.minor = element_blank(),
        panel.grid.major = element_blank())

test_that("Hide all the gridlines", {
  info <- expect_traces(blank.minor.major, 1, "blank-minor-major")
})

blank.minor <- bp +
  theme(panel.grid.minor = element_blank())

test_that("Hide just the minor gridlines", {
  info <- expect_traces(blank.minor, 1, "blank-minor")
})

blank.x <- bp +
  theme(panel.grid.minor.x = element_blank(),
        panel.grid.major.x = element_blank())

test_that("Hide all the horizontal gridlines", {
  info <- expect_traces(blank.x, 1, "blank-x")
})

blank.y <- bp +
  theme(panel.grid.minor.y = element_blank(),
        panel.grid.major.y = element_blank())

test_that("Hide all the vertical gridlines", {
  info <- expect_traces(blank.y, 1, "blank-y")
})