599 lines
23 KiB
R
599 lines
23 KiB
R
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()
|
|
#################################
|
|
#################################
|