test_graphs <- list( list( short_name = "hello_TeX", description = "Draw a circle and some simple text", tags = c("base", "text"), graph_code = quote({ plot(1, axes = F, xlab = "", ylab = "") text(1, 1.1, "Hello TeX") }) ), list( short_name = "graph_box", description = "Draw a box around a graph", tags = c("base"), graph_code = quote({ plot(1, type = "n", axes = F) box() }) ), list( short_name = "text_color", description = "Draw colorized text", tags = c("base", "text"), graph_code = quote({ plot(1, type = "n") text(0.8, 0.8, "red", col = "red") text(1.2, 1.2, "blue", col = rgb(0, 0, 1, 0.5), cex = 2) }) ), list( short_name = "plot_legend", description = "Draw a legend box", tags = c("base"), graph_code = quote({ plot(1, 1, xlim = c(0, 10), ylim = c(0, 10)) legend(x = "top", title = "Legend Test", legend = c("Hello, world!"), inset = 0.05) legend(6, 4, title = "Another Legend Test", legend = c("Test 1", "Test 2"), pch = c(1, 16)) }) ), list( short_name = "pch_caracters", description = "Draw common plotting characters", tags = c("base"), graph_code = quote({ # Magic stuff taken from example(points) n <- floor(sqrt(26)) npchIndex <- 0:(25) ix <- npchIndex %/% n iy <- 3 + (n - 1) - npchIndex %% n rx <- c(-1, 1) / 2 + range(ix) ry <- c(-1, 1) / 2 + range(iy) # Set up plot area plot(rx, ry, type = "n", axes = F, xlab = "", ylab = "", sub = "Standard R plotting characters") # Plot characters. for (i in 1:26) { points(ix[i], iy[i], pch = i - 1) # Place text label so we know which character is being plotted. text(ix[i] - 0.3, iy[i], i - 1) } }) ), list( short_name = "draw_circles", description = "Draw circles", tags = c("base"), graph_code = quote({ plot(-2:2, -2:2, type = "n", axes = F, xlab = "", ylab = "") points(rnorm(10), rnorm(10), col = "red") points(rnorm(10) / 2, rnorm(10) / 2, col = "blue") }) ), list( short_name = "draw_filled_circles", description = "Draw filled circles", tags = c("base"), graph_code = quote({ plot(-2:2, -2:2, type = "n", axes = F, xlab = "", ylab = "") points(rnorm(10), rnorm(10), pch = 21, col = "blue", bg = "forestgreen") }) ), list( short_name = "line_color", description = "Draw colored lines", tags = c("base"), graph_code = quote({ plot( c(0, 1), c(0, 1), type = "l", axes = F, xlab = "", ylab = "", col = "red3" ) }) ), list( short_name = "line_color_width", description = "Draw colored lines with changed line width", tags = c("base"), graph_options = list( tikzLwdUnit = 72.27 / 96 ), graph_code = quote({ plot( c(0, 1), c(0, 1), type = "l", axes = F, xlab = "", ylab = "", col = "red3" ) }) ), list( short_name = "character_expansion", description = "Test character expansion", tags = c("base"), graph_code = quote({ plot(1, axes = F, xlab = "", ylab = "", cex = 10) points(1, cex = .5) }) ), list( short_name = "filled_rectangle", description = "Test filled rectangles", tags = c("base"), graph_code = quote({ plot(-2:2, -2:2, type = "n", axes = F, xlab = "", ylab = "") points(rnorm(10), rnorm(10), pch = 22, col = "red", bg = "gold") }) ), list( short_name = "line_types", description = "Test line types", tags = c("base"), graph_code = quote({ plot( 0, type = "n", xlim = c(0, 1), ylim = c(0, 6), axes = F, xlab = "", ylab = "" ) for (i in 0:6) lines(c(0, 1), c(i, i), lty = i) }) ), list( short_name = "line_weights", description = "Test line weights", tags = c("base"), graph_code = quote({ plot( 0, type = "n", xlim = c(0, 1), ylim = c(0, 6), axes = F, xlab = "", ylab = "" ) for (i in 0:6) lines(c(0, 1), c(i, i), lwd = i) }) ), list( short_name = "transparency", description = "Test transparency", tags = c("base"), graph_code = quote({ plot(-2:2, -2:2, type = "n", axes = F, xlab = "", ylab = "") points(rnorm(50), rnorm(50), pch = 21, bg = rainbow(50, alpha = .5), cex = 10) }) ), list( short_name = "lots_of_elements", description = "Test of many points for file size", tags = c("base"), graph_code = quote({ plot(-2:2, -2:2, type = "n", axes = F, xlab = "", ylab = "") points(rnorm(500), rnorm(500), pch = 21, bg = rainbow(50, alpha = .5), cex = 10) }) ), list( short_name = "contour_lines", description = "Test contour lines and associated text", tags = c("base", "text"), graph_code = quote({ x <- -6:16 op <- par(mfrow = c(2, 2)) contour(outer(x, x), method = "edge") z <- outer(x, sqrt(abs(x)), FUN = "/") image(x, x, z) contour(x, x, z, col = "pink", add = TRUE, method = "edge") contour(x, x, z, ylim = c(1, 6), method = "simple", labcex = 1) contour(x, x, z, ylim = c(-6, 6), nlev = 20, lty = 2, method = "simple") par(op) }) ), list( short_name = "string_placement", description = "Test string placement and TeX symbol generation", tags = c("base", "text"), graph_code = quote({ syms <- c( "alpha", "theta", "tau", "beta", "vartheta", "pi", "upsilon", "gamma", "gamma", "varpi", "phi", "delta", "kappa", "rho", "varphi", "epsilon", "lambda", "varrho", "chi", "varepsilon", "mu", "sigma", "psi", "zeta", "nu", "varsigma", "omega", "eta", "xi", "Gamma", "Lambda", "Sigma", "Psi", "Delta", "Xi", "Upsilon", "Omega", "Theta", "Pi", "Phi" ) x <- rnorm(length(syms)) y <- rnorm(length(syms)) plot(-2:2, -2:2, type = "n", axes = F, xlab = "", ylab = "") points(x, y, pch = 21, bg = "black", cex = .5) text(x, y, paste("\\Large$\\", syms, "$", sep = "")) }) ), list( short_name = "text_alignment", description = "Test text alignment", tags = c("base", "text"), graph_code = quote({ plot(1, 1, type = "n", xlab = "", ylab = "", axes = F) abline(v = 1) # left justified par(adj = 0) text(1, 1.1, "Left") # Center Justified par(adj = 0.5) text(1, 1, "Center") # Right Justified par(adj = 1) text(1, 0.9, "Right") }) ), list( short_name = "persp_3D", description = "Test of 3D graphs with persp", tags = c("base", "3D"), graph_code = quote({ x <- seq(-1.95, 1.95, length = 30) y <- seq(-1.95, 1.95, length = 35) z <- outer(x, y, function(a, b) { a * b ^ 2 }) nrz <- nrow(z) ncz <- ncol(z) jet.colors <- colorRampPalette(c("blue", "green")) nbcol <- 100 color <- jet.colors(nbcol) zfacet <- z[-1, -1] + z[-1, -ncz] + z[-nrz, -1] + z[-nrz, -ncz] facetcol <- cut(zfacet, nbcol) persp(x, y, z, col = color[facetcol], phi = 30, theta = -30, ticktype = "detailed") }) ), list( short_name = "base_annotation", description = "Annotation of base graphics", tags = c("base", "annotation"), graph_options = list( tikzLatexPackages = c( getOption("tikzLatexPackages"), "\\usetikzlibrary{decorations.pathreplacing}", "\\usetikzlibrary{positioning}", "\\usetikzlibrary{shapes.arrows,shapes.symbols}" ) ), fuzz = 130, graph_code = quote({ p <- rgamma(300, 1) outliers <- which(p > quantile(p, .75) + 1.5 * IQR(p)) boxplot(p) # Add named coordinates that other TikZ commands can hook onto tikzCoord(1, min(p[outliers]), "min outlier") tikzCoord(1, max(p[outliers]), "max outlier") # Use tikzAnnotate to insert arbitrary code, such as drawing a fancy path # between min outlier and max outlier. tikzAnnotate(c( "\\draw[very thick,red,", # Turn the path into a brace. "decorate,decoration={brace,amplitude=12pt},", # Shift it 1em to the left of the coordinates "transform canvas={xshift=-1em}]", "(min outlier) --", # Add a node with some text in the middle of the path "node[single arrow,anchor=tip,fill=white,draw=green,", "left=14pt,text width=0.70in,align=center]", "{Holy Outliers Batman!}", "(max outlier);" )) # tikzNode can be used to place nodes with customized options and content tikzNode( opts = "starburst,fill=green,draw=blue,very thick,right=of max outlier", content = "Wow!" ) }) ), list( short_name = "grid_annotation", description = "Annotation of grid graphics", tags = c("grid", "annotation"), graph_options = list( tikzLatexPackages = c( getOption("tikzLatexPackages"), "\\usetikzlibrary{shapes.callouts}" ) ), fuzz = 745, graph_code = quote({ library(grid) pushViewport(plotViewport()) pushViewport(dataViewport(1:10, 1:10)) grid.rect() grid.xaxis() grid.yaxis() grid.points(1:10, 1:10) for (i in seq(2, 8, 2)) { grid.tikzNode(i, i, opts = "ellipse callout,draw,anchor=pointer", content = i) } }) ), list( short_name = "annotation_noflush", description = "Annotation prior to any graphics output", tags = c("base", "annotation"), graph_code = quote({ plot.new() plot.window(0:1, 0:1) tikzCoord(0, 0, name = "ll") tikzCoord(1, 1, name = "ur") tikzAnnotate("\\draw (ll) rectangle (ur);") }) ), list( short_name = "ggplot2_test", description = "Test of ggplot2 graphics", tags = c("ggplot2"), graph_code = quote({ print(ggplot2::qplot( carat, price, data = ggplot2::diamonds, geom = "smooth", colour = color )) }) ), list( short_name = "ggplot2_superscripts", description = "Test of grid text alignment with ggplot2", tags = c("ggplot2", "text"), graph_code = quote({ soilSample <- structure( list( `Grain Diameter` = c(8, 5.6, 4, 2.8, 2, 1, 0.5, 0.355, 0.25), `Percent Finer` = c( 0.951603145795523, 0.945553539019964, 0.907239362774753, 0.86771526517443, 0.812865497076023, 0.642064932446058, 0.460375075620085, 0.227465214761041, 0.0389191369227667 ) ), .Names = c("Grain Diameter", "Percent Finer"), row.names = c(NA, 9L), class = "data.frame" ) # R 2.12.x and 2.13.x have to test with ggplot2 v0.8.9 which is very # different from 0.9.0. # # FIXME: Remove this once we drop support for 2.13.x if (exists("scale_y_probit")) { # We are using a ggplot2 version that is earlier than 0.9.0 testPlot <- ggplot2::qplot(`Grain Diameter`, `Percent Finer`, data = soilSample) + ggplot2::scale_x_log10() + ggplot2::scale_y_probit() + ggplot2::theme_bw() } else { testPlot <- ggplot2::qplot(log10(`Grain Diameter`), `Percent Finer`, data = soilSample) + ggplot2::scale_x_continuous(labels = scales::math_format(10 ^ .x)) + ggplot2::scale_y_continuous(trans = "probit", breaks = seq(0.2, 0.8, 0.2)) + ggplot2::theme_bw() } print(testPlot) }) ), list( short_name = "polypath", description = "Test polypath support", tags = c("base", "polypath"), graph_code = quote({ # From example(polypath) plotPath <- function(x, y, col="grey", rule="winding") { plot.new() plot.window(range(x, na.rm = TRUE), range(y, na.rm = TRUE)) polypath(x, y, col = col, rule = rule) if (!is.na(col)) { mtext(paste("Rule:", rule), side = 1, line = 0) } } plotRules <- function(x, y, title) { plotPath(x, y) plotPath(x, y, rule = "evenodd") mtext(title, side = 3, line = 0) plotPath(x, y, col = NA) } op <- par(mfrow = c(5, 3), mar = c(2, 1, 1, 1)) plotRules( c(.1, .1, .9, .9, NA, .2, .2, .8, .8), c(.1, .9, .9, .1, NA, .2, .8, .8, .2), title = "Nested rectangles, both clockwise" ) plotRules( x = c(.1, .1, .9, .9, NA, .2, .8, .8, .2), y = c(.1, .9, .9, .1, NA, .2, .2, .8, .8), title = "Nested rectangles, outer clockwise, inner anti-clockwise" ) plotRules( x = c(.1, .1, .4, .4, NA, .6, .9, .9, .6), y = c(.1, .4, .4, .1, NA, .6, .6, .9, .9), title = "Disjoint rectangles" ) plotRules( x = c(.1, .1, .6, .6, NA, .4, .4, .9, .9), y = c(.1, .6, .6, .1, NA, .4, .9, .9, .4), title = "Overlapping rectangles, both clockwise" ) plotRules( x = c(.1, .1, .6, .6, NA, .4, .9, .9, .4), y = c(.1, .6, .6, .1, NA, .4, .4, .9, .9), title = "Overlapping rectangles, one clockwise, other anti-clockwise" ) par(op) }) ), list( short_name = "base_raster", description = "Test raster support in base graphics", tags = c("base", "raster", "reflection"), fuzz = 642, graph_code = quote({ plot(c(100, 250), c(300, 450), type = "n", xlab = "", ylab = "") image <- as.raster(matrix(rep(c(rep(0:1, 4), rep(1:0, 4)), each = 3), ncol = 6, nrow = 4)) rasterImage(image, 100, 300, 150, 350, interpolate = FALSE) rasterImage(image, 100, 400, 150, 450) rasterImage( image, 200, 300, 200 + xinch(.5), 300 + yinch(.3), interpolate = FALSE ) rasterImage( image, 200, 400, 250, 450, angle = 15, interpolate = FALSE ) rasterImage( image, 175 + xinch(.5), 350, 175, 350 + yinch(.3), angle = -30, interpolate = FALSE ) rasterImage( image, 200 + xinch(.5), 350 + yinch(.3), 200, 350, angle = -45, interpolate = FALSE ) rasterImage( image, 225, 350 + yinch(.3), 225 + xinch(.5), 350, angle = -60, interpolate = FALSE ) }) ), list( short_name = "raster_reflection", description = "Test raster handling in graphics with reflected axes", tags = c("base", "raster", "reflection"), graph_code = quote({ par(mfrow = c(2, 2)) image(volcano, useRaster = TRUE) image(volcano, xlim = c(1, 0), useRaster = TRUE) image(volcano, ylim = c(1, 0), useRaster = TRUE) image(volcano, xlim = c(1, 0), ylim = c(1, 0), useRaster = TRUE) }) ), list( short_name = "grid_raster", description = "Test raster support in grid graphics", tags = c("grid", "raster"), graph_code = quote({ suppressPackageStartupMessages(library(grid)) suppressPackageStartupMessages(library(lattice)) plt <- levelplot( volcano, panel = panel.levelplot.raster, col.regions = topo.colors, cuts = 30, interpolate = TRUE ) print(plt) }) ), list( short_name = "base_raster_noresample", description = "Test noresampling raster support in base graphics", tags = c("base", "raster"), fuzz = 1400, graph_code = quote({ plot.new() suppressWarnings(rasterImage(as.raster(matrix(seq(0, 1, len = 9), 3)), 0, 0, 1, 1, interpolate = TRUE)) }) ), list( short_name = "base_symbolic_simple", description = "Test symbolic colors for a simple image", tags = c("base", "symbolic"), graph_options = list( tikzSymbolicColors = TRUE, tikzMaxSymbolicColors = 3 ), graph_code = quote({ plot.new() points(0, 0) points(0, 1, col = "red") suppressWarnings(points(1, 1, col = "green")) points(1, 0, col = "gray50") points(0.5, 0.5, col = "#F3346A") }) ), # New pdfLaTeX tests go here # list( # short_name = 'something_suitable_as_a_filename', # description = 'Longer description of what the test does', # tags = c('plot', 'tags'), # graph_options = list(optional stuff to pass to options() during this test) # graph_code = quote({ # # }) # ) ### XeLaTeX Tests list( short_name = "utf8_characters", description = "Test of UTF8 characters", tags = c("base", "xetex", "utf8"), engine = "xetex", graph_code = quote({ n <- 8 data <- expand.grid(x = 1:n, y = 1:n) data$chars <- intToUtf8(seq.int(187, by = 1, length.out = n * n), multiple = T) p <- ggplot2::ggplot(data, ggplot2::aes(x = x, y = y)) + ggplot2::geom_text(ggplot2::aes(label = chars)) print(p) }) ), list( short_name = "xetex_variants", description = "Test of XeLaTeX font variants", tags = c("xetex", "utf8"), engine = "xetex", # Only OS X is likely to have the required fonts installed skip_if = function() { Sys.info()["sysname"] != "Darwin" }, graph_options = list( tikzXelatexPackages = c( "\\usepackage{fontspec}", "\\usepackage[colorlinks, breaklinks, pdftitle={The Beauty of LaTeX},pdfauthor={Taraborelli, Dario}]{hyperref}", "\\usepackage{tikz}", "\\usepackage{color}", "\\definecolor{Gray}{rgb}{.7,.7,.7}", "\\definecolor{lightblue}{rgb}{.2,.5,1}", "\\definecolor{myred}{rgb}{1,0,0}", "\\newcommand{\\red}[1]{\\color{myred} #1}", "\\newcommand{\\reda}[1]{\\color{myred}\\fontspec[Variant=2]{Zapfino}#1}", "\\newcommand{\\redb}[1]{\\color{myred}\\fontspec[Variant=3]{Zapfino}#1}", "\\newcommand{\\redc}[1]{\\color{myred}\\fontspec[Variant=4]{Zapfino}#1}", "\\newcommand{\\redd}[1]{\\color{myred}\\fontspec[Variant=5]{Zapfino}#1}", "\\newcommand{\\rede}[1]{\\color{myred}\\fontspec[Variant=6]{Zapfino}#1}", "\\newcommand{\\redf}[1]{\\color{myred}\\fontspec[Variant=7]{Zapfino}#1}", "\\newcommand{\\redg}[1]{\\color{myred}\\fontspec[Variant=8]{Zapfino}#1}", "\\newcommand{\\lbl}[1]{\\color{lightblue} #1}", "\\newcommand{\\lbla}[1]{\\color{lightblue}\\fontspec[Variant=2]{Zapfino}#1}", "\\newcommand{\\lblb}[1]{\\color{lightblue}\\fontspec[Variant=3]{Zapfino}#1}", "\\newcommand{\\lblc}[1]{\\color{lightblue}\\fontspec[Variant=4]{Zapfino}#1}", "\\newcommand{\\lbld}[1]{\\color{lightblue}\\fontspec[Variant=5]{Zapfino}#1}", "\\newcommand{\\lble}[1]{\\color{lightblue}\\fontspec[Variant=6]{Zapfino}#1}", "\\newcommand{\\lblf}[1]{\\color{lightblue}\\fontspec[Variant=7]{Zapfino}#1}", "\\newcommand{\\lblg}[1]{\\color{lightblue}\\fontspec[Variant=8]{Zapfino}#1}", "\\newcommand{\\old}[1]{", "\\fontspec[Ligatures={Common, Rare},Variant=1,Swashes={LineInitial, LineFinal}]{Zapfino}", "\\fontsize{25pt}{30pt}\\selectfont #1}%", "\\newcommand{\\smallprint}[1]{\\fontspec{Hoefler Text}\\fontsize{10pt}{13pt}\\color{Gray}\\selectfont #1}%\n", "\\usepackage[active,tightpage,xetex]{preview}", "\\PreviewEnvironment{pgfpicture}", "\\setlength\\PreviewBorder{0pt}" ) ), graph_code = quote({ label <- c( "\\noindent{\\red d}roo{\\lbl g}", "\\noindent{\\reda d}roo{\\lbla g}", "\\noindent{\\redb d}roo{\\lblb g}", "\\noindent{\\redf d}roo{\\lblf g}\\\\[.3cm]", "\\noindent{\\redc d}roo{\\lblc g}", "\\noindent{\\redd d}roo{\\lbld g}", "\\noindent{\\rede d}roo{\\lble g}", "\\noindent{\\redg d}roo{\\lblg g}\\\\[.2cm]" ) title <- c( "\\smallprint{D. Taraborelli (2008), \\href{http://nitens.org/taraborelli/latex}{The Beauty of \\LaTeX}}", "\\smallprint{\\\\\\emph{Some rights reserved}. \\href{http://creativecommons.org/licenses/by-sa/3.0/}{\\textsc{cc-by-sa}}}" ) lim <- 0:(length(label) + 1) plot(lim, lim, cex = 0, pch = ".", xlab = title[2], ylab = "", main = title[1]) for (i in 1:length(label)) text(i, i, label[i]) }) ), ### LuaLaTeX Tests list( short_name = "luatex_utf8_characters", description = "Test of UTF8 characters w/ LuaTeX", tags = c("base", "luatex", "utf8"), engine = "luatex", # Travis CI runs Ubuntu Precise with a fontspec package that doesn't accept # LuaLaTeX yet skip_if = function() { Sys.getenv("TRAVIS") != "" }, graph_code = quote({ n <- 8 data <- expand.grid(x = 1:n, y = 1:n) data$chars <- intToUtf8(seq.int(187, by = 1, length.out = n * n), multiple = T) p <- ggplot2::ggplot(data, ggplot2::aes(x = x, y = y)) + ggplot2::geom_text(ggplot2::aes(label = chars)) print(p) }) ), # New UTF8/XeLaTeX/LuaLatex tests go here # list( # short_name = 'something_suitable_as_a_filename', # description = 'Longer description of what the test does', # tags = c('plot', 'tags'), # uses_xetex = TRUE, # graph_options = list(optional stuff to pass to options() during this test) # graph_code = quote({ # # }) # ) NULL ) test_graphs <- test_graphs[!vapply(test_graphs, is.null, logical(1L))] if (length(tags_to_run)) { test_graphs <- Filter( function(graph) { any(graph$tags %in% tags_to_run) }, test_graphs ) } run_test <- function(graph) { do.call(do_graphics_test, graph) } graphs_produced <- Filter(run_test, test_graphs) context("Graph test cleanup") test_that("All graphics devices closed", { expect_that(length(dev.list()), equals(0)) }) message("\nFinished generating TikZ test graphs.") message("PDF files are in:\n\t", test_output_dir) message("\nTeX sources and log files are in:\n\t", test_work_dir) if (!is.null(gs_cmd)) { # Combine all test PDFs into one big file for easy viewing graph_files <- Map(function(graph) { file.path(test_output_dir, paste0(graph$short_name, ".pdf")) }, graphs_produced) test_output <- file.path(test_output_dir, "test_results.pdf") silence <- system( paste( shQuote(gs_cmd), "-dNOPAUSE", "-sDEVICE=pdfwrite", paste0("-sOUTPUTFILE=", test_output), "-dBATCH", paste(shQuote(graph_files), collapse = " ") ), intern = TRUE, ignore.stderr = TRUE ) message("\nAll test outputs combined into:\n\t", test_output) } if (!is.null(compare_cmd) && !is.null(convert_cmd)) { # Combine all visual diffs into one big PDF file for easy viewing graph_files <- Map(function(graph) { file.path(test_work_dir, paste0(graph$short_name, "_diff.png")) }, graphs_produced) diff_output <- file.path(test_output_dir, "test_diffs.pdf") silence <- system( paste( shQuote(convert_cmd), paste(shQuote(graph_files), collapse = " "), diff_output ), intern = TRUE, ignore.stderr = TRUE ) message("\nResults of all visual diffs combined into:\n\t", diff_output) }