BiomedEngX/CircosHeatmap-aardio
2
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases 3 Wiki Activity
CircosHeatmap-aardio/dist/lib/r/site-library/grid/tests/coords.R
freefire 8b0f368c7e 首次上传
2025-01-12 00:52:51 +08:00

599 lines
23 KiB
R
Raw Blame History

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()
#################################
#################################
Reference in New Issue View Git Blame Copy Permalink