Comparing fingerprints

analyse_fprint.R

## Run https://gist.github.com/lgatto/1875f858f4af543990ce3dc84825d9ee

fls <- dir(pattern = "rda")

fps <- lapply(fls, readRDS)
names(fps) <- fls
fps <- lapply(fps, "[[", 1)

.ref <- 3
ref <- fps[[.ref]]
fps <- fps[-.ref]


hdists <- sapply(seq_along(fps),
                 function(i) mapply(visualTest:::hamming_distance,
                                    ref, fps[[i]]))
colnames(hdists) <- sub("fprint-", "", sub(".rda", "", names(fps)))

t(hdists)

gr <- expand.grid(ref, ref)
x <- matrix(apply(gr, 1, function(i) visualTest:::hamming_distance(i[[1]], i[[2]])), 13)
colnames(x) <- rownames(x) <- names(ref)

levelplot(x,
          panel = function(x, y, z, ...) {
              panel.levelplot(x, y, z, ...)
              panel.text(x, y, z)
          })

fingerprint.R

plist <- list(
    p0 <- function() plot(1:10),
    p1 <- function() plot(1:10, main = "A title"),
    p2 <- function() plot(1:10, col = "red"),
    p3 <- function() plot(1:10, pch = 19),
    p4 <- function() plot(1:10, pch = 19),
    p5 <- function() plot(1:10, pch = 2),
    p6 <- function() plot(1:10, pch = 19, col = "red"),
    p7 <- function() plot(10:1),
    p8 <- function() plot(10:1, main = "A title"),
    p9 <- function() plot(10:1, col = "red"),
    p10 <- function() plot(10:1, pch = 19),
    p11 <- function() plot(10:1, pch = 19),
    p12 <- function() plot(10:1, pch = 19, col = "red")
)

names(plist) <- paste0("p", seq_along(plist) - 1)

if (!require("visualTest")) {
    if (!require("devtools")) install.packages("devtools")
    if (!require("png")) install.packages("png")
    library("devtools")
    devtools::install_github("MangoTheCat/visualTest")
    library("visualTest")
}

    
do <- function(fun) {
    fn <- tempfile(fileext = ".png")
    on.exit(unlink(fn))
    png(fn)
    do.call(fun, list())
    dev.off()
    visualTest::getFingerprint(fn)
}

res <- list(
    fprint = sapply(plist, do),
    si = sessionInfo())

outf <- paste0("fprint-", Sys.info()[["sysname"]], "-", Sys.info()[["release"]], ".rda")
saveRDS(res, file = outf)