1library(testit) 2 3op = options(device = function(file = NULL, ...) { 4 pdf(file, ...) 5 dev.control('enable') # important! otherwise plots get discarded 6}) 7 8evaluate = evaluate::evaluate 9classes = evaluate:::classes 10 11# remove the blank plot 12assert('blank plots are removed', { 13 res = evaluate('layout(t(1:2))') 14 (identical(classes(res), 'source')) 15}) 16 17assert('plots generated by par(), palette() or layout() are removed', { 18 res = evaluate('par(mfrow = c(1, 2))\npie(islands)\nbarplot(islands)') 19 (identical(classes(res), rep(c('source', 'recordedplot'), c(3, 1)))) 20 res = evaluate('layout(t(1:2))\npie(islands)\nbarplot(islands)') 21 (identical(classes(res), rep(c('source', 'recordedplot'), c(3, 1)))) 22 res = evaluate('pie(islands)\nbarplot(islands)\npar(mfrow = c(1, 2))') 23 res = merge_low_plot(res) 24 (identical(classes(res), rep(c('source', 'recordedplot'), length = 5))) 25 res = evaluate('pie(islands)\npar(cex.main=1.2)\nbarplot(islands)') 26 res = merge_low_plot(res) 27 (identical(classes(res), c('source', 'recordedplot')[c(1, 2, 1, 1, 2)])) 28 res = evaluate('par(cex.main=1.2)\npalette(c("red","black"))\nbarplot(islands)') 29 (identical(classes(res), rep(c('source', 'recordedplot'), c(3, 1)))) 30}) 31 32assert('merge low-level changes', { 33 res = evaluate('plot(1)\npoints(1.1, 1.1)') 34 (classes(res) %==% rep(c('source', 'recordedplot'), 2)) 35 (classes(merge_low_plot(res)) %==% rep(c('source', 'recordedplot'), c(2, 1))) 36}) 37 38assert('captures grid graphics', { 39 res = evaluate('library(grid) 40 grid.newpage() 41 grid.rect(gp=gpar(fill="grey")) 42 grid.rect(gp=gpar(fill="red"))') 43 (classes(res) %==% c('source', 'recordedplot')[c(1, 1, 1, 2, 1, 2)]) 44 res = merge_low_plot(res) 45 (identical(classes(res), rep(c('source', 'recordedplot'), c(4, 1)))) 46}) 47 48options(op) 49 50# rmarkdown sets dev.args = list(pdf = list(useDingbats = FALSE)) when dev = 'pdf' 51if (!has_error({png(); dev.off()})) { 52 assert('chunk_device() correctly opens the png device with dev.args', { 53 chunk_device(opts_chunk$merge(list( 54 dev = 'png', dev.args = list(pdf = list(useDingbats = FALSE)) 55 ))) 56 plot(1:10) 57 dev.off() 58 TRUE 59 }) 60} 61 62if (requireNamespace("ragg", quietly = TRUE) && 63 !has_error({ragg::agg_png(); dev.off()})) { 64 assert( 65 'chunk_device() correctly opens the ragg::agg_png device with dev.args', 66 { 67 chunk_device(opts_chunk$merge(list( 68 dev = 'ragg_png', dev.args = list(pdf = list(useDingbats = FALSE)) 69 ))) 70 plot(1:10) 71 dev.off() 72 TRUE 73 } 74 ) 75 assert( 76 'ragg_png_dev correctly handles bg dev.arg into background arg', 77 { 78 chunk_device(opts_chunk$merge(list( 79 dev = 'ragg_png', dev.args = list(bg = "grey") 80 ))) 81 plot(1:10) 82 dev.off() 83 TRUE 84 } 85 ) 86} 87 88# should not error (find `pdf` correctly in grDevices, instead of the one 89# defined below) 90pdf = function() {} 91do.call(pdf_null, list(7, 7)) 92dev.off() 93 94 95gen_source = function(x) structure(x, class = 'source') 96gen_plotrc = function(x) structure(factor(x), class = c('factor', 'recordedplot')) 97 98assert('fig_before_code() moves plots before code blocks', { 99 res = list( 100 gen_source(1), gen_plotrc('a'), gen_plotrc('b'), gen_source(2), gen_source(3), 101 gen_plotrc('c'), gen_source(4), gen_plotrc('d') 102 ) 103 (fig_before_code(res) %==% res[c(2, 3, 1, 4, 6, 5, 8, 7)]) 104}) 105 106assert('plots are rearrange based on fig.keep & fig.show options', { 107 res = list(gen_source(1), gen_source(2)) 108 (rearrange_figs(res, 'high', NULL, 'asis') %==% res) 109 # only one plot to keep 110 res = c(evaluate('plot(1)'), list(gen_source(1))) 111 (rearrange_figs(res, 'high', NULL, 'asis') %==% res) 112 (rearrange_figs(res, 'all', NULL, 'asis') %==% res) 113 (rearrange_figs(res, 'last', NULL, 'asis') %==% res) 114 (rearrange_figs(res, 'first', NULL, 'asis') %==% res) 115 (rearrange_figs(res, 'index', 2, 'asis') %==% res) 116 # several plots 117 res = c(list(gen_source(1)), evaluate('plot(1)\npoints(1.1, 1.1)'), 118 list(gen_plotrc('b'), gen_source(2))) 119 (rearrange_figs(res, 'high', NULL, 'asis') %==% res[-3]) 120 (rearrange_figs(res, 'all', NULL, 'asis') %==% res) 121 (rearrange_figs(res, 'all', NULL, 'hold') %==% res[c(1:2, 4, 7, 3, 5, 6)]) 122 (rearrange_figs(res, 'last', NULL, 'asis') %==% res[c(-3, -5)]) 123 (rearrange_figs(res, 'first', NULL, 'asis') %==% res[c(-5, -6)]) 124 (rearrange_figs(res, 'none', NULL, 'asis') %==% res[c(-3, -5, -6)]) 125 # correspond to options$fig.keep with numeric vector 126 (rearrange_figs(res, 'index', 1, 'asis') %==% res[c(-5, -6)]) 127 (rearrange_figs(res, 'index', c(2, 3), 'asis') %==% res[c(-3)]) 128 (rearrange_figs(res, 'index', c(2, 3), 'hold') %==% res[c(1:2, 4, 7, 5, 6)]) 129 (rearrange_figs(res, 'index', c(1, 2, 3), 'asis') %==% res) 130}) 131 132# should not error when a plot label contains special characters and sanitize=TRUE 133if (xfun::loadable('tikzDevice') && 134 (!is.na(Sys.getenv('CI', NA)) || Sys.getenv('USER') == 'yihui' || !xfun::is_macos())) { 135 knit('knit-tikzDevice.Rnw', quiet = TRUE) 136 unlink(c('*-tikzDictionary', 'figure', 'knit-tikzDevice.tex'), recursive = TRUE) 137} 138 139# https://github.com/yihui/knitr/issues/1166 140knit(text = "\\Sexpr{include_graphics('myfigure.pdf', error = FALSE)}", quiet = TRUE) 141 142with_par = function(expr, ...) { 143 # set par 144 op = graphics::par(...) 145 # reset on exit 146 on.exit(graphics::par(op)) 147 # save changed state 148 global.pars = par(no.readonly = TRUE) 149 # reset par 150 graphics::par(op) 151 # simulate what happens when global.par = TRUE by restoring pars 152 par2(global.pars) 153 # evaluate in this state 154 force(expr) 155} 156 157assert("par2 correctly handles specific pars", { 158 (par2(NULL) %==% NULL) 159 # correctly changed 160 (with_par(par("col") %==% "red", col = "red")) 161 (with_par(par("cex") %==% 2, cex = 2)) 162 # unchanged 163 old = par("fig") 164 (with_par(par("fig") %==% old, fig = old / 2)) 165 old = par("fin") 166 (with_par(par("fin") %==% old, fin = old / 2)) 167 old = par("pin") 168 (with_par(par("pin") %==% old, pin = old / 2)) 169 old = par("usr") 170 (with_par(par("usr") %==% old, usr = old / 2)) 171 old = par("ask") 172 (with_par(par("ask") %==% old, ask = !old)) 173 # Does not work - something else is changing plt when setting everything 174 # old = par("plt") 175 # (with_par(par("plt") %==% old, plt = old / 2)) 176}) 177