R Under development (unstable) (2025-12-16 r89184 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2025 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> message("*** devEval() ...")
*** devEval() ...
> 
> library("R.devices")
R.devices v2.17.3 successfully loaded. See ?R.devices for help.
> library("R.utils")
Loading required package: R.oo
Loading required package: R.methodsS3
R.methodsS3 v1.8.2 (2022-06-13 22:00:14 UTC) successfully loaded. See ?R.methodsS3 for help.
R.oo v1.27.1 (2025-05-02 21:00:05 UTC) successfully loaded. See ?R.oo for help.

Attaching package: 'R.oo'

The following object is masked from 'package:R.methodsS3':

    throw

The following objects are masked from 'package:methods':

    getClasses, getMethods

The following objects are masked from 'package:base':

    attach, detach, load, save

R.utils v2.13.0 (2025-02-24 21:20:02 UTC) successfully loaded. See ?R.utils for help.

Attaching package: 'R.utils'

The following object is masked from 'package:utils':

    timestamp

The following objects are masked from 'package:base':

    cat, commandArgs, getOption, isOpen, nullfile, parse, use, warnings

> graphics.off()
> 
> 
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Various types of single and multiple device outputs
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> message("*** devEval() - single and multiple device outputs ...")
*** devEval() - single and multiple device outputs ...
> 
> types <- list(
+   character(0L),
+   "{png}",
+   "{jpg}",
+   "nulldev",
+   c("{png}", "{png}", "{jpeg}"),
+   "{png},nulldev,pdf"
+ )
> 
> for (type in types) {
+   cat("Device types: ", paste(sQuote(type), collapse=", "), "\n", sep="")
+   devList0 <- devList()
+   res <- devEval(type, name="multi", aspectRatio=2/3, {
+     plot(1:10)
+   })
+   print(res)
+   stopifnot(length(res) == length(unlist(strsplit(type, split=","))))
+   stopifnot(all.equal(devList(), devList0))
+ }
Device types: 
character(0)
Device types: '{png}'
[1] "figures/multi.png"
Device types: '{jpg}'
[1] "figures/multi.jpg"
Device types: 'nulldev'
[1] "NUL"
Device types: '{png}', '{png}', '{jpeg}'
$png
[1] "figures/multi.png"

$png
[1] "figures/multi.png"

$jpeg
[1] "figures/multi.jpg"

Device types: '{png},nulldev,pdf'
$png
[1] "figures/multi.png"

$nulldev
[1] "NUL"

$pdf
[1] "figures/multi.pdf"

> 
> # Sanity checks
> print(devList())
named integer(0)
> stopifnot(length(devList()) == 0L)
> 
> message("*** devEval() - single and multiple device outputs ... DONE")
*** devEval() - single and multiple device outputs ... DONE
> 
> 
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # With 'initially' and 'finally' expression
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> message("*** devEval() - initially and finally ...")
*** devEval() - initially and finally ...
> 
> devList0 <- devList()
> devEval(c("{png}", "{jpg}"), name="count", {
+   plot(1:10)
+   count <- count + 1L
+ }, initially = {
+   # Emulate an overhead
+   cat("Initiate...")
+   count <- 0L
+   Sys.sleep(1)
+   cat("done\n")
+ }, finally = {
+   cat("Number of image files created: ", count, "\n", sep="")
+ })
Initiate...done
Number of image files created: 2
$png
[1] "figures/count.png"

$jpeg
[1] "figures/count.jpg"

> stopifnot(all.equal(devList(), devList0))
> 
> # Sanity checks
> print(devList())
named integer(0)
> stopifnot(length(devList()) == 0L)
> 
> message("*** devEval() - initially and finally ... DONE")
*** devEval() - initially and finally ... DONE
> 
> 
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Try several devices until first successful device is found
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> message("*** devEval() - first successful device ...")
*** devEval() - first successful device ...
> 
> types <- list(
+   "png|jpg|pdf",                 # PNG, JPG, or PDF
+   "dummy|png|jpg|pdf",           # "Non-existing", PNG, JPG, or PDF
+   "quartz|x11|windows",          # Any interactive device (depending on OS)
+   c("{png}|jpg", "x11|windows"), # PNG or JPG and then x11 or windows
+   "eps|postscript|pdf",          # EPS, Postscript or PDF
+   "jpeg2|jpeg",                  # JPEG via bitmap() or via jpeg()
+   "{png},jpg|x11|windows",       # == c("{png}", "jpg|x11|windows")
+   "nulldev|jpeg",                # NULL devices, otherwise jpeg
+   "{png}"                        # Any PNG device
+ )
> 
> if (!capabilitiesX11()) {
+   message("Skipping test for X11")
+   types <- lapply(types, FUN=function(x) gsub("x11|", "", x, fixed=TRUE))
+ }
Skipping test for X11
> 
> devList0 <- devList()
> 
> for (type in types) {
+   printf("Any of %s\n", paste(sQuote(type), collapse=" + "))
+ 
+   # Use try-catch in case not supported on some test systems
+   tryCatch({
+     res <- devEval(type, name="any", aspectRatio=2/3, scale=1.2, {
+       plot(100:1)
+     })
+     printf("Result: %s (%s)\n\n", sQuote(res), attr(res, "type"))
+ 
+     if (length(devList()) > 0) devOff()
+   }, error = function(ex) {
+     printf("Failed: %s\n\n", sQuote(ex$message))
+   })
+ } # for (type ...)
Any of 'png|jpg|pdf'
Result: 'figures/any.png' (png)

Any of 'dummy|png|jpg|pdf'
Result: 'figures/any.png' (png)

Any of 'quartz|windows'
Failed: 'screen devices should not be used in examples etc'

Any of '{png}|jpg' + 'windows'
Failed: 'screen devices should not be used in examples etc'

Any of 'eps|postscript|pdf'
Result: 'figures/any.eps' (eps)

Any of 'jpeg2|jpeg'
Result: 'figures/any.jpg' (jpeg2)

Any of '{png},jpg|windows'
Failed: 'screen devices should not be used in examples etc'

Any of 'nulldev|jpeg'
Result: 'NUL' (nulldev)

Any of '{png}'
Result: 'figures/any.png' (png)

> 
> # Sanity check
> stopifnot(all.equal(devList(), devList0))
> 
> message("*** devEval() - first successful device ... DONE")
*** devEval() - first successful device ... DONE
> 
> 
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Plot a parsed expression
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> message("*** devEval() - parsed expressions ...")
*** devEval() - parsed expressions ...
> 
> expr <- substitute(plot(1:10))
> tryCatch({
+   res <- devEval("png|jpg|pdf", name="any", width=480L, height=480L, {
+     plot(100:1)
+   })
+   printf("Result: %s (%s)\n\n", sQuote(res), attr(res, "type"))
+ 
+   if (length(devList()) > 0) devOff()
+ }, error = function(ex) {
+   printf("Failed: %s\n\n", sQuote(ex$message))
+ })
Result: 'figures/any.png' (png)

> 
> message("*** devEval() - parsed expressions ... DONE")
*** devEval() - parsed expressions ... DONE
> 
> 
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Special cases
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> message("*** toDefault(<expr>) ...")
*** toDefault(<expr>) ...
> 
> # toX11({ plot(1:10) }) actually results in a call to
> # devEval(type="x11", name={ plot(1:10) }); note argument 'name'
> # and not 'expr'.  The following tests that devEval() recognizes
> # and handles this internally.
> 
> ## FIXME: The current solution evaluates 'name' internally
> ## and therefore opens a interactive graphics device.
> if (interactive()) {
+    res <- toDefault({ plot(1:10) })
+    print(res)
+ 
+    ## FIX ME:
+    graphics.off()
+ }
> 
> message("*** toDefault(<expr>) ... DONE")
*** toDefault(<expr>) ... DONE
> 
> 
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Device type specified as a device functions
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> message("*** devEval(<fcn>) ...")
*** devEval(<fcn>) ...
> 
> types <- list(
+   png     = "grDevices::png",
+   jpg     = "grDevices::jpeg",
+   nulldev = "R.devices::nulldev"
+ )
> types <- types[names(types) %in% rownames(devOptions())]
> types <- lapply(types, FUN = function(code) eval(parse(text = code)))
> 
> for (name in names(types)) {
+   cat("Device types: ", paste(sQuote(name), collapse=", "), "\n", sep="")
+   type <- types[[name]]
+   str(args(type))
+   devList0 <- devList()
+   res <- devEval(type, name="multi", tags="function", aspectRatio=2/3, {
+     plot(1:10)
+   })
+   print(res)
+   stopifnot(length(res) == length(type))
+   stopifnot(all.equal(devList(), devList0))
+ }
Device types: 'png'
function (filename = "Rplot%03d.png", width = 480, height = 480, units = "px", 
    pointsize = 12, bg = "white", res = NA, family = "sans", restoreConsole = TRUE, 
    type = c("windows", "cairo", "cairo-png"), antialias = c("default", 
        "none", "cleartype", "gray", "subpixel"), symbolfamily = "default")  
[1] "figures/multi,function.png"
Device types: 'nulldev'
function (file = nullfile(), ...)  
[1] "NUL"
> 
> message("*** devEval(<fcn>) ... DONE")
*** devEval(<fcn>) ... DONE
> 
> 
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> # Special case: Default device
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> message("*** devEval(<default>) ...")
*** devEval(<default>) ...
> 
> cat("Device types: 'default'\n")
Device types: 'default'
> type <- getOption("device")
> str(type)
function (file = if (onefile) "Rplots.pdf" else "Rplot%03d.pdf", width, 
    height, onefile, family, title, fonts, version, paper, encoding, bg, 
    fg, pointsize, pagecentre, colormodel, useDingbats, useKerning, fillOddEven, 
    compress, timestamp, producer, author)  
> devList0 <- devList()
> res <- devEval(type, name="default", aspectRatio=2/3, {
+   plot(1:10)
+ })
> print(res)
[1] "figures/default.pdf"
> wasInteractiveOpened <- (length(setdiff(devList(), devList0)) > 0L)
> if (wasInteractiveOpened) devOff()
> 
> message("*** devEval(<default>) ... DONE")
*** devEval(<default>) ... DONE
> 
> 
> 
> # Sanity checks
> print(devList())
named integer(0)
> stopifnot(length(devList()) == 0L)
> 
> message("*** devEval() ... DONE")
*** devEval() ... DONE
> 
> proc.time()
   user  system elapsed 
   1.62    0.26    3.62