Merge pull request #172 from ropensci/toby-cookbook

Toby cookbook-axes

Author: Toby Dylan Hocking

R/ggplotly.R

@@ -165,7 +165,10 @@ gg2list <- function(p){
         names(ranks) <- br
         misc$breaks[[a.vec]] <- ranks
       }
-      misc$trans[sc$aesthetics] <- sc$trans$name
+      ## store if this is a reverse scale so we can undo that later.
+      if(is.character(sc$trans$name)){
+        misc$trans[sc$aesthetics] <- sc$trans$name
+      }
     }
     reverse.aes <- names(misc$trans)[misc$trans=="reverse"]
 
@@ -271,6 +274,12 @@ gg2list <- function(p){
   trace.name.map <- c()
   for(xy in c("x","y")){
     ax.list <- list()
+    coord.lim <- p$coord$limits[[xy]]
+    if(is.numeric(coord.lim)){
+      ## TODO: maybe test for more exotic coord specification types
+      ## involving NA, Inf, etc?
+      ax.list$range <- coord.lim
+    }
     s <- function(tmp)sprintf(tmp, xy)
     ax.list$tickcolor <- toRGB(theme.pars$axis.ticks$colour)
 
@@ -335,8 +344,13 @@ gg2list <- function(p){
       sc <- p$scales$scales[[scale.i]]
       if(ax.list$type == "category"){
         trace.order.list[[xy]] <- sc$limits
+        if(is.character(sc$breaks)){
+          if(is.character(sc$labels)){
+            trace.name.map[sc$breaks] <- sc$labels
+          }
+          ##TODO: if(is.function(sc$labels)){
+        }
       }
-      trace.name.map[sc$breaks] <- sc$labels
       if (is.null(sc$breaks)) {
         ax.list$showticklabels <- FALSE
         ax.list$showgrid <- FALSE

tests/testthat/test-cookbook-axes.R

@@ -0,0 +1,219 @@
+context("cookbook axes")
+
+bp <- ggplot(PlantGrowth, aes(x=group, y=weight)) +
+  geom_boxplot()
+
+expect_traces <- function(gg, n.traces, name){
+  stopifnot(is.ggplot(gg))
+  stopifnot(is.numeric(n.traces))
+  save_outputs(gg, paste0("cookbook-axes-", name))
+  L <- gg2list(gg)
+  is.trace <- names(L) == ""
+  all.traces <- L[is.trace]
+  no.data <- sapply(all.traces, function(tr) {
+    is.null(tr[["x"]]) && is.null(tr[["y"]])
+  })
+  has.data <- all.traces[!no.data]
+  expect_equal(length(has.data), n.traces)
+  list(traces=has.data, kwargs=L$kwargs)
+}
+
+# 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, 3, "flevels")
+  trace.names <- sapply(info$traces, "[[", "name")
+  expect_identical(as.character(trace.names),
+                   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_traces(bp.ylim.hide, 3, "ylim.hide")
+})
+
+bp.scale.hide <- bp + scale_y_continuous(limits=c(5, 7.5))
+test_that("scale_y(limits) hides points", {
+  info <- expect_traces(bp.scale.hide, 3, "scale.hide")
+  expect_equal(info$kwargs$layout$yaxis$range, c(5, 7.5))
+})
+  
+bp.coord <- bp + coord_cartesian(ylim=c(5, 7.5))
+test_that("Using coord_cartesian zooms into the area", {
+  info <- expect_traces(bp.coord, 3, "coord-ylim")
+  expect_equal(info$kwargs$layout$yaxis$range, c(5, 7.5))
+})
+
+# Create some noisy exponentially-distributed data
+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)
+
+dat <- data.frame(xval = xval, yval = yval)
+
+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)     # Need the scales package
+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(ytrans="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")
+})
+
+# Data where x ranges from 0-10, y ranges from 0-30
+set.seed(202)
+dat <- data.frame(xval = runif(40,0,10), yval = runif(40,0,30))
+sp <- ggplot(dat, aes(xval, yval)) + geom_point()
+
+sp.fixed <- sp + coord_fixed()
+
+test_that("Force equal scaling", {
+  info <- expect_traces(sp.fixed, 1, "coord-fixed")
+})
+
+sp.ratio <- sp + coord_fixed(ratio=1/3)
+
+test_that("coord_fixed(ratio)", {
+  info <- expect_traces(sp.ratio, 1, "coord-fixed-ratio")
+})
+
+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, 3, "no-x-title")
+})
+
+# 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, 3, "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, 3, "fonts")
+  x <- info$kwargs$layout$xaxis
+  xtitle <- x[["titlefont"]]
+  xtick <- x[["tickfont"]]
+  expect_identical(xtitle$color, toRGB("#990000"))
+  expect_equal(xtitle$size, 20)
+  ## TODO: does plotly support bold text?
+  expect_equal(x$tickangle, -90)
+  ## TODO: can we test for vjust?
+  expect_equal(xtick$size, 16)
+})
+
+# 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, 3, "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, 3, "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, 3, "blank-minor-major")
+})
+
+blank.minor <- bp +
+  theme(panel.grid.minor=element_blank())
+
+test_that("Hide just the minor gridlines", {
+  info <- expect_traces(blank.minor, 3, "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, 3, "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, 3, "blank-y")
+})
+