From 0a30e0401a19ab064fab0d6fd3f3eec5cf48a897 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 12 Jul 2023 20:51:02 +0200 Subject: [PATCH 01/17] backport isTRUE --- R/backports.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/backports.R b/R/backports.R index 7dea54cd3a..e67403e989 100644 --- a/R/backports.R +++ b/R/backports.R @@ -17,7 +17,8 @@ if (getRversion() < 3.3) { on_load(backport_unit_methods()) -# isFALSE() is available on R (>=3.5) +# isFALSE() and isTRUE() are available on R (>=3.5) if (getRversion() < 3.5) { isFALSE <- function(x) is.logical(x) && length(x) == 1L && !is.na(x) && !x + isTRUE <- function(x) is.logical(x) && length(x) == 1L && !is.na(x) && x } From 56de161f1bd1ad533fb4456a4b11cec962ca464d Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Thu, 13 Jul 2023 21:26:38 +0200 Subject: [PATCH 02/17] Implement `check_device()` --- R/utilities-checks.R | 294 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 294 insertions(+) diff --git a/R/utilities-checks.R b/R/utilities-checks.R index 5f5ee1231c..47c3861e14 100644 --- a/R/utilities-checks.R +++ b/R/utilities-checks.R @@ -68,3 +68,297 @@ check_inherits <- function(x, call = call ) } + +#' Check graphics device capabilities +#' +#' This function makes an attempt to estimate whether the graphics device is +#' able to render newer graphics features. +#' +#' @param feature A string naming a graphics device feature. One of: +#' `"clippingPaths"`, `"alpha_masks"`, `"lumi_masks"`, `"compositing"`, +#' `"blending"`, `"transformations"`, `"gradients"`, `"patterns"`, `"paths"` +#' or `"glyphs"`. See the 'Features' section below for an explanation +#' of these terms. +#' @param action A string for what action to take. One of: +#' * `"test"` returns `TRUE` or `FALSE` indicating support of the feature. +#' * `"warn"` also returns a logical, but throws an informative warning when +#' `FALSE`. +#' * `"abort"` throws an error when the device is estimated to not support +#' the feature. +#' @param call The execution environment of a currently running function, e.g. +#' [`caller_env()`][rlang::caller_env()]. The function will be mentioned in +#' warnings and error messages as the source of the warning or error. See +#' the `call` argument of [`abort()`][rlang::abort()] for more information. +#' +#' @details +#' The procedure for testing is as follows: +#' +#' * First, the \R version is checked against the version wherein a feature was +#' introduced. +#' * Next, the [dev.capabilities()][grDevices::dev.capabilities()] function is +#' queried for support of the feature. +#' * If that check is ambiguous, the \pkg{svglite} and \pkg{ragg} devices are +#' checked for known support. +#' * Lastly, if there is no answer yet, it is checked whether the device is one +#' of the 'known' devices that supports a feature. +#' +#' @section Features: +#' \describe{ +#' \item{`"clippingPaths"`}{While most devices support rectangular clipping +#' regions, this feature is about the support for clipping to arbitrary paths. +#' It can be used to only display a part of a drawing.} +#' \item{`"alpha_masks"`}{Like clipping regions and paths, alpha masks can also +#' be used to only display a part of a drawing. In particular a +#' semi-transparent mask can be used to display a drawing in the opaque parts +#' of the mask and hide a drawing in transparent part of a mask.} +#' \item{`"lumi_masks`}{Similar to alpha masks, but using the mask's luminance +#' (greyscale value) to determine what is drawn. Light values are opaque and +#' dark values are transparent.} +#' \item{`"compositing"`}{Compositing allows one to control how to drawings +#' are drawn in relation to one another. By default, one drawing is drawn +#' 'over' the previous one, but other operators are possible, like 'clear', +#' 'in' and 'out'.} +#' \item{`"blending"`}{When placing one drawing atop of another, the blend +#' mode determines how the colours of the drawings relate to one another.} +#' \item{`"transformations"`}{Performing an affine transformation on a group +#' can be used to translate, rotate, scale, shear and flip the drawing.} +#' \item{`"gradients"`}{Gradients can be used to show a transition between +#' two or more colours as a fill in a drawing. The checks expects both linear +#' and radial gradients to be supported.} +#' \item{`"patterns"`}{Patterns can be used to display a repeated, tiled +#' drawing as a fill in another drawing.} +#' \item{`"paths"`}{Contrary to 'paths' as polyline or polygon drawings, +#' `"paths"` refers to the ability to fill and stroke collections of +#' drawings.} +#' \item{`"glyphs"`}{Refers to the advanced typesetting feature for +#' controlling the appearance of individual glyphs.} +#' } +#' +#' @section Limitations: +#' +#' * On Windows machines, bitmap devices such as `png()` or `jpeg()` default +#' to `type = "windows"`, which at the time of writing don't support any +#' new features, instead of `type = "cairo"`, which does. Prior to \R version +#' 4.2.0, the capabilities cannot be resolved and a conservative `FALSE` is +#' returned. +#' * The \pkg{vdiffr}'s device name is the same as \pkg{svglite}'s device name, +#' but these devices differ in what features are supported. Their differences +#' cannot be resolved and it will be assumed that \pkg{svglite} was used. +#' * With the exception of the \pkg{ragg} and \pkg{svglite} devices, if the +#' device doesn't report their capabilities via +#' [dev.capabilities()][grDevices::dev.capabilities()], or the \R version is +#' below 4.2.0, it is assumed that the feature is unsupported. +#' * Even though patterns and gradients where introduced in \R 4.1.0, they +#' are considered unsupported because providing vectorised patterns and +#' gradients was only introduced later in \R 4.2.0. +#' +#' @return `TRUE` when the feature is thought to be supported and `FALSE` +#' otherwise. +#' @export +#' @keywords internal +#' +#' @examples +#' # Typically you'd run `check_device()` inside a function that might produce +#' # advanced graphics. +#' # The check is designed for use in control flow statements in the test mode +#' if (check_device("patterns", action = "test")) { +#' print("Yay") +#' } else { +#' print("Nay") +#' } +#' +#' # Automatically throw a warning when unavailable +#' if (check_device("compositing", action = "warn")) { +#' print("Yay") +#' } else { +#' print("Nay") +#' } +#' +#' # Throw an error +#' if (check_device("glyphs", action = "abort")) { +#' print("Yay") +#' } +check_device = function(feature, action = "warn", + call = caller_env()) { + + action <- arg_match0(action, c("test", "warn", "abort")) + action_fun <- switch( + action, + warn = cli::cli_warn, + abort = cli::cli_abort, + function(...) invisible() + ) + + feature <- arg_match0( + feature, + c("clippingPaths", "alpha_masks", "lumi_masks", "compositing", "blending", + "transformations", "glyphs", "patterns", "gradients", "paths", + ".test_feature") + ) + # Formatting prettier feature names + feat_name <- switch( + feature, + clippingPaths = "clipping paths", + patterns = "tiled patterns", + blending = "blend modes", + gradients = "colour gradients", + glyphs = "typeset glyphs", + paths = "stroking and filling paths", + transformations = "affine transformations", + alpha_masks = "alpha masks", + lumi_masks = "luminance masks", + feature + ) + + # Perform version check + version <- getRversion() + capable <- switch( + feature, + glyphs = version >= "4.3.0", + paths =, transformations =, compositing =, + patterns =, lumi_masks =, blending =, + gradients = version >= "4.2.0", + alpha_masks =, + clippingPaths = version >= "4.1.0", + TRUE + ) + if (isFALSE(capable)) { + action_fun("R {version} does not support {.emph {feature}}.", + call = call) + return(FALSE) + } + + dev_name <- names(grDevices::dev.cur()) + + # The dev.capabilities() approach may work from R 4.2.0 onwards + if (version >= "4.2.0") { + capa <- grDevices::dev.capabilities() + + # Test if device explicitly states that it is capable of this feature + capable <- switch( + feature, + clippingPaths = isTRUE(capa$clippingPaths), + gradients = all(c("LinearGradient", "RadialGradient") %in% capa$patterns), + alpha_masks = "alpha" %in% capa$masks, + lumi_masks = "luminance" %in% capa$masks, + patterns = "TilingPattern" %in% capa$patterns, + compositing = all(.compo_ops %in% capa$compositing), + blending = all(.blend_ops %in% capa$compositing), + transformations = isTRUE(capa$transformations), + paths = isTRUE(capa$paths), + glyphs = isTRUE(capa$glyphs), + NA + ) + if (isTRUE(capable)) { + return(TRUE) + } + + # Test if device explicitly denies that it is capable of this feature + incapable <- switch( + feature, + clippingPaths = isFALSE(capa$clippingPaths), + gradients = !all(is.na(capa$patterns)) && + !all(c("LinearGradient", "RadialGradient") %in% capa$patterns), + alpha_masks = !is.na(capa$masks) && !("alpha" %in% capa$masks), + lumi_masks = !is.na(capa$masks) && !("luminance" %in% capa$masks), + patterns = !is.na(capa$patterns) && !("TilingPattern" %in% capa$patterns), + compositing = !all(is.na(capa$compositing)) && + !all(.compo_ops %in% capa$compositing), + blending = !all(is.na(capa$compositing)) && + !all(.blend_ops %in% capa$compositing), + transformations = isFALSE(capa$transformations), + paths = isFALSE(capa$paths), + glyphs = isFALSE(capa$glyphs), + NA + ) + + if (isTRUE(incapable)) { + action_fun( + "The {.field {dev_name}} device does not support {.emph {feat_name}}.", + call = call + ) + return(FALSE) + } + } + + # Test {ragg}'s capabilities + if (dev_name %in% c("agg_jpeg", "agg_ppm", "agg_png", "agg_tiff")) { + # We return ragg's version number if not installed, so we can suggest to + # install it. + capable <- switch( + feature, + clippingPaths =, alpha_masks =, gradients =, + patterns = if (is_installed("ragg", version = "1.2.0")) TRUE else "1.2.0", + FALSE + ) + if (isTRUE(capable)) { + return(TRUE) + } + if (is.character(capable) && action != "test") { + check_installed( + "ragg", version = capable, + reason = paste0("for graphics support of ", feat_name, ".") + ) + } + action_fun(paste0( + "The {.pkg ragg} package's {.field {dev_name}} device does not support ", + "{.emph {feat_name}}." + ), call = call) + return(FALSE) + } + + # The same logic applies to {svglite} but is tested separately in case + # {ragg} and {svglite} diverge at some point. + if (dev_name == "devSVG") { + # We're ignoring here that {vdiffr} might be active, which has the same + # device name as {svglite}. + # We'll return a version number if not installed so we can suggest it + capable <- switch( + feature, + clippingPaths =, gradients =, alpha_masks =, + patterns = if (is_installed("svglite", version = "2.1.0")) TRUE else "2.1.0", + FALSE + ) + if (isTRUE(capable)) { + return(TRUE) + } + if (is.character(capable) && action != "test") { + check_installed( + "svglite", version = capable, + reason = paste0("for graphics support of ", feat_name, ".") + ) + } + action_fun(paste0( + "The {.pkg svglite} package's {.field {dev_name}} device does not ", + "support {.emph {feat_name}}.", call = call + )) + return(FALSE) + } + + # Last resort: list of known support prior to R 4.2.0 + supported <- c("pdf", "cairo_pdf", "cairo_ps", "svg") + if (feature == "compositing") { + supported <- setdiff(supported, "pdf") + } + if (.Platform$OS.type == "unix") { + # These devices *can* be supported on Windows, but would have to have + # type = "cairo", which we can't check. + supported <- c(supported, "bmp", "jpeg", "png", "tiff") + } + if (isTRUE(dev_name %in% supported)) { + return(TRUE) + } + action_fun( + "Unable to check the capabilities of the {.field {dev_name}} device.", + call = call + ) + return(FALSE) +} + +.compo_ops <- c("clear", "source", "over", "in", "out", "atop", "dest", + "dest.over", "dest.in", "dest.out", "dest.atop", "xor", "add", + "saturate") + +.blend_ops <- c("multiply", "screen", "overlay", "darken", "lighten", + "color.dodge", "color.burn", "hard.light", "soft.light", + "difference", "exclusion") From 2400911e8c491c4aa4cc6b3913a89da9273ba508 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Thu, 13 Jul 2023 21:26:52 +0200 Subject: [PATCH 03/17] Document --- NAMESPACE | 1 + man/check_device.Rd | 128 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 129 insertions(+) create mode 100644 man/check_device.Rd diff --git a/NAMESPACE b/NAMESPACE index eb67c79182..717abb2e18 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -291,6 +291,7 @@ export(benchplot) export(binned_scale) export(borders) export(calc_element) +export(check_device) export(combine_vars) export(continuous_scale) export(coord_cartesian) diff --git a/man/check_device.Rd b/man/check_device.Rd new file mode 100644 index 0000000000..a6ed6c9f79 --- /dev/null +++ b/man/check_device.Rd @@ -0,0 +1,128 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-checks.R +\name{check_device} +\alias{check_device} +\title{Check graphics device capabilities} +\usage{ +check_device(feature, action = "warn", call = caller_env()) +} +\arguments{ +\item{feature}{A string naming a graphics device feature. One of: +\code{"clippingPaths"}, \code{"alpha_masks"}, \code{"lumi_masks"}, \code{"compositing"}, +\code{"blending"}, \code{"transformations"}, \code{"gradients"}, \code{"patterns"}, \code{"paths"} +or \code{"glyphs"}. See the 'Features' section below for an explanation +of these terms.} + +\item{action}{A string for what action to take. One of: +\itemize{ +\item \code{"test"} returns \code{TRUE} or \code{FALSE} indicating support of the feature. +\item \code{"warn"} also returns a logical, but throws an informative warning when +\code{FALSE}. +\item \code{"abort"} throws an error when the device is estimated to not support +the feature. +}} + +\item{call}{The execution environment of a currently running function, e.g. +\code{\link[rlang:stack]{caller_env()}}. The function will be mentioned in +warnings and error messages as the source of the warning or error. See +the \code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} +} +\value{ +\code{TRUE} when the feature is thought to be supported and \code{FALSE} +otherwise. +} +\description{ +This function makes an attempt to estimate whether the graphics device is +able to render newer graphics features. +} +\details{ +The procedure for testing is as follows: +\itemize{ +\item First, the \R version is checked against the version wherein a feature was +introduced. +\item Next, the \link[grDevices:dev.capabilities]{dev.capabilities()} function is +queried for support of the feature. +\item If that check is ambiguous, the \pkg{svglite} and \pkg{ragg} devices are +checked for known support. +\item Lastly, if there is no answer yet, it is checked whether the device is one +of the 'known' devices that supports a feature. +} +} +\section{Features}{ + +\describe{ +\item{\code{"clippingPaths"}}{While most devices support rectangular clipping +regions, this feature is about the support for clipping to arbitrary paths. +It can be used to only display a part of a drawing.} +\item{\code{"alpha_masks"}}{Like clipping regions and paths, alpha masks can also +be used to only display a part of a drawing. In particular a +semi-transparent mask can be used to display a drawing in the opaque parts +of the mask and hide a drawing in transparent part of a mask.} +\item{\verb{"lumi_masks}}{Similar to alpha masks, but using the mask's luminance +(greyscale value) to determine what is drawn. Light values are opaque and +dark values are transparent.} +\item{\code{"compositing"}}{Compositing allows one to control how to drawings +are drawn in relation to one another. By default, one drawing is drawn +'over' the previous one, but other operators are possible, like 'clear', +'in' and 'out'.} +\item{\code{"blending"}}{When placing one drawing atop of another, the blend +mode determines how the colours of the drawings relate to one another.} +\item{\code{"transformations"}}{Performing an affine transformation on a group +can be used to translate, rotate, scale, shear and flip the drawing.} +\item{\code{"gradients"}}{Gradients can be used to show a transition between +two or more colours as a fill in a drawing. The checks expects both linear +and radial gradients to be supported.} +\item{\code{"patterns"}}{Patterns can be used to display a repeated, tiled +drawing as a fill in another drawing.} +\item{\code{"paths"}}{Contrary to 'paths' as polyline or polygon drawings, +\code{"paths"} refers to the ability to fill and stroke collections of +drawings.} +\item{\code{"glyphs"}}{Refers to the advanced typesetting feature for +controlling the appearance of individual glyphs.} +} +} + +\section{Limitations}{ + +\itemize{ +\item On Windows machines, bitmap devices such as \code{png()} or \code{jpeg()} default +to \code{type = "windows"}, which at the time of writing don't support any +new features, instead of \code{type = "cairo"}, which does. Prior to \R version +4.2.0, the capabilities cannot be resolved and a conservative \code{FALSE} is +returned. +\item The \pkg{vdiffr}'s device name is the same as \pkg{svglite}'s device name, +but these devices differ in what features are supported. Their differences +cannot be resolved and it will be assumed that \pkg{svglite} was used. +\item With the exception of the \pkg{ragg} and \pkg{svglite} devices, if the +device doesn't report their capabilities via +\link[grDevices:dev.capabilities]{dev.capabilities()}, or the \R version is +below 4.2.0, it is assumed that the feature is unsupported. +\item Even though patterns and gradients where introduced in \R 4.1.0, they +are considered unsupported because providing vectorised patterns and +gradients was only introduced later in \R 4.2.0. +} +} + +\examples{ +# Typically you'd run `check_device()` inside a function that might produce +# advanced graphics. +# The check is designed for use in control flow statements in the test mode +if (check_device("patterns", action = "test")) { + print("Yay") +} else { + print("Nay") +} + +# Automatically throw a warning when unavailable +if (check_device("compositing", action = "warn")) { + print("Yay") +} else { + print("Nay") +} + +# Throw an error +if (check_device("glyphs", action = "abort")) { + print("Yay") +} +} +\keyword{internal} From d824bad91ca7e63e4c4d555bbdcaffb7cd263d8d Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Thu, 13 Jul 2023 21:27:20 +0200 Subject: [PATCH 04/17] Write tests --- tests/testthat/test-utilities-checks.R | 95 ++++++++++++++++++++++++++ 1 file changed, 95 insertions(+) create mode 100644 tests/testthat/test-utilities-checks.R diff --git a/tests/testthat/test-utilities-checks.R b/tests/testthat/test-utilities-checks.R new file mode 100644 index 0000000000..e030913cf2 --- /dev/null +++ b/tests/testthat/test-utilities-checks.R @@ -0,0 +1,95 @@ + +test_that("check_device checks R versions correctly", { + + # Most widely supported device + withr::local_pdf() + + # R 4.0.0 doesn't support any new features + with_mocked_bindings( + getRversion = function() package_version("4.0.0"), + expect_warning(check_device("gradients"), "R 4.0.0 does not support"), + .package = "base" + ) + + # R 4.1.0 doesn't support vectorised patterns + with_mocked_bindings( + getRversion = function() package_version("4.1.0"), + expect_warning(check_device("gradients"), "R 4.1.0 does not support"), + .package = "base" + ) + + # R 4.1.0 does support clipping paths + with_mocked_bindings( + getRversion = function() package_version("4.1.0"), + expect_true(check_device("clippingPaths"), "R 4.1.0 does not support"), + .package = "base" + ) + + # Glyphs are only supported in R 4.3.0 onwards + with_mocked_bindings( + getRversion = function() package_version("4.2.0"), + expect_warning(check_device("glyphs"), "R 4.2.0 does not support"), + .package = "base" + ) + + # R 4.2.0 does support vectorised patterns + with_mocked_bindings( + getRversion = function() package_version("4.2.0"), + expect_true(check_device("patterns")), + .package = "base" + ) +}) + +test_that("check_device finds device capabilities", { + skip_if( + getRversion() < "4.1.0", + "R version < 4.1.0 does not have special graphics features." + ) + withr::local_pdf() + with_mocked_bindings( + dev.capabilities = function() list(clippingPaths = TRUE), + expect_true(check_device("clippingPaths")), + .package = "grDevices" + ) + + with_mocked_bindings( + dev.capabilities = function() list(clippingPaths = FALSE), + expect_warning(check_device("clippingPaths"), "does not support"), + .package = "grDevices" + ) + + with_mocked_bindings( + dev.cur = function() c(foobar = 1), + expect_warning(check_device(".test_feature"), "Unable to check"), + .package = "grDevices" + ) + +}) + +test_that("check_device finds ragg capabilities", { + skip_if( + getRversion() < "4.2.0" || !is_installed("ragg", version = "1.2.0"), + "Cannot test {ragg} capabilities." + ) + tmp <- withr::local_tempfile(fileext = ".tiff") + ragg::agg_tiff(tmp) + + expect_true(check_device("gradients")) + expect_warning(check_device("compositing"), "does not support") + + dev.off() +}) + +test_that("check_device finds svglite capabilities", { + skip_if( + getRversion() < "4.2.0" || !is_installed("svglite", version = "2.1.0"), + "Cannot test {svglite} capabilities." + ) + tmp <- withr::local_tempfile(fileext = ".svg") + svglite::svglite(tmp) + + expect_true(check_device("gradients")) + expect_warning(check_device("compositing"), "does not support") + + dev.off() +}) From 514565550b4092016db134fd24484ea5035bdb1f Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Thu, 13 Jul 2023 21:29:29 +0200 Subject: [PATCH 05/17] Add NEWS bullet --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS.md b/NEWS.md index 6fb136dcfc..e00d63882b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # ggplot2 (development version) +* New function `check_device()` for testing the availability of advanced + graphics features introduced in R 4.1.0 onwards (@teunbrand, #5332). + * Nicer error messages for xlim/ylim arguments in coord-* functions (@92amartins, #4601, #5297). From bbca4abb2d92d345414bfc6b16c871988348a1fe Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Thu, 13 Jul 2023 21:52:20 +0200 Subject: [PATCH 06/17] Wrap error-throwing example --- R/utilities-checks.R | 6 ++---- man/check_device.Rd | 6 ++---- 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/R/utilities-checks.R b/R/utilities-checks.R index 47c3861e14..aec8b1dafa 100644 --- a/R/utilities-checks.R +++ b/R/utilities-checks.R @@ -174,10 +174,8 @@ check_inherits <- function(x, #' print("Nay") #' } #' -#' # Throw an error -#' if (check_device("glyphs", action = "abort")) { -#' print("Yay") -#' } +#' # Possibly throw an error +#' try(check_device("glyphs", action = "abort")) check_device = function(feature, action = "warn", call = caller_env()) { diff --git a/man/check_device.Rd b/man/check_device.Rd index a6ed6c9f79..c745d6e9db 100644 --- a/man/check_device.Rd +++ b/man/check_device.Rd @@ -120,9 +120,7 @@ if (check_device("compositing", action = "warn")) { print("Nay") } -# Throw an error -if (check_device("glyphs", action = "abort")) { - print("Yay") -} +# Possibly throw an error +try(check_device("glyphs", action = "abort")) } \keyword{internal} From 5c696e1bf01d9a165ade1a057ffbc90e00dd6a92 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Thu, 13 Jul 2023 22:57:49 +0200 Subject: [PATCH 07/17] skip test for dev capabilities on R < 4.2.0 --- tests/testthat/test-utilities-checks.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-utilities-checks.R b/tests/testthat/test-utilities-checks.R index e030913cf2..d67eb83b5f 100644 --- a/tests/testthat/test-utilities-checks.R +++ b/tests/testthat/test-utilities-checks.R @@ -42,8 +42,8 @@ test_that("check_device checks R versions correctly", { test_that("check_device finds device capabilities", { skip_if( - getRversion() < "4.1.0", - "R version < 4.1.0 does not have special graphics features." + getRversion() < "4.2.0", + "R version < 4.2.0 does doesn't have proper `dev.capabilities()`." ) withr::local_pdf() with_mocked_bindings( From 6297a2f7c951c7006e23246ed5a257933784cd90 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 31 Jul 2023 19:49:25 +0200 Subject: [PATCH 08/17] Check next device when RStudioGD --- R/utilities-checks.R | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/R/utilities-checks.R b/R/utilities-checks.R index aec8b1dafa..bb19faa835 100644 --- a/R/utilities-checks.R +++ b/R/utilities-checks.R @@ -226,7 +226,19 @@ check_device = function(feature, action = "warn", return(FALSE) } - dev_name <- names(grDevices::dev.cur()) + # Grab device for checking + dev_cur <- grDevices::dev.cur() + dev_name <- names(dev_cur) + + if (dev_name == "RStudioGD") { + # RStudio opens RStudioGD as the active graphics device, but the back-end + # appears to be the *next* device. Temporarily set the next device as the + # device to check capabilities. + dev_old <- dev_cur + on.exit(grDevices::dev.set(dev_old), add = TRUE) + dev_cur <- grDevices::dev.set(grDevices::dev.next()) + dev_name <- names(dev_cur) + } # The dev.capabilities() approach may work from R 4.2.0 onwards if (version >= "4.2.0") { From fcada6a19d263c8d25cd1d92e9087fc8cc39110d Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 31 Jul 2023 20:44:04 +0200 Subject: [PATCH 09/17] Allow testing for specific blending/compositing operation --- R/utilities-checks.R | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/R/utilities-checks.R b/R/utilities-checks.R index bb19faa835..a36c162385 100644 --- a/R/utilities-checks.R +++ b/R/utilities-checks.R @@ -85,6 +85,9 @@ check_inherits <- function(x, #' `FALSE`. #' * `"abort"` throws an error when the device is estimated to not support #' the feature. +#' @param op A string for a specific operation to test for when `feature` is +#' either `"blending"` or `"compositing"`. If `NULL` (default), support for +#' all known blending or compositing operations is queried. #' @param call The execution environment of a currently running function, e.g. #' [`caller_env()`][rlang::caller_env()]. The function will be mentioned in #' warnings and error messages as the source of the warning or error. See @@ -176,7 +179,7 @@ check_inherits <- function(x, #' #' # Possibly throw an error #' try(check_device("glyphs", action = "abort")) -check_device = function(feature, action = "warn", +check_device = function(feature, action = "warn", op = NULL, call = caller_env()) { action <- arg_match0(action, c("test", "warn", "abort")) @@ -240,6 +243,21 @@ check_device = function(feature, action = "warn", dev_name <- names(dev_cur) } + # For blending/compositing, maybe test a specific operation + if (!is.null(op)) { + if (feature == "blending") { + .blend_ops <- arg_match0(op, .blend_ops) + } else if (feature == "compositing") { + .compo_ops <- arg_match0(op, .compo_ops) + } else { + cli::cli_abort(paste0( + "The {.arg op} argument must be used with {.code feature = blending}", + " or {.code feature = compositing}." + )) + } + feat_name <- paste0("'", gsub("\\.", " ", op), "' ", feat_name) + } + # The dev.capabilities() approach may work from R 4.2.0 onwards if (version >= "4.2.0") { capa <- grDevices::dev.capabilities() From ee191ca20f84ff4998756813cee29093f787346d Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 31 Jul 2023 21:01:35 +0200 Subject: [PATCH 10/17] More vdiffr nuance --- R/utilities-checks.R | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/R/utilities-checks.R b/R/utilities-checks.R index a36c162385..f379cb81cc 100644 --- a/R/utilities-checks.R +++ b/R/utilities-checks.R @@ -146,7 +146,8 @@ check_inherits <- function(x, #' returned. #' * The \pkg{vdiffr}'s device name is the same as \pkg{svglite}'s device name, #' but these devices differ in what features are supported. Their differences -#' cannot be resolved and it will be assumed that \pkg{svglite} was used. +#' cannot be resolved and it will be assumed that \pkg{svglite} was used, +#' unless the check is run in a \pkg{testthat} environment. #' * With the exception of the \pkg{ragg} and \pkg{svglite} devices, if the #' device doesn't report their capabilities via #' [dev.capabilities()][grDevices::dev.capabilities()], or the \R version is @@ -338,8 +339,6 @@ check_device = function(feature, action = "warn", op = NULL, # The same logic applies to {svglite} but is tested separately in case # {ragg} and {svglite} diverge at some point. if (dev_name == "devSVG") { - # We're ignoring here that {vdiffr} might be active, which has the same - # device name as {svglite}. # We'll return a version number if not installed so we can suggest it capable <- switch( feature, @@ -347,6 +346,17 @@ check_device = function(feature, action = "warn", op = NULL, patterns = if (is_installed("svglite", version = "2.1.0")) TRUE else "2.1.0", FALSE ) + + # When we're in a testthat environment, we'll assume we're in vdiffr, which + # doesn't support newer features. + # Determining this is logic copied from `testthat::is_testing()` + if (identical(Sys.getenv("TESTTHAT"), "true")) { + capable <- FALSE + pkg <- "vdiffr" + } else { + pkg <- "svglite" + } + if (isTRUE(capable)) { return(TRUE) } @@ -357,7 +367,7 @@ check_device = function(feature, action = "warn", op = NULL, ) } action_fun(paste0( - "The {.pkg svglite} package's {.field {dev_name}} device does not ", + "The {.pkg {pkg}} package's {.field {dev_name}} device does not ", "support {.emph {feat_name}}.", call = call )) return(FALSE) From 43453becb347bfa6895394b37ca4a1069ac46978 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 31 Jul 2023 22:26:20 +0200 Subject: [PATCH 11/17] Redocument --- man/check_device.Rd | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/man/check_device.Rd b/man/check_device.Rd index c745d6e9db..80ec5b4908 100644 --- a/man/check_device.Rd +++ b/man/check_device.Rd @@ -4,7 +4,7 @@ \alias{check_device} \title{Check graphics device capabilities} \usage{ -check_device(feature, action = "warn", call = caller_env()) +check_device(feature, action = "warn", op = NULL, call = caller_env()) } \arguments{ \item{feature}{A string naming a graphics device feature. One of: @@ -22,6 +22,10 @@ of these terms.} the feature. }} +\item{op}{A string for a specific operation to test for when \code{feature} is +either \code{"blending"} or \code{"compositing"}. If \code{NULL} (default), support for +all known blending or compositing operations is queried.} + \item{call}{The execution environment of a currently running function, e.g. \code{\link[rlang:stack]{caller_env()}}. The function will be mentioned in warnings and error messages as the source of the warning or error. See @@ -92,7 +96,8 @@ new features, instead of \code{type = "cairo"}, which does. Prior to \R version returned. \item The \pkg{vdiffr}'s device name is the same as \pkg{svglite}'s device name, but these devices differ in what features are supported. Their differences -cannot be resolved and it will be assumed that \pkg{svglite} was used. +cannot be resolved and it will be assumed that \pkg{svglite} was used, +unless the check is run in a \pkg{testthat} environment. \item With the exception of the \pkg{ragg} and \pkg{svglite} devices, if the device doesn't report their capabilities via \link[grDevices:dev.capabilities]{dev.capabilities()}, or the \R version is From 9207aac5ec6c3a2211b83a74d4aa57502807a773 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 31 Jul 2023 22:53:23 +0200 Subject: [PATCH 12/17] Misplaced parenthesis --- R/utilities-checks.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/utilities-checks.R b/R/utilities-checks.R index f379cb81cc..fd57faf7be 100644 --- a/R/utilities-checks.R +++ b/R/utilities-checks.R @@ -368,8 +368,8 @@ check_device = function(feature, action = "warn", op = NULL, } action_fun(paste0( "The {.pkg {pkg}} package's {.field {dev_name}} device does not ", - "support {.emph {feat_name}}.", call = call - )) + "support {.emph {feat_name}}."), call = call + ) return(FALSE) } From c353e54a9664d9e2bc3163ae097a893f6e88c588 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 31 Jul 2023 22:53:57 +0200 Subject: [PATCH 13/17] Get out of pickle --- tests/testthat/test-utilities-checks.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-utilities-checks.R b/tests/testthat/test-utilities-checks.R index d67eb83b5f..04dbd79f52 100644 --- a/tests/testthat/test-utilities-checks.R +++ b/tests/testthat/test-utilities-checks.R @@ -86,6 +86,7 @@ test_that("check_device finds svglite capabilities", { "Cannot test {svglite} capabilities." ) tmp <- withr::local_tempfile(fileext = ".svg") + withr::local_envvar(TESTTHAT = "false") # To not trigger vdiffr rules svglite::svglite(tmp) expect_true(check_device("gradients")) From 6ed4b10ff205bc1c4cc5378969a613fdd66e1476 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Tue, 1 Aug 2023 17:09:26 +0200 Subject: [PATCH 14/17] Add `maybe` argument --- R/utilities-checks.R | 12 ++++++++---- man/check_device.Rd | 15 ++++++++++++--- 2 files changed, 20 insertions(+), 7 deletions(-) diff --git a/R/utilities-checks.R b/R/utilities-checks.R index fd57faf7be..a958d3f741 100644 --- a/R/utilities-checks.R +++ b/R/utilities-checks.R @@ -88,6 +88,8 @@ check_inherits <- function(x, #' @param op A string for a specific operation to test for when `feature` is #' either `"blending"` or `"compositing"`. If `NULL` (default), support for #' all known blending or compositing operations is queried. +#' @param maybe A logical of length 1 determining what the return value should +#' be in case the device capabilities cannot be assessed. #' @param call The execution environment of a currently running function, e.g. #' [`caller_env()`][rlang::caller_env()]. The function will be mentioned in #' warnings and error messages as the source of the warning or error. See @@ -142,8 +144,8 @@ check_inherits <- function(x, #' * On Windows machines, bitmap devices such as `png()` or `jpeg()` default #' to `type = "windows"`, which at the time of writing don't support any #' new features, instead of `type = "cairo"`, which does. Prior to \R version -#' 4.2.0, the capabilities cannot be resolved and a conservative `FALSE` is -#' returned. +#' 4.2.0, the capabilities cannot be resolved and the value of the `maybe` +#' argument is returned. #' * The \pkg{vdiffr}'s device name is the same as \pkg{svglite}'s device name, #' but these devices differ in what features are supported. Their differences #' cannot be resolved and it will be assumed that \pkg{svglite} was used, @@ -180,9 +182,11 @@ check_inherits <- function(x, #' #' # Possibly throw an error #' try(check_device("glyphs", action = "abort")) -check_device = function(feature, action = "warn", op = NULL, +check_device = function(feature, action = "warn", op = NULL, maybe = FALSE, call = caller_env()) { + check_bool(maybe, allow_na = TRUE) + action <- arg_match0(action, c("test", "warn", "abort")) action_fun <- switch( action, @@ -390,7 +394,7 @@ check_device = function(feature, action = "warn", op = NULL, "Unable to check the capabilities of the {.field {dev_name}} device.", call = call ) - return(FALSE) + return(maybe) } .compo_ops <- c("clear", "source", "over", "in", "out", "atop", "dest", diff --git a/man/check_device.Rd b/man/check_device.Rd index 80ec5b4908..6739ef2c67 100644 --- a/man/check_device.Rd +++ b/man/check_device.Rd @@ -4,7 +4,13 @@ \alias{check_device} \title{Check graphics device capabilities} \usage{ -check_device(feature, action = "warn", op = NULL, call = caller_env()) +check_device( + feature, + action = "warn", + op = NULL, + maybe = FALSE, + call = caller_env() +) } \arguments{ \item{feature}{A string naming a graphics device feature. One of: @@ -26,6 +32,9 @@ the feature. either \code{"blending"} or \code{"compositing"}. If \code{NULL} (default), support for all known blending or compositing operations is queried.} +\item{maybe}{A logical of length 1 determining what the return value should +be in case the device capabilities cannot be assessed.} + \item{call}{The execution environment of a currently running function, e.g. \code{\link[rlang:stack]{caller_env()}}. The function will be mentioned in warnings and error messages as the source of the warning or error. See @@ -92,8 +101,8 @@ controlling the appearance of individual glyphs.} \item On Windows machines, bitmap devices such as \code{png()} or \code{jpeg()} default to \code{type = "windows"}, which at the time of writing don't support any new features, instead of \code{type = "cairo"}, which does. Prior to \R version -4.2.0, the capabilities cannot be resolved and a conservative \code{FALSE} is -returned. +4.2.0, the capabilities cannot be resolved and the value of the \code{maybe} +argument is returned. \item The \pkg{vdiffr}'s device name is the same as \pkg{svglite}'s device name, but these devices differ in what features are supported. Their differences cannot be resolved and it will be assumed that \pkg{svglite} was used, From 705e371b7a36dd3a32b973b26af94d99fec45dd5 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Tue, 1 Aug 2023 18:57:00 +0200 Subject: [PATCH 15/17] Don't internally discriminate blending/compositing with `op` argument --- R/utilities-checks.R | 14 +++----------- 1 file changed, 3 insertions(+), 11 deletions(-) diff --git a/R/utilities-checks.R b/R/utilities-checks.R index a958d3f741..e659e4719e 100644 --- a/R/utilities-checks.R +++ b/R/utilities-checks.R @@ -249,17 +249,9 @@ check_device = function(feature, action = "warn", op = NULL, maybe = FALSE, } # For blending/compositing, maybe test a specific operation - if (!is.null(op)) { - if (feature == "blending") { - .blend_ops <- arg_match0(op, .blend_ops) - } else if (feature == "compositing") { - .compo_ops <- arg_match0(op, .compo_ops) - } else { - cli::cli_abort(paste0( - "The {.arg op} argument must be used with {.code feature = blending}", - " or {.code feature = compositing}." - )) - } + if (!is.null(op) && feature %in% c("blending", "compositing")) { + op <- arg_match0(op, c(.blend_ops, .compo_ops)) + .blend_ops <- .compo_ops <- op feat_name <- paste0("'", gsub("\\.", " ", op), "' ", feat_name) } From 4e247ef52f5db5193f4ba93e3694224a47d5ade5 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 4 Sep 2023 09:40:15 +0200 Subject: [PATCH 16/17] Cleaner vdiffr solution --- DESCRIPTION | 2 +- R/utilities-checks.R | 24 ++++++++++-------------- man/check_device.Rd | 4 ---- 3 files changed, 11 insertions(+), 19 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 218c8a88bd..7083afd731 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -67,7 +67,7 @@ Suggests: sf (>= 0.7-3), svglite (>= 1.2.0.9001), testthat (>= 3.1.2), - vdiffr (>= 1.0.0), + vdiffr (>= 1.0.6), xml2 Enhances: sp diff --git a/R/utilities-checks.R b/R/utilities-checks.R index e659e4719e..6b7dd0d3da 100644 --- a/R/utilities-checks.R +++ b/R/utilities-checks.R @@ -146,10 +146,6 @@ check_inherits <- function(x, #' new features, instead of `type = "cairo"`, which does. Prior to \R version #' 4.2.0, the capabilities cannot be resolved and the value of the `maybe` #' argument is returned. -#' * The \pkg{vdiffr}'s device name is the same as \pkg{svglite}'s device name, -#' but these devices differ in what features are supported. Their differences -#' cannot be resolved and it will be assumed that \pkg{svglite} was used, -#' unless the check is run in a \pkg{testthat} environment. #' * With the exception of the \pkg{ragg} and \pkg{svglite} devices, if the #' device doesn't report their capabilities via #' [dev.capabilities()][grDevices::dev.capabilities()], or the \R version is @@ -332,6 +328,16 @@ check_device = function(feature, action = "warn", op = NULL, maybe = FALSE, return(FALSE) } + # The vdiffr version of the SVG device is known to not support any newer + # features + if (dev_name == "devSVG_vdiffr") { + action_fun( + "The {.pkg vdiffr} package's device does not support {.emph {feat_name}}.", + call = call + ) + return(FALSE) + } + # The same logic applies to {svglite} but is tested separately in case # {ragg} and {svglite} diverge at some point. if (dev_name == "devSVG") { @@ -343,16 +349,6 @@ check_device = function(feature, action = "warn", op = NULL, maybe = FALSE, FALSE ) - # When we're in a testthat environment, we'll assume we're in vdiffr, which - # doesn't support newer features. - # Determining this is logic copied from `testthat::is_testing()` - if (identical(Sys.getenv("TESTTHAT"), "true")) { - capable <- FALSE - pkg <- "vdiffr" - } else { - pkg <- "svglite" - } - if (isTRUE(capable)) { return(TRUE) } diff --git a/man/check_device.Rd b/man/check_device.Rd index 6739ef2c67..924813638f 100644 --- a/man/check_device.Rd +++ b/man/check_device.Rd @@ -103,10 +103,6 @@ to \code{type = "windows"}, which at the time of writing don't support any new features, instead of \code{type = "cairo"}, which does. Prior to \R version 4.2.0, the capabilities cannot be resolved and the value of the \code{maybe} argument is returned. -\item The \pkg{vdiffr}'s device name is the same as \pkg{svglite}'s device name, -but these devices differ in what features are supported. Their differences -cannot be resolved and it will be assumed that \pkg{svglite} was used, -unless the check is run in a \pkg{testthat} environment. \item With the exception of the \pkg{ragg} and \pkg{svglite} devices, if the device doesn't report their capabilities via \link[grDevices:dev.capabilities]{dev.capabilities()}, or the \R version is From 912cc84187a66717d5ed4d46d9a41fe4df4b91f4 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 4 Sep 2023 09:48:13 +0200 Subject: [PATCH 17/17] Polish docs a bit --- R/utilities-checks.R | 13 ++++++++----- man/check_device.Rd | 13 ++++++++----- 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/R/utilities-checks.R b/R/utilities-checks.R index 6b7dd0d3da..3d42703bb5 100644 --- a/R/utilities-checks.R +++ b/R/utilities-checks.R @@ -142,17 +142,20 @@ check_inherits <- function(x, #' @section Limitations: #' #' * On Windows machines, bitmap devices such as `png()` or `jpeg()` default -#' to `type = "windows"`, which at the time of writing don't support any -#' new features, instead of `type = "cairo"`, which does. Prior to \R version -#' 4.2.0, the capabilities cannot be resolved and the value of the `maybe` -#' argument is returned. +#' to `type = "windows"`. At the time of writing, these don't support any +#' new features, in contrast to `type = "cairo"`, which does. Prior to \R +#' version 4.2.0, the capabilities cannot be resolved and the value of the +#' `maybe` argument is returned. #' * With the exception of the \pkg{ragg} and \pkg{svglite} devices, if the #' device doesn't report their capabilities via #' [dev.capabilities()][grDevices::dev.capabilities()], or the \R version is -#' below 4.2.0, it is assumed that the feature is unsupported. +#' below 4.2.0, the `maybe` value is returned. #' * Even though patterns and gradients where introduced in \R 4.1.0, they #' are considered unsupported because providing vectorised patterns and #' gradients was only introduced later in \R 4.2.0. +#' * When using the RStudio graphics device, the back end is assumed to be the +#' next device on the list. This assumption is typically met by default, +#' unless the device list is purposefully rearranged. #' #' @return `TRUE` when the feature is thought to be supported and `FALSE` #' otherwise. diff --git a/man/check_device.Rd b/man/check_device.Rd index 924813638f..cc09a1de67 100644 --- a/man/check_device.Rd +++ b/man/check_device.Rd @@ -99,17 +99,20 @@ controlling the appearance of individual glyphs.} \itemize{ \item On Windows machines, bitmap devices such as \code{png()} or \code{jpeg()} default -to \code{type = "windows"}, which at the time of writing don't support any -new features, instead of \code{type = "cairo"}, which does. Prior to \R version -4.2.0, the capabilities cannot be resolved and the value of the \code{maybe} -argument is returned. +to \code{type = "windows"}. At the time of writing, these don't support any +new features, in contrast to \code{type = "cairo"}, which does. Prior to \R +version 4.2.0, the capabilities cannot be resolved and the value of the +\code{maybe} argument is returned. \item With the exception of the \pkg{ragg} and \pkg{svglite} devices, if the device doesn't report their capabilities via \link[grDevices:dev.capabilities]{dev.capabilities()}, or the \R version is -below 4.2.0, it is assumed that the feature is unsupported. +below 4.2.0, the \code{maybe} value is returned. \item Even though patterns and gradients where introduced in \R 4.1.0, they are considered unsupported because providing vectorised patterns and gradients was only introduced later in \R 4.2.0. +\item When using the RStudio graphics device, the back end is assumed to be the +next device on the list. This assumption is typically met by default, +unless the device list is purposefully rearranged. } }