x <- c(0.25, 0.25, 0.75, 0.75)
y <- c(0.25, 0.75, 0.75, 0.25)
xsplineTest <- function(s, i, j, open) {
pushViewport(viewport(layout.pos.col=j, layout.pos.row=i))
grid.points(x, y, default.units="npc", pch=16, size=unit(2, "mm"))
grid.xspline(x, y, shape=s, open=open, gp=gpar(fill="grey"))
grid.text(s, gp=gpar(col="grey"),
x=unit(x, "npc") + unit(c(-1, -1, 1, 1), "mm"),
y=unit(y, "npc") + unit(c(-1, 1, 1, -1), "mm"),
hjust=c(1, 1, 0, 0),
vjust=c(1, 0, 0, 1))
popViewport()
}
pushViewport(viewport(width=.5, x=0, just="left",
layout=grid.layout(3, 3, respect=TRUE)))
pushViewport(viewport(layout.pos.row=1))
grid.text("Open Splines", y=1, just="bottom")
popViewport()
xsplineTest(c(0, -1, -1, 0), 1, 1, TRUE)
xsplineTest(c(0, -1, 0, 0), 1, 2, TRUE)
xsplineTest(c(0, -1, 1, 0), 1, 3, TRUE)
xsplineTest(c(0, 0, -1, 0), 2, 1, TRUE)
xsplineTest(c(0, 0, 0, 0), 2, 2, TRUE)
xsplineTest(c(0, 0, 1, 0), 2, 3, TRUE)
xsplineTest(c(0, 1, -1, 0), 3, 1, TRUE)
xsplineTest(c(0, 1, 0, 0), 3, 2, TRUE)
xsplineTest(c(0, 1, 1, 0), 3, 3, TRUE)
popViewport()
pushViewport(viewport(width=.5, x=1, just="right",
layout=grid.layout(3, 3, respect=TRUE)))
pushViewport(viewport(layout.pos.row=1))
grid.text("Closed Splines", y=1, just="bottom")
popViewport()
xsplineTest(c(-1, -1, -1, -1), 1, 1, FALSE)
xsplineTest(c(-1, -1, 0, -1), 1, 2, FALSE)
xsplineTest(c(-1, -1, 1, -1), 1, 3, FALSE)
xsplineTest(c( 0, 0, -1, 0), 2, 1, FALSE)
xsplineTest(c( 0, 0, 0, 0), 2, 2, FALSE)
xsplineTest(c( 0, 0, 1, 0), 2, 3, FALSE)
xsplineTest(c( 1, 1, -1, 1), 3, 1, FALSE)
xsplineTest(c( 1, 1, 0, 1), 3, 2, FALSE)
xsplineTest(c( 1, 1, 1, 1), 3, 3, FALSE)
popViewport()
Run the code above in your browser using DataLab