Add unit tests to ggExtra (#47)

* Add newpage argument to print.ggExtraPlot so there isn't a leading empty page when using non-interactive devices

* Use ggTitle grob instead of text grob for the plot title (closes #46)

* Add code to render baseline test figures as well as the svg files

* Add visual regression tests for ggMarginal under ggplot2 version 2.2.1 (closes #41)

* Add unit tests for ggplot2 internals (title accession only)

* Fix extraction of title/subtitle to account for there being two title grobs (title and sub).

* Alter test of figure title to account for subtitle and add new svg.

* Refactor render-figs.R

* Add function braces

* Add fontquiver and svglite to suggests

* Add line breaks to comment

* format code

.travis.yml

@@ -1,3 +1,10 @@
 language: r
 sudo: false
 cache: packages
+
+addons:
+  apt:
+    sources:
+      - debian-sid
+    packages:
+      - libfreetype6

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ggExtra
 Title: Add Marginal Histograms to 'ggplot2', and More 'ggplot2' Enhancements
-Version: 0.6.1
+Version: 0.6.1.9000
 Authors@R: c(
     person("Dean", "Attali", , "[email protected]", role = c("aut", "cre"))
     )
@@ -20,13 +20,18 @@ Imports:
     miniUI (>= 0.1.1),
     shiny (>= 0.13.0),
     shinyjs (>= 0.5.2),
-    utils
+    utils,
+    grDevices
 Suggests:
     knitr (>= 1.7),
     rmarkdown,
-    rstudioapi (>= 0.5)
+    rstudioapi (>= 0.5),
+    testthat,
+    vdiffr,
+    fontquiver,
+    svglite
 License: MIT + file LICENSE
 SystemRequirements: pandoc with https support
 LazyData: true
 VignetteBuilder: knitr
-RoxygenNote: 5.0.1
+RoxygenNote: 6.0.1

R/ggMarginal.R

@@ -79,7 +79,7 @@
 ggMarginal <- function(p, data, x, y, type = c("density", "histogram", "boxplot"),
                        margins = c("both", "x", "y"), size = 5,
                        ..., xparams, yparams) {
-
+  
   # figure out all the default parameters
   type <- match.arg(type)
   margins <- match.arg(margins)
@@ -108,7 +108,7 @@ ggMarginal <- function(p, data, x, y, type = c("density", "histogram", "boxplot"
   } else {
     yparams <- as.list(yparams)
   }
-
+  
   # Try to infer values for parameters that are missing from the input scatterplot
   if (missing(p)) {
     if (missing(data) || missing(x) || missing(y)) {
@@ -150,19 +150,17 @@ ggMarginal <- function(p, data, x, y, type = c("density", "histogram", "boxplot"
   # Remove all margin around plot so that it's easier to position the
   # density plots beside the main plot
   p <- p + ggplot2::theme(plot.margin = grid::unit(c(0, 0, 0, 0), "null"))
-
+  
   # Decompose the original ggplot2 object to grab all sorts of information from it
   pb <- ggplot2::ggplot_build(p)
 
   # Pull out the plot title if one exists and save it as a grob for later use.
+  # Note: You can't have a subtitle without a title in ggplot2
   hasTitle <- (!is.null(pb$plot$labels$title))
   if (hasTitle) {
-    title <- grid::textGrob(
-      pb$plot$labels$title,
-      gp = grid::gpar(col = pb$plot$theme$plot.title$colour,
-                      fontsize = 16, fontface = pb$plot$theme$plot.title$face)
-    )
+    titleGrobs <- getTitleGrobs(p = p)
     p$labels$title <- NULL
+    p$labels$subtitle <- NULL
   }
 
   # Create the horizontal margin plot
@@ -184,7 +182,7 @@ ggMarginal <- function(p, data, x, y, type = c("density", "histogram", "boxplot"
     top <- top +
       ggplot2::ylab(p$labels$y) +
       getScale(margin = "x", type = type, pb = pb)
-
+    
     # Add the longest y axis label to the top plot and ensure it's at a y value
     # that is on the plot (this is why I build the top plot, to know the y values)
     pbTop <- ggplot2::ggplot_build(top)
@@ -217,32 +215,29 @@ ggMarginal <- function(p, data, x, y, type = c("density", "histogram", "boxplot"
   pGrob <- ggplot2::ggplotGrob(p)
   suppressMessages({
   if (margins == "both") {
-    ggxtra_tmp <- addTopMargPlot(ggMargGrob = pGrob, top = top, 
-                                 size = size)
-    ggxtra_nottl <- addRightMargPlot(ggMargGrob = ggxtra_tmp, right = right, 
-                                     size = size)
+    ggxtraTmp <- addTopMargPlot(ggMargGrob = pGrob, top = top, 
+                                size = size)
+    ggxtraNoTtl <- addRightMargPlot(ggMargGrob = ggxtraTmp, right = right, 
+                                    size = size)
   } else if (margins == "x") {
-    ggxtra_tmp <- gtable::gtable_add_padding(x = pGrob, 
-                                             grid::unit(c(0, 0.5, 0, 0), "lines"))
-    ggxtra_nottl <- addTopMargPlot(ggMargGrob = ggxtra_tmp, top = top, 
-                                   size = size)
+    ggxtraTmp <- gtable::gtable_add_padding(x = pGrob, 
+                                            grid::unit(c(0, 0.5, 0, 0), "lines"))
+    ggxtraNoTtl <- addTopMargPlot(ggMargGrob = ggxtraTmp, top = top, 
+                                  size = size)
   } else if (margins == "y") {
-    ggxtra_tmp <- gtable::gtable_add_padding(x = pGrob, 
-                                             grid::unit(c(0.5, 0, 0, 0), "lines"))
-    ggxtra_nottl <- addRightMargPlot(ggMargGrob = ggxtra_tmp, right = right,
+    ggxtraTmp <- gtable::gtable_add_padding(x = pGrob, 
+                                            grid::unit(c(0.5, 0, 0, 0), "lines"))
+    ggxtraNoTtl <- addRightMargPlot(ggMargGrob = ggxtraTmp, right = right,
                                      size = size)
   }
   })
-  # Add the title to the resulting ggExtra plot
+
+  # Add the title to the resulting ggExtra plot if it exists
   if (hasTitle) {
-      titleH <- grid::grobHeight(title)
-      gt_t <- gtable::gtable_add_rows(x = ggxtra_nottl, heights = titleH, pos = 0)
-      max(gt_t$layout$r) -> maxR
-      ggExtraPlot <- gtable::gtable_add_grob(x = gt_t, grobs = title, t = 1, b = 1,
-                                  l = 1, r = maxR, z = Inf, clip = "on",
-                                  name = "plotTitle")
+    ggExtraPlot <- addTitleGrobs(ggxtraNoTtl = ggxtraNoTtl, 
+                                 titleGrobs = titleGrobs)
   } else {
-     ggExtraPlot <- ggxtra_nottl
+     ggExtraPlot <- ggxtraNoTtl
   }
 
   # Aadd a class for S3 method dispatch for printing the ggExtra plot
@@ -257,11 +252,12 @@ ggMarginal <- function(p, data, x, y, type = c("density", "histogram", "boxplot"
 #' plots.
 #' 
 #' @param x ggExtraPlot object.
+#' @param newpage Should a new page (i.e., an empty page) be drawn before the ggExtraPlot is drawn?
 #' @param ... ignored
 #' @seealso \code{\link{ggMarginal}}
 #' @export
 #' @keywords internal
-print.ggExtraPlot <- function(x, ...) {
-  grid::grid.newpage()
+print.ggExtraPlot <- function(x, newpage = grDevices::dev.interactive(), ...) {
+  if (newpage) grid::grid.newpage()
   grid::grid.draw(x)
-}
+}

R/ggMarginalHelpers.R

@@ -245,4 +245,50 @@ addRightMargPlot <- function(ggMargGrob, right, size) {
                                 b = panelPos[["b"]], r = ncol(gt), l = ncol(gt),
                                 z = Inf, clip = "on", name = "rightMargPlot")
   gt
+}
+
+# Pull out the title and subtitle grobs for a plot, after we have checked to 
+# make sure there is a title. Note: plot.title and plot.subtitle will actually
+# always exist (I believe) in recent versions of ggplot2, even if the user 
+# doesn't specify a title/subtitle. In these cases, the title/subtitle grobs
+# will be "zeroGrobs." However, a 'label' won't exist 
+# (i.e, !is.null(pb$plot$labels$title) will be true) when there is no title,
+# so it's not like we will be needlessly adding zeroGrobs to our plot (though
+# it wouldn't be a problem, even if we did add the zeroGrobs - it would just take 
+# a little longer.
+getTitleGrobs <- function(p) {
+  grobs <- ggplot2::ggplotGrob(p)$grobs
+  gindTitle <- sapply(grobs, function(x) {
+    grepl(pattern = "plot\\.title", x$name)
+  })
+  gindSub <- sapply(grobs, function(x) {
+    grepl(pattern = "plot\\.subtitle", x$name)
+  })
+  list(
+    titleG = grobs[gindTitle][[1]],
+    subTitleG = grobs[gindSub][[1]]
+  )
+}
+
+# Helper function for addTitleGrobs
+rbindGrobs <- function(topGrob, gtable, l, r) {
+  topH <- grid::grobHeight(topGrob)
+  gt_t <- gtable::gtable_add_rows(x = gtable, heights = topH, pos = 0)
+  gtable::gtable_add_grob(x = gt_t, grobs = topGrob, t = 1, b = 1,
+                          l = l, r = r, z = Inf)
+}
+
+# Add the title/subtitle grobs to the main ggextra plot, along with a little 
+# padding
+addTitleGrobs <- function(ggxtraNoTtl, titleGrobs) {
+  layout <- ggxtraNoTtl$layout
+  l <- layout[layout$name == "panel", "l"]
+  spacerGrob <- grid::rectGrob(height = grid::unit(.2, "cm"), 
+                               gp = grid::gpar(col = "white", fill = NULL))
+  plotWSpace <- rbindGrobs(topGrob = spacerGrob, gtable = ggxtraNoTtl,
+                           l = l, r = l)
+  plotWSubTitle <- rbindGrobs(topGrob = titleGrobs$subTitleG, 
+                              gtable = plotWSpace, l = l, r = l)
+  rbindGrobs(topGrob = titleGrobs$titleG,
+             gtable = plotWSubTitle, l = l, r = l)
 }