tests/test-wh.R

In grImport2: Importing 'SVG' Graphics

library(grid)
library(grImport2)
library(gridSVG)

test <- readPicture("test-wh-input.svg")

dev <- function(name, width, height) {
    gridsvg(name, width = width, height = height, annotate = FALSE)
}

## Check that 'width' and 'height' default to sensible unit(1, "npc")
dev("test-wh-default.svg", width=4, height=4)
grid.rect(gp=gpar(col=NA, fill="grey"))
grid.picture(test, expansion=0)
dev.off()

dev("test-wh-default-wider.svg", width=8, height=4)
grid.rect(gp=gpar(col=NA, fill="grey"))
grid.picture(test, expansion=0)
dev.off()

dev("test-wh-default-taller.svg", width=4, height=8)
grid.rect(gp=gpar(col=NA, fill="grey"))
grid.picture(test, expansion=0)
dev.off()

## Check justification
dev("test-wh-default-wider-left.svg", width=8, height=4)
grid.rect(gp=gpar(col=NA, fill="grey"))
grid.picture(test, expansion=0, x=0, hjust=0)
dev.off()

dev("test-wh-default-taller-bottom.svg", width=4, height=8)
grid.rect(gp=gpar(col=NA, fill="grey"))
grid.picture(test, expansion=0, y=0, vjust=0)
dev.off()

## Check that aspect ratio is retained if only one of width/height is given
dev("test-wh-width-null.svg", width=4, height=4)
grid.rect(gp=gpar(col=NA, fill="grey"))
grid.picture(test, expansion=0,
             height=.5,
             x=.25, y=.25, hjust=0, vjust=0)
dev.off()

dev("test-wh-height-null.svg", width=4, height=4)
grid.rect(gp=gpar(col=NA, fill="grey"))
grid.picture(test, expansion=0,
             width=.5,
             x=.25, y=.25, hjust=0, vjust=0)
dev.off()

## For sanity, check that setting width and height is respected
dev("test-wh-set.svg", width=4, height=4)
grid.rect(gp=gpar(col=NA, fill="grey"))
grid.picture(test, expansion=0,
             width=.5, height=.5)
dev.off()

dev("test-wh-set-wider.svg", width=4, height=4)
grid.rect(gp=gpar(col=NA, fill="grey"))
grid.picture(test, expansion=0,
             width=1, height=.5)
dev.off()

## Various repetitions allowing distortion
dev("test-wh-set-distort.svg", width=4, height=4)
grid.rect(gp=gpar(col=NA, fill="grey"))
grid.picture(test, expansion=0,
             width=.5, height=.5,
             distort=TRUE)
dev.off()

dev("test-wh-set-wider-distort.svg", width=4, height=4)
grid.rect(gp=gpar(col=NA, fill="grey"))
grid.picture(test, expansion=0,
             width=1, height=.5,
             distort=TRUE)
dev.off()

dev("test-wh-default-wider-distort.svg", width=8, height=4)
grid.rect(gp=gpar(col=NA, fill="grey"))
grid.picture(test, expansion=0,
             distort=TRUE)
dev.off()

dev("test-wh-default-taller-distort.svg", width=4, height=8)
grid.rect(gp=gpar(col=NA, fill="grey"))
grid.picture(test, expansion=0,
             distort=TRUE)
dev.off()

dev("test-wh-width-null-distort.svg", width=4, height=4)
grid.rect(gp=gpar(col=NA, fill="grey"))
grid.picture(test, expansion=0,
             height=.5,
             x=.25, y=.25, hjust=0, vjust=0,
             distort=TRUE)
dev.off()

dev("test-wh-height-null-distort.svg", width=4, height=4)
grid.rect(gp=gpar(col=NA, fill="grey"))
grid.picture(test, expansion=0,
             width=.5,
             x=.25, y=.25, hjust=0, vjust=0,
             distort=TRUE)
dev.off()

###############
modelFiles <- list.files(pattern="^test-wh-.+[.]save")
testFiles <- gsub("[.]save", "", modelFiles)
for (i in seq_along(modelFiles)) {
    model <- readLines(modelFiles[i])[-1]
    test <- readLines(testFiles[i])[-1]
    same <- model == test
    if (! all(same)) {
        stop(paste0("wh output not equal to expected output",
                    "------------------",
                    model[!same],
                    "------------------",
                    test[!same],
                    collapse="\n"))
    }
}