/usr/lib/R/site-library/gtable/tests/test-subsetting.r is in r-cran-gtable 0.1.2-1.1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 | context("Subsetting")
base <- gtable(unit(rep(1, 3), "null"), unit(rep(1, 3), "null"))
rownames(base) <- LETTERS[1:3]
colnames(base) <- letters[1:3]
test_that("dimensions correct after subsetting", {
expect_equal(dim(base[, ]), c(3, 3))
expect_equal(dim(base[1:3, 1:3]), c(3, 3))
expect_equal(dim(base[T, T]), c(3, 3))
expect_equal(dim(base[c("A", "B", "C"), c("a", "b", "c")]), c(3, 3))
expect_equal(dim(base[1, 1]), c(1, 1))
expect_equal(dim(base[c(T, F, F), c(T, F, F)]), c(1, 1))
expect_equal(dim(base[-(2:3), -(2:3)]), c(1, 1))
expect_equal(dim(base["A", "b"]), c(1, 1))
expect_equal(dim(base[1:2, 2:3]), c(2, 2))
})
rect <- rectGrob()
mid <- gtable_add_grob(base, rect, 2, 2)
row <- gtable_add_grob(base, rect, 2, l = 1, r = 3)
col <- gtable_add_grob(base, rect, 2, t = 1, b = 3)
tlbr <- function(x) unname(unlist(x$layout[c("t", "l", "b", "r")]))
test_that("grobs moved to correct location", {
expect_equal(tlbr(mid[2, 2]), c(1, 1, 1, 1))
expect_equal(tlbr(mid[2:3, 2:3]), c(1, 1, 1, 1))
expect_equal(tlbr(mid[1:2, 1:2]), c(2, 2, 2, 2))
expect_equal(tlbr(mid[1:3, 1:3]), c(2, 2, 2, 2))
})
test_that("spanning grobs kept if ends kept", {
expect_equal(length(row[, -2]), 1)
expect_equal(tlbr(row[, -2]), c(2, 1, 2, 2))
expect_equal(length(col[-2, ]), 1)
expect_equal(tlbr(col[-2, ]), c(1, 2, 2, 2))
expect_equal(length(row[, 1]), 0)
expect_equal(length(col[1, ]), 0)
})
# Detailed tests for indexing with [.gtable ----------------------------------
# Some of these tests can be confusing; if you need to see
# what's going on, run grid.draw(gt)
# Make a bunch of grobs
g1 <- rectGrob()
g2 <- circleGrob()
g3 <- polygonGrob()
g4 <- linesGrob()
g5 <- circleGrob()
g6 <- rectGrob()
# Check that two gtable objects are the same.
# This allows for differences in how units are stored and other subtle
# changes that don't affect appearance.
equal_gtable <- function(a, b) {
require(plyr)
identical(a$grobs, b$grobs) &&
# Normalized z values are the same (ensuring same render order)
# Also ignore row names
all.equal(unrowname(z_normalise(a)$layout),
unrowname(z_normalise(b)$layout)) &&
# Test widths/heights for equality.
# This is the best way I could think of, but it's not very nice
all(convertUnit(a$widths - b$widths, "cm", valueOnly = TRUE) == 0) &&
all(convertUnit(a$heights - b$heights, "cm", valueOnly = TRUE) == 0) &&
all.equal(a$respect, b$respect) &&
all.equal(a$rownames, b$rownames) &&
all.equal(a$colnames, b$colnames)
}
# This will create a new gtable made with gtable_matrix
# using the specified cols and rows from grobmat.
# The sizes of the rows/cols are the same as the index values (but in cm)
make_gt <- function(grobmat, rows, cols) {
gtable_matrix("test", grobmat[rows, cols, drop = FALSE],
heights=unit(rows, "cm"), widths=unit(cols, "cm") )
}
test_that("Indexing with single-cell grobs", {
# Make a 2x3 gtable where each cell has one grob
grobmat <- matrix(list(g1, g2, g3, g4, g5, g6), nrow=2)
gt <- make_gt(grobmat, 1:2, 1:3)
# Indexing in ways that don't change gt
expect_true(equal_gtable(gt, gt[1:2, 1:3]))
expect_true(equal_gtable(gt, gt[]))
expect_true(equal_gtable(gt, gt[1:2, ]))
expect_true(equal_gtable(gt, gt[, 1:3]))
# New table from contiguous cells
expect_true(equal_gtable(gt[1, 1], make_gt(grobmat, 1, 1)))
expect_true(equal_gtable(gt[2, 2], make_gt(grobmat, 2, 2)))
expect_true(equal_gtable(gt[1:2, 1], make_gt(grobmat, 1:2, 1)))
expect_true(equal_gtable(gt[1:2, 2], make_gt(grobmat, 1:2, 2)))
expect_true(equal_gtable(gt[1, 1:3], make_gt(grobmat, 1, 1:3)))
expect_true(equal_gtable(gt[1, 1:2], make_gt(grobmat, 1, 1:2)))
expect_true(equal_gtable(gt[1:2, 1:2], make_gt(grobmat, 1:2, 1:2)))
expect_true(equal_gtable(gt[1:2, 2:3], make_gt(grobmat, 1:2, 2:3)))
# New table from non-contiguous cells
expect_true(equal_gtable(gt[1, c(1, 3)], make_gt(grobmat, 1, c(1, 3))))
expect_true(equal_gtable(gt[1:2, c(1, 3)], make_gt(grobmat, 1:2, c(1, 3))))
})
test_that("Indexing with names", {
# Make a 2x3 gtable where each cell has one grob
grobmat <- matrix(list(g1, g2, g3, g4, g5, g6), nrow=2)
gt <- make_gt(grobmat, 1:2, 1:3)
dimnames(gt) <- list(c("a","b"), c("x","y","z"))
expect_true(equal_gtable(gt, gt[c("a","b"), c("x","y","z")]))
expect_true(equal_gtable(gt[1, ], gt["a", ]))
expect_true(equal_gtable(gt[, 2], gt[, "y"]))
expect_true(equal_gtable(gt[, 2:3], gt[, c("y","z")]))
expect_true(equal_gtable(gt[1, 1:2], gt["a", c("x","y")]))
expect_true(equal_gtable(gt[1, 1:2], gt["a", 1:2]))
})
# Make a gtable with grobs that span cells
make_span_gt <- function(rows, cols) {
# Make gtable with one grob at (1:1, 1:3) and another at (1:2, 1:2)
gt <- gtable(name = "test",
heights=unit(rows, "cm"), widths=unit(cols, "cm") )
if (all(1 %in% rows) && all(c(1,3) %in% cols)) {
gt <- gtable_add_grob(gt, g3, 1, 1, 1, length(cols))
}
if (all(1:2 %in% rows) && all(c(1,2) %in% cols)) {
gt <- gtable_add_grob(gt, g4, 1, 1, 2, 2)
}
gt
}
test_that("Indexing with grobs that span cells", {
# Make a gtable with two grobs that span cells
gt <- make_span_gt(1:2, 1:3)
# Indexing in ways that don't change gt
expect_true(equal_gtable(gt, gt[1:2, 1:3]))
# If a cell at the end of a grob is dropped, drop the grob
# These should drop all grobs
expect_true(equal_gtable(gt[1, 2], make_span_gt(1, 2)))
expect_equal(length(gt[1, 2]$grobs), 0)
expect_true(equal_gtable(gt[1:2, 2], make_span_gt(1:2, 2)))
expect_equal(length(gt[1:2, 2]$grobs), 0)
# These should preserve one of the grobs
expect_true(equal_gtable(gt[1:2, 1:2], make_span_gt(1:2, 1:2)))
expect_equal(length(gt[1:2, 1:2]$grobs), 1)
expect_true(equal_gtable(gt[1, 1:3], make_span_gt(1, 1:3)))
expect_equal(length(gt[1, 1:3]$grobs), 1)
# If a cell in the middle of a grob is dropped, don't drop the grob
expect_true(equal_gtable(gt[1, c(1,3)], make_span_gt(1, c(1,3))))
expect_equal(length(gt[1, c(1,3)]$grobs), 1)
# Currently undefined behavior:
# What happens when you do repeat rows/cols, like gt[1, c(1,1,1,3)] ?
# What happens when order is non-monotonic, like gt[1, c(3,1,2)] ?
})
|