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