我们正在使用一个function，它可以绘制或不绘制图。
我正在寻找一个解决方案，以检查该功能是否有绘图的副作用。
我希望有一些dev.*解决方案来检查它。
inherits只能用于返回可重用对象（如ggplot2）的解决方案。另一方面，boxplot返回list，plot返回NULL类。
我期望精确地检查dev。
提供了不同图形和非图形的广泛列表。

input_plots <- list(
  function() print(ggplot2::qplot(1)),
  function() lattice::densityplot(1),
  function() grid::grid.draw(ggplotify::as.grob(lattice::densityplot(1))),
  function() plot(1),
  function() boxplot(2),
  function() hist(1)
)

input_noplots <- list(
  function() list(),
  function() NULL,
  function() 2,
  function() NA
)

# We are working with a function which could draw a plot or not
all(vapply(input_plots, is.function, FUN.VALUE = logical(1)))
#> [1] TRUE
all(vapply(input_noplots, is.function, FUN.VALUE = logical(1)))
#> [1] TRUE

# all input_plots should be TRUE for is_draw
# all input_noplots should be FALSE for is_draw
is_draw <- function(fun){
  # inherits works only for functions returning proper instances
  # you can call a function fun()
  ...
  # return logical if the fun draw a plot
}

# all(vapply(input_plots, is_draw, FUN.VALUE = logical(1)))
# TRUE
# all(vapply(input_noplots, Negate(is_draw), FUN.VALUE = logical(1)))
# TRUE

创建于2022年11月29日，使用reprex v2.0.2
验证溶液：

# all input_plots should be TRUE for is_draw
# all input_noplots should be FALSE for is_draw

# this function will clear your device
is_draw <- function(f) {
  try(dev.off(), silent = TRUE)
  # graphics.off() # close any current graphics devices
  cdev <- dev.cur()
  f()
  if (cdev != dev.cur()) {
    on.exit(dev.off())
    return(TRUE)
  }
  return(FALSE)
}

all(vapply(input_plots, is_draw, FUN.VALUE = logical(1)))
#> Warning: `qplot()` was deprecated in ggplot2 3.4.0.
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
#> [1] TRUE
# TRUE
all(vapply(input_noplots, Negate(is_draw), FUN.VALUE = logical(1)))
#> [1] TRUE
# TRUE

plot(1)
all(vapply(input_plots, is_draw, FUN.VALUE = logical(1)))
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
#> [1] TRUE
# TRUE
all(vapply(input_noplots, Negate(is_draw), FUN.VALUE = logical(1)))
#> [1] TRUE
# TRUE

创建于2022年11月29日，使用reprex v2.0.2