Check if a function draw/plot something-CodePudding

We are working with a function which could draw a plot or not.
I am looking for a solution to check if the function has a side effect of drawing.
I hope there is some dev.* solution to check it out.
The inherits could be used only for solutions which return reusable objects like ggplot2. On the other hand boxplot return a list and plot a NULL class.
I expect to check the dev precisely.
The extensive list of different graphics and non-graphics is provided.

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

^{Created on 2022-11-29 with reprex v2.0.2}

VALIDATE SOLUTION:

# 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

^{Created on 2022-11-29 with reprex v2.0.2}

CodePudding user response：

As long as you currently have no graphics device open, one way would be to check if the current device changed.

is_draw <- function(f) {
  graphics.off() # close any current graphics devices
  cdev <- dev.cur()
  f()
  if (cdev != dev.cur()) {
    on.exit(dev.off())
    return(TRUE)
  }
  return(FALSE)
}

Note that this depends on you being able to evaluate the function. This returns FALSE for your lattice example because, like ggplot, those plots only render when the print() method is called.

This method also closes the graphics device so the plot is lost, but you need to close it to see if a new one opens up

CodePudding user response：

This seems to work on Rgui on Windows. You can check whether it works in your environment. Zap all graphics devices using dev.off and then after running your code check the length of dev.list() .

for(d in dev.list()) dev.off()

x <- 3 # does not plot
length(dev.list())
## [1] 0

plot(0)  # plots
length(dev.list())
## [1] 1