sgi*_*ibb 36 testing graphics plot r testthat
我想知道如何测试生成图形的函数.我有一个简单的绘图功能img:
img <- function() {
plot(1:10)
}
Run Code Online (Sandbox Code Playgroud)
在我的包中,我喜欢使用这个函数创建一个单元测试testthat.因为plot和它的朋友在基础图形只是返回NULL一个简单
expect_identical的不工作:
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)
Run Code Online (Sandbox Code Playgroud)
首先,我考虑绘制到文件中并比较md5校验和以确保函数的输出相等:
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)
Run Code Online (Sandbox Code Playgroud)
这适用于Linux,但不适用于Windows.令人惊讶的是
md5plot(plot(1:10)),每次通话都会产生新的md5sum.除了这个问题,我需要创建大量的临时文件.
接下来我使用recordPlot(首先创建一个空设备,调用绘图函数并记录其输出).这按预期工作:
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)
Run Code Online (Sandbox Code Playgroud)
有人知道测试函数图形输出的更好方法吗?
编辑:关于@josilber在评论中提出的要点.
虽然该recordPlot方法运行良好,但您必须在单元测试中重写整个绘图功能.对于复杂的绘图功能而言,这变得复杂.如果有一种允许存储包含图像的文件(*.RData或*.pdf......)的方法,可以在将来的测试中进行比较,这将是一件好事.该md5sum方法不起作用,因为md5sums在不同平台上有所不同.通过recordPlot你可以创建一个*.RData文件,但你不能依赖它的格式(从recordPlot手册页):
记录图的格式可能会在R版本之间发生变化.记录的图不能用作R图的永久存储格式.
也许这将有可能存储图像文件(*.png,*.bmp,等),将其导入并逐像素进行比较?
EDIT2:以下代码说明了使用svg作为输出的所需参考文件方法.首先是所需的辅助函数:
## 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()
}
Run Code Online (Sandbox Code Playgroud)
测试将是:
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)
Run Code Online (Sandbox Code Playgroud)
遗憾的是,这不适用于不同的平台.在Linux和Windows上,svg元素的顺序(和名称)完全不同.
存在类似的问题png,jpeg和recordPlot.生成的文件在所有平台上都不同.
目前唯一可行的解决方案是上述recPlot方法.但是因此我需要在单元测试中重写整个绘图功能.
# on Windows
table(sapply(1:100, function(x)md5plot(plot(1:10))))
#4693c8bcf6b6cb78ce1fc7ca41831353 51e8845fead596c86a3f0ca36495eacb
# 40 60
Run Code Online (Sandbox Code Playgroud)
And*_*rie 13
Mango Solutions已经发布了一个开源软件包,visualTest它可以对图表进行模糊匹配,以解决这个用例.
包在github上,所以安装使用:
devtools::install_github("MangoTheCat/visualTest")
library(visualTest)
Run Code Online (Sandbox Code Playgroud)
然后使用该函数getFingerprint()为每个绘图提取指纹,并使用该函数进行比较isSimilar(),指定合适的阈值.
首先,在文件上创建一些图:
png(filename = "test1.png")
img()
dev.off()
png(filename = "test2.png")
plot(1:11, col="red")
dev.off()
Run Code Online (Sandbox Code Playgroud)
指纹是一个数字向量:
> 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
Run Code Online (Sandbox Code Playgroud)
比较使用isSimilar():
> isSimilar(file = "test2.png",
+ fingerprint = getFingerprint(file = "test1.png"),
+ threshold = 0.1
+ )
[1] FALSE
Run Code Online (Sandbox Code Playgroud)
您可以在http://www.mango-solutions.com/wp/products-services/r-services/r-packages/visualtest/上阅读有关该软件包的更多信息.