Cómo probar la salida gráfica de funciones?


Me pregunto cómo probar funciones que producen gráficos. Tengo un simple función de trazado img:

img <- function() {
  plot(1:10)
}

En mi paquete me gusta crear una prueba unitaria para esta función usando testthat. Porque plot y sus amigos en gráficos base simplemente devuelven NULL un simple expect_identical no funciona:

library("testthat")

## example for a successful test
expect_identical(plot(1:10), img()) ## equal (as expected)

## example for a test failure
expect_identical(plot(1:10, col="red"), img()) ## DOES NOT FAIL!
# (because both return NULL)

Primero pensé en graficar en un archivo y comparar las sumas de verificación md5 con asegúrese de que la salida de las funciones es igual:

md5plot <- function(expr) {
  file <- tempfile(fileext=".pdf")
  on.exit(unlink(file))
  pdf(file)
  expr
  dev.off()
  unname(tools::md5sum(file))
}

## example for a successful test
expect_identical(md5plot(img()),
                 md5plot(plot(1:10))) ## equal (as expected)

## example for a test failure
expect_identical(md5plot(img()),
                 md5plot(plot(1:10, col="red"))) ## not equal (as expected)

Eso funciona bien en Linux pero no en Windows. Sorprendentemente md5plot(plot(1:10)) resulta en un nuevo md5sum en cada llamada. Aparte de este problema, necesito crear muchos archivos temporales.

Luego usé recordPlot (primero creando un dispositivo nulo, llame al trazado función y registrar su salida). Esto funciona como se esperaba:

recPlot <- function(expr) {
  pdf(NULL)
  on.exit(dev.off())
  dev.control(displaylist="enable")
  expr
  recordPlot()
}

## example for a successful test
expect_identical(recPlot(plot(1:10)),
                 recPlot(img())) ## equal (as expected)

## example for a test failure
expect_identical(recPlot(plot(1:10, col="red")),
                 recPlot(img())) ## not equal (as expected)

¿Alguien conoce una mejor manera de probar la salida gráfica de funciones?

EDITAR : respecto a los puntos que @josilber pregunta en sus comentarios.

Mientras que el recordPlot el enfoque funciona bien, debe reescribir toda la función de trazado en la prueba unitaria. Eso se vuelve complicado para funciones de trazado complejas. Sería bueno tener un enfoque que permite almacenar un archivo (*.RData o *.pdf, ...) que contiene una imagen contra usted podría comparar en pruebas futuras. El enfoque md5sum no funciona porque los md5sums difieren en diferentes plataformas. A través de recordPlot puede crear un archivo *.RData pero no puede confiar en su formato (del manual recordPlot página):

El formato de las gráficas registradas puede cambiar entre versiones R. Las parcelas registradas pueden no utilizarse como formato de almacenamiento permanente para R parcelas.

Tal vez sería posible almacenar un archivo de imagen (*.png, *.bmp, etc), importarlo y compararlo píxel por píxel ...

EDIT2: El siguiente código ilustra el enfoque de archivo de referencia deseado usando svg como salida. Primero el ayudante necesario funciones:

## plot to svg and return file contant as character
plot_image <- function(expr) {
  file <- tempfile(fileext=".svg")
  on.exit(unlink(file))
  svg(file)
  expr
  dev.off()
  readLines(file)
}

## the IDs differ at each `svg` call, that's why we simple remove them
ignore_svg_id <- function(lines) {
  gsub(pattern = "(xlink:href|id)=\"#?([a-z0-9]+)-?(?<![0-9])[0-9]+\"",
       replacement = "\\1=\"\\2\"", x = lines, perl = TRUE)
}

## compare svg character vs reference
expect_image_equal <- function(object, expected, ...) {
  stopifnot(is.character(expected) && file.exists(expected))
  expect_equal(ignore_svg_id(plot_image(object)),
               ignore_svg_id(readLines(expected)), ...)
}

## create reference image
create_reference_image <- function(expr, file) {
  svg(file)
  expr
  dev.off()
}

Una prueba sería:

create_reference_image(img(), "reference.svg")

## create tests
library("testthat")

expect_image_equal(img(), "reference.svg") ## equal (as expected)
expect_image_equal(plot(1:10, col="red"), "reference.svg") ## not equal (as expected)

Lamentablemente esto no está funcionando en diferentes plataformas. El orden (y los nombres) de los elementos svg difiere completamente en Linux y Windows.

Existen problemas Similares para png, jpeg y recordPlot. Los archivos resultantes difieren en todas las plataformas.

Actualmente la única solución que funciona es el enfoque recPlot anterior. Pero por lo tanto Necesito reescribir todas las funciones de trazado en mi unidad prueba.


P. S.: Estoy completamente confundido acerca de los diferentes md5sums en Windows. Parece que dependen del tiempo de creación de los archivos temporales:
# on Windows
table(sapply(1:100, function(x)md5plot(plot(1:10))))
#4693c8bcf6b6cb78ce1fc7ca41831353 51e8845fead596c86a3f0ca36495eacb
#                              40                               60
Author: sgibb, 2015-05-14

2 answers

Mango Solutions ha publicado un paquete de código abierto, visualTest, que hace coincidencia difusa de parcelas, para abordar este caso de uso.

El paquete está en github , así que instale usando:

devtools::install_github("MangoTheCat/visualTest")
library(visualTest)

Luego use la función getFingerprint() para extraer una huella dactilar para cada gráfico, y compare usando la función isSimilar(), especificando un umbral adecuado.

Primero, cree algunas gráficas en el archivo:

png(filename = "test1.png")
img()
dev.off()

png(filename = "test2.png")
plot(1:11, col="red")
dev.off()

La huella dactilar es un vector numérico:

> getFingerprint(file = "test1.png")
 [1]  4  7  4  4 10  4  7  7  4  7  7  4  7  4  5  9  4  7  7  5  6  7  4  7  4  4 10
[28]  4  7  7  4  7  7  4  7  4  3  7  4  4  3  4  4  5  5  4  7  4  7  4  7  7  7  4
[55]  7  7  4  7  4  7  5  6  7  7  4  8  6  4  7  4  7  4  7  7  7  4  4 10  4  7  4

> getFingerprint(file = "test2.png")
 [1]  7  7  4  4 17  4  7  4  7  4  7  7  4  5  9  4  7  7  5  6  7  4  7  7 11  4  7
[28]  7  5  6  7  4  7  4 14  4  3  4  7 11  7  4  7  5  6  7  7  4  7 11  7  4  7  5
[55]  6  7  7  4  8  6  4  7  7  4  4  7  7  4 10 11  4  7  7

Comparar usando isSimilar():

> isSimilar(file = "test2.png",
+           fingerprint = getFingerprint(file = "test1.png"),
+           threshold = 0.1
+ )
[1] FALSE

Puede leer más sobre el paquete en http://www.mango-solutions.com/wp/products-services/r-services/r-packages/visualtest /

 13
Author: Andrie,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/ajaxhispano.com/template/agent.layouts/content.php on line 61
2015-05-17 11:51:07

Vale la pena señalar que el paquete vdiffr también admite la comparación de gráficos. Una buena característica es que se integra con el paquete testthat actually en realidad se usa para probar en ggplot2 and y tiene un complemento para RStudio para ayudar a administrar su testsuite.

 3
Author: Dylan,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/ajaxhispano.com/template/agent.layouts/content.php on line 61
2017-07-08 21:02:29