| library(grid) |
| |
| ## Tests for grobCoords() |
| |
| check <- function(coords, model) { |
| stopifnot(isTRUE(all.equal(as.numeric(coords$x), model$x)) && |
| isTRUE(all.equal(as.numeric(coords$y), model$y))) |
| } |
| |
| ## Simple primitive |
| coords <- grobCoords(rectGrob(0, 0, 1, 1, |
| just=c("left", "bottom"), |
| default.units="in"), |
| closed=TRUE) |
| check(coords[[1]], list(x=c(0, 0, 1, 1), y=c(0, 1, 1, 0))) |
| |
| ## Primitives that generate more points than grob description |
| coords <- grobCoords(circleGrob(0, 0, r=unit(1, "in")), n=4, |
| closed=TRUE) |
| check(coords[[1]], list(x=c(1, 0, -1, 0), y=c(0, 1, 0, -1))) |
| |
| coords <- grobCoords(xsplineGrob(c(0, 1, 2), c(0, 1, 0), |
| default.units="in"), |
| closed=FALSE) |
| check(coords[[1]], list(x=c(0, 1, 2), y=c(0, 1, 0))) |
| |
| ## grob with 'id' |
| coords <- grobCoords(polylineGrob(1:4, 1:4, |
| id=rep(1:2, each=2), |
| default.units="in"), |
| closed=FALSE) |
| check(coords[[1]], list(x=1:2, y=1:2)) |
| check(coords[[2]], list(x=3:4, y=3:4)) |
| |
| ## grob with 'pathId' |
| coords <- grobCoords(pathGrob(c(0, 0, 3, 3, 1, 1, 2, 2, 4, 4, 7, 7, 5, 5, 6, 6), |
| c(0, 3, 3, 0, 1, 2, 2, 1, 4, 7, 7, 4, 5, 6, 6, 5), |
| id=rep(rep(1:2, each=4), 2), |
| pathId=rep(1:2, each=8), |
| default.units="in"), |
| closed=TRUE) |
| check(coords[[1]], list(x=c(0, 0, 3, 3), y=c(0, 3, 3, 0))) |
| check(coords[[2]], list(x=c(1, 1, 2, 2), y=c(1, 2, 2, 1))) |
| check(coords[[3]], list(x=c(4, 4, 7, 7), y=c(4, 7, 7, 4))) |
| check(coords[[4]], list(x=c(5, 5, 6, 6), y=c(5, 6, 6, 5))) |
| |
| ## Mostly testing makeContent() |
| coords <- grobCoords(bezierGrob(c(0, 1, 2, 3), c(0, 1, 2, 3), |
| default.units="in"), |
| closed=FALSE) |
| coords <- lapply(coords[[1]], function(x) { x[c(1, length(x))] }) |
| check(coords, list(x=c(0, 3), y=c(0, 3))) |
| |
| ## Text returns a bounding box if closed is TRUE |
| coords <- grobCoords(textGrob("test", 0, 0, just=c("left", "bottom")), |
| closed=TRUE) |
| w <- convertWidth(stringWidth("test"), "in", valueOnly=TRUE) |
| h <- convertHeight(stringHeight("test"), "in", valueOnly=TRUE) |
| check(coords[[1]], list(x=c(0, 0, w, w), y=c(0, h, h, 0))) |
| |
| coords <- grobCoords(textGrob("test"), closed=FALSE) |
| check(coords[[1]], emptyCoords) |
| |
| ## All emptyCoords |
| coords <- grobCoords(moveToGrob(), closed=FALSE) |
| check(coords[[1]], emptyCoords) |
| |
| coords <- grobCoords(lineToGrob(), closed=FALSE) |
| check(coords[[1]], emptyCoords) |
| |
| coords <- grobCoords(nullGrob(), closed=FALSE) |
| check(coords[[1]], emptyCoords) |
| |
| coords <- grobCoords(clipGrob(), closed=FALSE) |
| check(coords[[1]], emptyCoords) |
| |
| coords <- grobCoords(rasterGrob(matrix(1)), closed=FALSE) |
| check(coords[[1]], emptyCoords) |
| |
| ################################# |
| ################################# |
| ## Start a Cairo PNG device to get reliable results |
| png("temp.png", type="cairo") |
| ################################# |
| ################################# |
| |
| ################################# |
| ## Names on coords |
| checkNames <- function(grob, seq, closed=TRUE) { |
| pts <- grobCoords(grob, closed=closed) |
| stopifnot(as.numeric(names(pts)) == seq) |
| } |
| ## Circles |
| grob <- circleGrob(1:2/3) |
| checkNames(grob, 1:2) |
| ## Lines |
| grob <- linesGrob(1:2, 1:2) |
| checkNames(grob, 1, FALSE) |
| ## Polyline |
| grob <- polylineGrob(1:2, 1:2) |
| checkNames(grob, 1, FALSE) |
| grob <- polylineGrob(1:4, 1:4, id=rep(1:2, 2)) |
| checkNames(grob, 1:2, FALSE) |
| ## Polygon |
| grob <- polygonGrob(1:2, 1:2) |
| checkNames(grob, 1) |
| grob <- polygonGrob(1:4, 1:4, id=rep(1:2, 2)) |
| checkNames(grob, 1:2) |
| ## Path |
| grob <- pathGrob(1:2, 1:2) |
| checkNames(grob, 1) |
| grob <- pathGrob(1:4, 1:4, id=rep(1:2, 2)) |
| checkNames(grob, c(1, 1)) |
| grob <- pathGrob(1:4, 1:4, pathId=rep(1:2, 2)) |
| checkNames(grob, 1:2) |
| grob <- pathGrob(1:8, 1:8, id=rep(1:2, 4), pathId=rep(1:2, each=4)) |
| checkNames(grob, c(1, 1, 2, 2)) |
| ## Rects |
| grob <- rectGrob(unit(c(1, 3), "in"), |
| width=unit(1, "in"), height=unit(1, "in")) |
| checkNames(grob, 1:2) |
| ## Segments |
| grob <- segmentsGrob(1:2) |
| checkNames(grob, 1:2, FALSE) |
| ## Xsplines |
| grob <- xsplineGrob(1:2, 1:2) |
| checkNames(grob, 1, FALSE) |
| grob <- xsplineGrob(1:3, 1:3, open=FALSE) |
| checkNames(grob, 1) |
| grob <- xsplineGrob(1:4, 1:4, id=rep(1:2, 2)) |
| checkNames(grob, 1:2, FALSE) |
| grob <- xsplineGrob(1:6, 1:6, id=rep(1:2, 3), open=FALSE) |
| checkNames(grob, 1:2) |
| ## Text |
| grob <- textGrob(1:2) |
| checkNames(grob, 1) |
| |
| ################################# |
| ## Points grobs |
| |
| ## Constants in grid.c |
| SMALL <- 0.25 |
| RADIUS <- 0.375 |
| SQRC <- 0.88622692545275801364 |
| DMDC <- 1.25331413731550025119 |
| TRC0 <- 1.55512030155621416073 |
| TRC1 <- 1.34677368708859836060 |
| TRC2 <- 0.77756015077810708036 |
| |
| ## pch="." |
| grob <- pointsGrob(1:3, 1:3, default.units="in", pch=".") |
| coords <- grobCoords(grob, closed=TRUE) |
| x <- c(.995, .995, 1.005, 1.005) |
| y <- c(.995, 1.005, 1.005, .995) |
| mapply(check, |
| coords, |
| list("1"=list(x=x, y=y), "2"=list(x=x+1, y=y+1), "3"=list(x=x+2, y=y+2))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| ## pch=0 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=0) |
| coords <- grobCoords(grob, closed=TRUE) |
| x <- c(1 - RADIUS, 1 - RADIUS, 1 + RADIUS, 1 + RADIUS) |
| y <- c(1 - RADIUS, 1 + RADIUS, 1 + RADIUS, 1 - RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x, y=y), "2"=list(x=x+1, y=y+1), "3"=list(x=x+2, y=y+2))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| ## pch=1 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=1) |
| coords <- grobCoords(grob, closed=TRUE, n=4) |
| mapply(check, |
| lapply(coords, function(c) list(x=c$x[1], y=c$y[1])), |
| list("1"=list(x=1 + RADIUS, y=1), |
| "2"=list(x=2 + RADIUS, y=2), |
| "3"=list(x=3 + RADIUS, y=3))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| ## pch=2 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=2) |
| coords <- grobCoords(grob, closed=TRUE) |
| x <- c(1, 1 + TRC1*RADIUS, 1 - TRC1*RADIUS) |
| y <- c(1 + TRC0*RADIUS, 1 - TRC2*RADIUS, 1 - TRC2*RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x, y=y), "2"=list(x=x+1, y=y+1), "3"=list(x=x+2, y=y+2))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| ## pch=3 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=3) |
| coords <- grobCoords(grob, closed=TRUE) |
| stopifnot(isEmptyCoords(coords)) |
| coords <- grobCoords(grob, closed=FALSE) |
| x1 <- c(1 - sqrt(2)*RADIUS, 1 + sqrt(2)*RADIUS) |
| y1 <- c(1, 1) |
| x2 <- c(1, 1) |
| y2 <- c(1 - sqrt(2)*RADIUS, 1 + sqrt(2)*RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x1, y=y1), "1"=list(x=x2, y=y2), |
| "2"=list(x=x1+1, y=y1+1), "2"=list(x=x2+1, y=y2+1), |
| "3"=list(x=x1+2, y=y1+2), "3"=list(x=x2+2, y=y2+2))) |
| ## pch=4 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=4) |
| coords <- grobCoords(grob, closed=TRUE) |
| stopifnot(isEmptyCoords(coords)) |
| coords <- grobCoords(grob, closed=FALSE) |
| x1 <- c(1 - RADIUS, 1 + RADIUS) |
| y1 <- c(1 - RADIUS, 1 + RADIUS) |
| x2 <- c(1 - RADIUS, 1 + RADIUS) |
| y2 <- c(1 + RADIUS, 1 - RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x1, y=y1), "1"=list(x=x2, y=y2), |
| "2"=list(x=x1+1, y=y1+1), "2"=list(x=x2+1, y=y2+1), |
| "3"=list(x=x1+2, y=y1+2), "3"=list(x=x2+2, y=y2+2))) |
| ## pch=5 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=5) |
| coords <- grobCoords(grob, closed=TRUE) |
| x <- c(1 - sqrt(2)*RADIUS, 1, 1 + sqrt(2)*RADIUS, 1) |
| y <- c(1, 1 + sqrt(2)*RADIUS, 1, 1 - sqrt(2)*RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x, y=y), "2"=list(x=x+1, y=y+1), "3"=list(x=x+2, y=y+2))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| ## pch=6 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=6) |
| coords <- grobCoords(grob, closed=TRUE) |
| x <- c(1, 1 + TRC1*RADIUS, 1 - TRC1*RADIUS) |
| y <- c(1 - TRC0*RADIUS, 1 + TRC2*RADIUS, 1 + TRC2*RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x, y=y), "2"=list(x=x+1, y=y+1), "3"=list(x=x+2, y=y+2))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| ## pch=7 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=7) |
| coords <- grobCoords(grob, closed=TRUE) |
| x <- c(1 - RADIUS, 1 - RADIUS, 1 + RADIUS, 1 + RADIUS) |
| y <- c(1 - RADIUS, 1 + RADIUS, 1 + RADIUS, 1 - RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x, y=y), "2"=list(x=x+1, y=y+1), "3"=list(x=x+2, y=y+2))) |
| coords <- grobCoords(grob, closed=FALSE) |
| x1 <- c(1 - RADIUS, 1 + RADIUS) |
| y1 <- c(1 - RADIUS, 1 + RADIUS) |
| x2 <- c(1 - RADIUS, 1 + RADIUS) |
| y2 <- c(1 + RADIUS, 1 - RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x1, y=y1), "1"=list(x=x2, y=y2), |
| "2"=list(x=x1+1, y=y1+1), "2"=list(x=x2+1, y=y2+1), |
| "3"=list(x=x1+2, y=y1+2), "3"=list(x=x2+2, y=y2+2))) |
| ## pch=8 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=8) |
| coords <- grobCoords(grob, closed=TRUE) |
| stopifnot(isEmptyCoords(coords)) |
| coords <- grobCoords(grob, closed=FALSE) |
| x1 <- c(1 - RADIUS, 1 + RADIUS) |
| y1 <- c(1 - RADIUS, 1 + RADIUS) |
| x2 <- c(1 - RADIUS, 1 + RADIUS) |
| y2 <- c(1 + RADIUS, 1 - RADIUS) |
| x3 <- c(1 - sqrt(2)*RADIUS, 1 + sqrt(2)*RADIUS) |
| y3 <- c(1, 1) |
| x4 <- c(1, 1) |
| y4 <- c(1 - sqrt(2)*RADIUS, 1 + sqrt(2)*RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x1, y=y1), "1"=list(x=x2, y=y2), |
| "1"=list(x=x3, y=y3), "1"=list(x=x4, y=y4), |
| "2"=list(x=x1+1, y=y1+1), "2"=list(x=x2+1, y=y2+1), |
| "2"=list(x=x3+1, y=y3+1), "2"=list(x=x4+1, y=y4+1), |
| "3"=list(x=x1+2, y=y1+2), "3"=list(x=x2+2, y=y2+2), |
| "3"=list(x=x3+2, y=y3+2), "3"=list(x=x4+2, y=y4+2))) |
| ## pch=9 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=9) |
| coords <- grobCoords(grob, closed=TRUE) |
| x <- c(1 - sqrt(2)*RADIUS, 1, 1 + sqrt(2)*RADIUS, 1) |
| y <- c(1, 1 + sqrt(2)*RADIUS, 1, 1 - sqrt(2)*RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x, y=y), "2"=list(x=x+1, y=y+1), "3"=list(x=x+2, y=y+2))) |
| coords <- grobCoords(grob, closed=FALSE) |
| x1 <- c(1 - sqrt(2)*RADIUS, 1 + sqrt(2)*RADIUS) |
| y1 <- c(1, 1) |
| x2 <- c(1, 1) |
| y2 <- c(1 - sqrt(2)*RADIUS, 1 + sqrt(2)*RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x1, y=y1), "1"=list(x=x2, y=y2), |
| "2"=list(x=x1+1, y=y1+1), "2"=list(x=x2+1, y=y2+1), |
| "3"=list(x=x1+2, y=y1+2), "3"=list(x=x2+2, y=y2+2))) |
| ## pch=10 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=10) |
| coords <- grobCoords(grob, closed=TRUE, n=4) |
| mapply(check, |
| lapply(coords, function(c) list(x=c$x[1], y=c$y[1])), |
| list("1"=list(x=1 + RADIUS, y=1), |
| "2"=list(x=2 + RADIUS, y=2), |
| "3"=list(x=3 + RADIUS, y=3))) |
| coords <- grobCoords(grob, closed=FALSE) |
| x1 <- c(1 - RADIUS, 1 + RADIUS) |
| y1 <- c(1, 1) |
| x2 <- c(1, 1) |
| y2 <- c(1 - RADIUS, 1 + RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x1, y=y1), "1"=list(x=x2, y=y2), |
| "2"=list(x=x1+1, y=y1+1), "2"=list(x=x2+1, y=y2+1), |
| "3"=list(x=x1+2, y=y1+2), "3"=list(x=x2+2, y=y2+2))) |
| ## pch=11 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=11) |
| coords <- grobCoords(grob, closed=TRUE) |
| x1 <- c(1, 1 + TRC1*RADIUS, 1 - TRC1*RADIUS) |
| y1 <- c(1 - TRC0*RADIUS, |
| 1 + .5*(TRC2*RADIUS + TRC0*RADIUS), |
| 1 + .5*(TRC2*RADIUS + TRC0*RADIUS)) |
| x2 <- c(1, 1 + TRC1*RADIUS, 1 - TRC1*RADIUS) |
| y2 <- c(1 + TRC0*RADIUS, |
| 1 - .5*(TRC2*RADIUS + TRC0*RADIUS), |
| 1 - .5*(TRC2*RADIUS + TRC0*RADIUS)) |
| mapply(check, |
| coords, |
| list("1"=list(x=x1, y=y1), "1"=list(x=x2, y=y2), |
| "2"=list(x=x1+1, y=y1+1), "2"=list(x=x2+1, y=y2+1), |
| "3"=list(x=x1+2, y=y1+2), "3"=list(x=x2+2, y=y2+2))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| ## pch=12 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=12) |
| coords <- grobCoords(grob, closed=TRUE) |
| x <- c(1 - RADIUS, 1 - RADIUS, 1 + RADIUS, 1 + RADIUS) |
| y <- c(1 - RADIUS, 1 + RADIUS, 1 + RADIUS, 1 - RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x, y=y), "2"=list(x=x+1, y=y+1), "3"=list(x=x+2, y=y+2))) |
| coords <- grobCoords(grob, closed=FALSE) |
| x1 <- c(1 - RADIUS, 1 + RADIUS) |
| y1 <- c(1, 1) |
| x2 <- c(1, 1) |
| y2 <- c(1 - RADIUS, 1 + RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x1, y=y1), "1"=list(x=x2, y=y2), |
| "2"=list(x=x1+1, y=y1+1), "2"=list(x=x2+1, y=y2+1), |
| "3"=list(x=x1+2, y=y1+2), "3"=list(x=x2+2, y=y2+2))) |
| ## pch=13 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=13) |
| coords <- grobCoords(grob, closed=TRUE, n=4) |
| mapply(check, |
| lapply(coords, function(c) list(x=c$x[1], y=c$y[1])), |
| list("1"=list(x=1 + RADIUS, y=1), |
| "2"=list(x=2 + RADIUS, y=2), |
| "3"=list(x=3 + RADIUS, y=3))) |
| coords <- grobCoords(grob, closed=FALSE) |
| x1 <- c(1 - RADIUS, 1 + RADIUS) |
| y1 <- c(1 - RADIUS, 1 + RADIUS) |
| x2 <- c(1 - RADIUS, 1 + RADIUS) |
| y2 <- c(1 + RADIUS, 1 - RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x1, y=y1), "1"=list(x=x2, y=y2), |
| "2"=list(x=x1+1, y=y1+1), "2"=list(x=x2+1, y=y2+1), |
| "3"=list(x=x1+2, y=y1+2), "3"=list(x=x2+2, y=y2+2))) |
| ## pch=14 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=14) |
| coords <- grobCoords(grob, closed=TRUE) |
| x1 <- c(1 - RADIUS, 1 - RADIUS, 1 + RADIUS, 1 + RADIUS) |
| y1 <- c(1 - RADIUS, 1 + RADIUS, 1 + RADIUS, 1 - RADIUS) |
| x2 <- c(1, 1 + RADIUS, 1 - RADIUS) |
| y2 <- c(1 + RADIUS, 1 - RADIUS, 1 - RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x1, y=y1), "1"=list(x=x2, y=y2), |
| "2"=list(x=x1+1, y=y1+1), "2"=list(x=x2+1, y=y2+1), |
| "3"=list(x=x1+2, y=y1+2), "3"=list(x=x2+2, y=y2+2))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| ## pch=15 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=15) |
| coords <- grobCoords(grob, closed=TRUE) |
| x <- c(1 - RADIUS, 1 + RADIUS, 1 + RADIUS, 1 - RADIUS) |
| y <- c(1 - RADIUS, 1 - RADIUS, 1 + RADIUS, 1 + RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x, y=y), "2"=list(x=x+1, y=y+1), "3"=list(x=x+2, y=y+2))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| ## pch=16 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=16) |
| coords <- grobCoords(grob, closed=TRUE, n=4) |
| mapply(check, |
| lapply(coords, function(c) list(x=c$x[1], y=c$y[1])), |
| list("1"=list(x=1 + RADIUS, y=1), |
| "2"=list(x=2 + RADIUS, y=2), |
| "3"=list(x=3 + RADIUS, y=3))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| ## pch=17 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=17) |
| coords <- grobCoords(grob, closed=TRUE) |
| x <- c(1, 1 + TRC1*RADIUS, 1 - TRC1*RADIUS) |
| y <- c(1 + TRC0*RADIUS, 1 - TRC2*RADIUS, 1 - TRC2*RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x, y=y), "2"=list(x=x+1, y=y+1), "3"=list(x=x+2, y=y+2))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| ## pch=18 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=18) |
| coords <- grobCoords(grob, closed=TRUE) |
| x <- c(1 - RADIUS, 1, 1 + RADIUS, 1) |
| y <- c(1, 1 + RADIUS, 1, 1 - RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x, y=y), "2"=list(x=x+1, y=y+1), "3"=list(x=x+2, y=y+2))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| ## pch=19 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=19) |
| coords <- grobCoords(grob, closed=TRUE, n=4) |
| mapply(check, |
| lapply(coords, function(c) list(x=c$x[1], y=c$y[1])), |
| list("1"=list(x=1 + RADIUS, y=1), |
| "2"=list(x=2 + RADIUS, y=2), |
| "3"=list(x=3 + RADIUS, y=3))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| ## pch=20 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=20) |
| coords <- grobCoords(grob, closed=TRUE, n=4) |
| mapply(check, |
| lapply(coords, function(c) list(x=c$x[1], y=c$y[1])), |
| list("1"=list(x=1 + SMALL, y=1), |
| "2"=list(x=2 + SMALL, y=2), |
| "3"=list(x=3 + SMALL, y=3))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| ## pch=21 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=21) |
| coords <- grobCoords(grob, closed=TRUE) |
| mapply(check, |
| lapply(coords, function(c) list(x=c$x[1], y=c$y[1])), |
| list(list(x=1 + RADIUS, y=1), |
| list(x=2 + RADIUS, y=2), |
| list(x=3 + RADIUS, y=3))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| ## pch=22 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=22) |
| coords <- grobCoords(grob, closed=TRUE) |
| x <- c(1 - RADIUS*SQRC, 1 - RADIUS*SQRC, 1 + RADIUS*SQRC, 1 + RADIUS*SQRC) |
| y <- c(1 - RADIUS*SQRC, 1 + RADIUS*SQRC, 1 + RADIUS*SQRC, 1 - RADIUS*SQRC) |
| mapply(check, |
| coords, |
| list("1"=list(x=x, y=y), "2"=list(x=x+1, y=y+1), "3"=list(x=x+2, y=y+2))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| ## pch=23 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=23) |
| coords <- grobCoords(grob, closed=TRUE) |
| x <- c(1, 1 + RADIUS*DMDC, 1, 1 - RADIUS*DMDC) |
| y <- c(1 - RADIUS*DMDC, 1, 1 + RADIUS*DMDC, 1) |
| mapply(check, |
| coords, |
| list("1"=list(x=x, y=y), "2"=list(x=x+1, y=y+1), "3"=list(x=x+2, y=y+2))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| ## pch=24 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=24) |
| coords <- grobCoords(grob, closed=TRUE) |
| x <- c(1, 1 + TRC1*RADIUS, 1 - TRC1*RADIUS) |
| y <- c(1 + TRC0*RADIUS, 1 - TRC2*RADIUS, 1 - TRC2*RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x, y=y), "2"=list(x=x+1, y=y+1), "3"=list(x=x+2, y=y+2))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| ## pch=25 |
| grob <- pointsGrob(1:3, 1:3, size=unit(1, "in"), default.units="in", pch=25) |
| coords <- grobCoords(grob, closed=TRUE) |
| x <- c(1, 1 + TRC1*RADIUS, 1 - TRC1*RADIUS) |
| y <- c(1 - TRC0*RADIUS, 1 + TRC2*RADIUS, 1 + TRC2*RADIUS) |
| mapply(check, |
| coords, |
| list("1"=list(x=x, y=y), "2"=list(x=x+1, y=y+1), "3"=list(x=x+2, y=y+2))) |
| coords <- grobCoords(grob, closed=FALSE) |
| stopifnot(isEmptyCoords(coords)) |
| |
| ################################# |
| ## coords from gTrees |
| ## gridCoords(c(.2, .2, .8, .8), c(.2, .8, .8, .2)) |
| ## gridPoints(list(gridCoords(c(.2, .2, .8, .8), c(.2, .8, .8, .2)), |
| ## gridCoords(c(.4, .4, .6, .6), c(.4, .6, .6, .4)))) |
| gtCheck <- function(x, y) { |
| stopifnot(identical(x, y)) |
| } |
| x <- c(.5, .5, 1.5, 1.5) |
| y <- c(.5, 1.5, 1.5, .5) |
| gtCheck(grobPoints(rectGrob(1, 1, 1, 1, default.units="in", name="r"), |
| closed=TRUE), |
| gridGrobCoords(list("1"=gridCoords(x, y)), "r")) |
| gtCheck(grobPoints(rectGrob(1:2, 1, 1, 1, |
| default.units="in", name="r"), |
| closed=TRUE), |
| gridGrobCoords(list("1"=gridCoords(x, y), |
| "2"=gridCoords(x + 1, y)), |
| "r")) |
| gtCheck(grobPoints(linesGrob(1:2, 1:2, default.units="in", name="l"), |
| closed=FALSE), |
| gridGrobCoords(list("1"=gridCoords(1:2, 1:2)), "l")) |
| gtCheck(grobPoints(polylineGrob(1:2, 1:2, default.units="in", name="pl"), |
| closed=FALSE), |
| gridGrobCoords(list("1"=gridCoords(1:2, 1:2)), "pl")) |
| gtCheck(grobPoints(polylineGrob(1:4, 1:4, id=rep(1:2, each=2), |
| default.units="in", name="pl"), |
| closed=FALSE), |
| gridGrobCoords(list("1"=gridCoords(1:2, 1:2), |
| "2"=gridCoords(3:4, 3:4)), "pl")) |
| gtCheck(grobPoints(polygonGrob(1:2, 1:2, default.units="in", name="p"), |
| closed=TRUE), |
| gridGrobCoords(list("1"=gridCoords(1:2, 1:2)), "p")) |
| gtCheck(grobPoints(polygonGrob(1:4, 1:4, id=rep(1:2, each=2), |
| default.units="in", name="p"), |
| closed=TRUE), |
| gridGrobCoords(list("1"=gridCoords(1:2, 1:2), |
| "2"=gridCoords(3:4, 3:4)), "p")) |
| gtCheck(grobPoints(pathGrob(1:2, 1:2, default.units="in", name="p"), |
| closed=TRUE), |
| gridGrobCoords(list("1"=gridCoords(1:2, 1:2)), "p", "winding")) |
| gtCheck(grobPoints(pathGrob(1:4, 1:4, id=rep(1:2, each=2), |
| default.units="in", name="p"), |
| closed=TRUE), |
| gridGrobCoords(list("1"=gridCoords(1:2, 1:2), |
| "1"=gridCoords(3:4, 3:4)), "p", "winding")) |
| gtCheck(grobPoints(pathGrob(1:4, 1:4, pathId=rep(1:2, each=2), |
| default.units="in", name="p"), |
| closed=TRUE), |
| gridGrobCoords(list("1"=gridCoords(1:2, 1:2), |
| "2"=gridCoords(3:4, 3:4)), "p", "winding")) |
| gtCheck(grobPoints(pathGrob(1:8, 1:8, id=rep(rep(1:2, each=2), 2), |
| pathId=rep(1:2, each=4), |
| default.units="in", name="p"), |
| closed=TRUE), |
| gridGrobCoords(list("1"=gridCoords(1:2, 1:2), |
| "1"=gridCoords(3:4, 3:4), |
| "2"=gridCoords(5:6, 5:6), |
| "2"=gridCoords(7:8, 7:8)), |
| "p", "winding")) |
| gtCheck(grobPoints(segmentsGrob(1:2, 1, 3, 2, default.units="in", name="s"), |
| closed=FALSE), |
| gridGrobCoords(list("1"=gridCoords(c(1, 3), 1:2), |
| "2"=gridCoords(c(2, 3), 1:2)), "s")) |
| x <- c(.5, .5, 1.5, 1.5) |
| y <- c(.5, 1.5, 1.5, .5) |
| r <- function(i) { |
| rectGrob(1, 1, 1, 1, default.units="in", name=paste0("r", i)) |
| } |
| r1 <- r(1) |
| r2 <- r(2) |
| r3 <- r(3) |
| gc <- function(i) { |
| gridGrobCoords(list("1"=gridCoords(x, y)), paste0("r", i)) |
| } |
| gc1 <- gc(1) |
| gc2 <- gc(2) |
| gc3 <- gc(3) |
| gtCheck(grobPoints(gTree(children=gList(r1), name="gt1"), closed=TRUE), |
| gridGTreeCoords(list(gc1), "gt1")) |
| gtCheck(grobPoints(gTree(children=gList(r1, r2), name="gt1"), closed=TRUE), |
| gridGTreeCoords(list(gc1, gc2), |
| "gt1")) |
| gtCheck(grobPoints(gTree(children=gList(r1, |
| gTree(children=gList(r2), name="gt2"), |
| r3), |
| name="gt1"), closed=TRUE), |
| gridGTreeCoords(list(gc1, |
| gridGTreeCoords(list(gc2), "gt2"), |
| gc3), |
| "gt1")) |
| gtCheck(grobPoints(gTree(children=gList(gTree(children=gList(r1), |
| name="gt2")), |
| name="gt1"), |
| closed=TRUE), |
| gridGTreeCoords(list(gridGTreeCoords(list(gc1), "gt2")), "gt1")) |
| stopifnot(isEmptyCoords(grobPoints(gTree()))) |
| stopifnot(isEmptyCoords(grobPoints(gTree(children=gList(segmentsGrob(0, 0:1, |
| 1, 1:0))), |
| closed=TRUE))) |
| |
| ################################# |
| ################################# |
| ## Close PNG device |
| dev.off() |
| ################################# |
| ################################# |
