diff --git a/.travis.yml b/.travis.yml index 03c5fa2..5882c45 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,3 +1,10 @@ language: r sudo: false cache: packages + +addons: + apt: + sources: + - debian-sid + packages: + - libfreetype6 \ No newline at end of file diff --git a/DESCRIPTION b/DESCRIPTION index 0ae7f3b..5018bb5 100644 --- a/DESCRIPTION +++ b/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", , "daattali@gmail.com", 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 diff --git a/R/ggMarginal.R b/R/ggMarginal.R index 31baa56..ae11900 100644 --- a/R/ggMarginal.R +++ b/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) -} +} \ No newline at end of file diff --git a/R/ggMarginalHelpers.R b/R/ggMarginalHelpers.R index fcd0759..b558165 100644 --- a/R/ggMarginalHelpers.R +++ b/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) } \ No newline at end of file diff --git a/man/print.ggExtraPlot.Rd b/man/print.ggExtraPlot.Rd index cbe81ce..d16a881 100644 --- a/man/print.ggExtraPlot.Rd +++ b/man/print.ggExtraPlot.Rd @@ -4,11 +4,13 @@ \alias{print.ggExtraPlot} \title{Print a ggExtraPlot object} \usage{ -\method{print}{ggExtraPlot}(x, ...) +\method{print}{ggExtraPlot}(x, newpage = grDevices::dev.interactive(), ...) } \arguments{ \item{x}{ggExtraPlot object.} +\item{newpage}{Should a new page (i.e., an empty page) be drawn before the ggExtraPlot is drawn?} + \item{...}{ignored} } \description{ @@ -20,4 +22,3 @@ plots. \code{\link{ggMarginal}} } \keyword{internal} - diff --git a/tests/figs/ggMarginal/ggplot2-2.2.1/basic-boxplot.svg b/tests/figs/ggMarginal/ggplot2-2.2.1/basic-boxplot.svg new file mode 100644 index 0000000..2fe3bf9 --- /dev/null +++ b/tests/figs/ggMarginal/ggplot2-2.2.1/basic-boxplot.svg @@ -0,0 +1,139 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +3.0 +3.5 +4.0 +4.5 +5.0 + + + + + + + + + +2 +3 +4 +5 +wt +drat + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/figs/ggMarginal/ggplot2-2.2.1/basic-density.svg b/tests/figs/ggMarginal/ggplot2-2.2.1/basic-density.svg new file mode 100644 index 0000000..a6170e2 --- /dev/null +++ b/tests/figs/ggMarginal/ggplot2-2.2.1/basic-density.svg @@ -0,0 +1,130 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +3.0 +3.5 +4.0 +4.5 +5.0 + + + + + + + + + +2 +3 +4 +5 +wt +drat + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/figs/ggMarginal/ggplot2-2.2.1/basic-histogram.svg b/tests/figs/ggMarginal/ggplot2-2.2.1/basic-histogram.svg new file mode 100644 index 0000000..01d8eb8 --- /dev/null +++ b/tests/figs/ggMarginal/ggplot2-2.2.1/basic-histogram.svg @@ -0,0 +1,186 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +3.0 +3.5 +4.0 +4.5 +5.0 + + + + + + + + + +2 +3 +4 +5 +wt +drat + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/figs/ggMarginal/ggplot2-2.2.1/both-hists-red-col.svg b/tests/figs/ggMarginal/ggplot2-2.2.1/both-hists-red-col.svg new file mode 100644 index 0000000..b5e235b --- /dev/null +++ b/tests/figs/ggMarginal/ggplot2-2.2.1/both-hists-red-col.svg @@ -0,0 +1,186 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +3.0 +3.5 +4.0 +4.5 +5.0 + + + + + + + + + +2 +3 +4 +5 +wt +drat + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/figs/ggMarginal/ggplot2-2.2.1/legend-and-title.svg b/tests/figs/ggMarginal/ggplot2-2.2.1/legend-and-title.svg new file mode 100644 index 0000000..4853b98 --- /dev/null +++ b/tests/figs/ggMarginal/ggplot2-2.2.1/legend-and-title.svg @@ -0,0 +1,181 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +3.0 +3.5 +4.0 +4.5 +5.0 + + + + + + + + + +2 +3 +4 +5 +wt +drat + + +3.0 +3.5 +4.0 +4.5 +5.0 +gear + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +not a bad subtitle either + + + + + + + + + + +pretty sweet title + + + + + + diff --git a/tests/figs/ggMarginal/ggplot2-2.2.1/only-x-margin.svg b/tests/figs/ggMarginal/ggplot2-2.2.1/only-x-margin.svg new file mode 100644 index 0000000..3e791d0 --- /dev/null +++ b/tests/figs/ggMarginal/ggplot2-2.2.1/only-x-margin.svg @@ -0,0 +1,119 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +3.0 +3.5 +4.0 +4.5 +5.0 + + + + + + + + + +2 +3 +4 +5 +wt +drat + + + + + + + + + + + + diff --git a/tests/figs/ggMarginal/ggplot2-2.2.1/scatter-plot-from-data.svg b/tests/figs/ggMarginal/ggplot2-2.2.1/scatter-plot-from-data.svg new file mode 100644 index 0000000..f1a1e96 --- /dev/null +++ b/tests/figs/ggMarginal/ggplot2-2.2.1/scatter-plot-from-data.svg @@ -0,0 +1,132 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +100 +200 +300 +400 + + + + + + + + + + +10 +15 +20 +25 +30 +35 +mpg +disp + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/figs/ggMarginal/ggplot2-2.2.1/smaller-marginal-plots.svg b/tests/figs/ggMarginal/ggplot2-2.2.1/smaller-marginal-plots.svg new file mode 100644 index 0000000..2ee7bc0 --- /dev/null +++ b/tests/figs/ggMarginal/ggplot2-2.2.1/smaller-marginal-plots.svg @@ -0,0 +1,130 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +3.0 +3.5 +4.0 +4.5 +5.0 + + + + + + + + + +2 +3 +4 +5 +wt +drat + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/figs/ggMarginal/ggplot2-2.2.1/theme-bw.svg b/tests/figs/ggMarginal/ggplot2-2.2.1/theme-bw.svg new file mode 100644 index 0000000..bca5c62 --- /dev/null +++ b/tests/figs/ggMarginal/ggplot2-2.2.1/theme-bw.svg @@ -0,0 +1,131 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +3.0 +3.5 +4.0 +4.5 +5.0 + + + + + + + + + +2 +3 +4 +5 +wt +drat + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/figs/ggMarginal/ggplot2-2.2.1/top-hist-red-col-and-fill.svg b/tests/figs/ggMarginal/ggplot2-2.2.1/top-hist-red-col-and-fill.svg new file mode 100644 index 0000000..fdeda99 --- /dev/null +++ b/tests/figs/ggMarginal/ggplot2-2.2.1/top-hist-red-col-and-fill.svg @@ -0,0 +1,186 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +3.0 +3.5 +4.0 +4.5 +5.0 + + + + + + + + + +2 +3 +4 +5 +wt +drat + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..fcc0f4c --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(ggExtra) + +test_check("ggExtra") \ No newline at end of file diff --git a/tests/testthat/helper-funs.R b/tests/testthat/helper-funs.R new file mode 100644 index 0000000..264d01a --- /dev/null +++ b/tests/testthat/helper-funs.R @@ -0,0 +1,37 @@ +basicScatP <- function() { + ggplot2::ggplot(data = mtcars) + + ggplot2::geom_point(ggplot2::aes(x = wt, y = drat)) +} + +ggMarg2 <- function(type, ...) { + ggMarginal(p = basicScatP(), type = type, ...) +} + +funList <- + list( + "basic density" = function() ggMarg2("density"), + "basic histogram" = function() ggMarg2("histogram"), + "basic boxplot" = function() ggMarg2("boxplot"), + "scatter plot from data" = function() ggMarginal(data = mtcars, x = "mpg", + y = "disp", type = "density"), + "only x margin" = function() ggMarg2("density", margins = "x"), + "smaller marginal plots" = function() ggMarg2("density", size = 10), + "both hists red col" = function() ggMarg2("histogram", colour = "red"), + "top hist red col and fill" = function() ggMarg2("histogram", xparams = + list(colour = "red", + fill = "red")), + "theme bw" = function() ggMarginal(p = basicScatP() + ggplot2::theme_bw(), + type = "density"), + "legend and title" = function() ggMarginal( + ggplot2::ggplot(data = mtcars) + + ggplot2::geom_point(ggplot2::aes(x = wt, y = drat, colour = gear)) + + ggplot2::ggtitle("pretty sweet title", + subtitle = "not a bad subtitle either") + + ggplot2::theme(plot.title = ggplot2::element_text(colour = "red")) + ) + ) + +expectDopp2 <- function(funName, ggplot2Version) { + path <- paste0("ggMarginal/ggplot2-", ggplot2Version) + vdiffr::expect_doppelganger(funName, funList[[funName]](), path = path) +} \ No newline at end of file diff --git a/tests/testthat/render-figs.R b/tests/testthat/render-figs.R new file mode 100644 index 0000000..dc1fc33 --- /dev/null +++ b/tests/testthat/render-figs.R @@ -0,0 +1,43 @@ +library(ggExtra) +library(ggplot2) +library(vdiffr) +library(fontquiver) +library(svglite) + +# Load functions that will be used to create the figures +source("tests/testthat/helper-funs.R") + +# writeSvg saves a plot in an svg file (function taken virtually verbatim from +# vidffr). We need to use write_svg so that our baseline files (i.e., those +# in tests/figs) are rendered in exactly the same way that vdiffr when it runs +# the visual regression tests. +writeSvg <- function(p, file) { + aliases <- font_families("Liberation") + aliases$symbol$symbol <- font_symbol("Symbola") + user_fonts <- aliases + svglite(file = file, user_fonts = user_fonts) + on.exit(grDevices::dev.off()) + print(p) +} + +getFigDir <- function(ggplot2Version) { + ggDir <- paste0("ggplot2-", ggplot2Version) + file.path("tests/figs/ggMarginal", ggDir) +} + +asSvgFile <- function(funName, ggplot2Version = "2.2.1") { + + figDir <- getFigDir(ggplot2Version = ggplot2Version) + + if (!dir.exists(figDir)) { + dir.create(figDir, recursive = TRUE) + } + + fileName <- paste0(gsub(" ", "-", funName), ".svg") + file.path(figDir, fileName) +} + +# Render the figures. Note, you must have ggExtra version >= 0.6.1.9000 +# (commit 4b31c7cf or after) for these figures to render correctly. +sapply(names(funList), function(x) + writeSvg(p = funList[[x]](), file = asSvgFile(funName = x))) \ No newline at end of file diff --git a/tests/testthat/test-ggMarginal.R b/tests/testthat/test-ggMarginal.R new file mode 100644 index 0000000..32117cc --- /dev/null +++ b/tests/testthat/test-ggMarginal.R @@ -0,0 +1,28 @@ +# Wrap up the ggMarginal visual tests in a function runMarginalTests so that +# it's easy to test under multiple versions of ggplot2 +runMarginalTests <- function(ggplot2Version) { + + context <- paste("ggMarginal under ggplot2 version", ggplot2Version) + + context(context) + + test_that("ggMarginal can produce basic marginal plots" , { + sapply(c("basic density", "basic histogram", "basic boxplot", + "scatter plot from data"), function(x) + expectDopp2(funName = x, ggplot2Version = ggplot2Version)) + }) + + test_that("ggMarginal's other params work" , { + sapply(c("only x margin", "smaller marginal plots", "both hists red col", + "top hist red col and fill"), function(x) + expectDopp2(funName = x, ggplot2Version = ggplot2Version)) + }) + + test_that("Misc. issues are solved" , { + sapply(c("theme bw", "legend and title"), function(x) + expectDopp2(funName = x, ggplot2Version = ggplot2Version)) + }) + +} + +runMarginalTests("2.2.1") \ No newline at end of file diff --git a/tests/testthat/test-ggplot2-internals.R b/tests/testthat/test-ggplot2-internals.R new file mode 100644 index 0000000..621f4a3 --- /dev/null +++ b/tests/testthat/test-ggplot2-internals.R @@ -0,0 +1,38 @@ +runggplot2InternalsTests <- function(ggplot2Version) { + + context <- paste("ggplot2 internals under ggplot2 version", ggplot2Version) + + context(context) + + test_that("ggExtra's accession of ggplot2 title grobs works" , { + + titleP <- function(title) { + basicScatP() + title + } + titleList <- list( + noSub = ggplot2::ggtitle("hi"), + sub = ggplot2::ggtitle("there", subtitle = "friend") + ) + + expect_true({ + gTest <- sapply(titleList, function(x) { + length(ggExtra:::getTitleGrobs(titleP(x))) == 2 + }) + all(gTest) + }) + expect_true({ + gTest <- sapply(titleList, function(x) { + !is.null(ggplot2::ggplot_build(titleP(x))$plot$labels$title) + }) + all(gTest) + }) + + expect_true({ + is.null(ggplot2::ggplot_build(titleP(ggplot2::theme()))$plot$labels$title) + }) + + }) + +} + +runggplot2InternalsTests("2.2.1") \ No newline at end of file