[med-svn] [r-cran-gtable] 11/14: New upstream version 0.2.0
Andreas Tille
tille at debian.org
Fri Sep 29 07:23:00 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-gtable.
commit 6bd5afd2e4e569d8be9a932dabaf3b3ef989a9e2
Author: Andreas Tille <tille at debian.org>
Date: Fri Sep 29 09:20:41 2017 +0200
New upstream version 0.2.0
---
DESCRIPTION | 19 +++
MD5 | 45 +++++++
NAMESPACE | 36 ++++++
NEWS.md | 21 ++++
R/add-grob.r | 69 +++++++++++
R/add-rows-cols.r | 85 +++++++++++++
R/add-space.r | 44 +++++++
R/align.r | 119 ++++++++++++++++++
R/filter.r | 30 +++++
R/grid.r | 81 ++++++++++++
R/gtable-layouts.r | 136 +++++++++++++++++++++
R/gtable.r | 258 +++++++++++++++++++++++++++++++++++++++
R/padding.r | 29 +++++
R/rbind-cbind.r | 85 +++++++++++++
R/trim.r | 36 ++++++
R/utils.r | 72 +++++++++++
R/z.r | 45 +++++++
README.md | 7 ++
debian/README.Debian | 7 --
debian/README.test | 9 --
debian/changelog | 22 ----
debian/compat | 1 -
debian/control | 27 ----
debian/copyright | 28 -----
debian/docs | 4 -
debian/rules | 7 --
debian/source/format | 1 -
debian/tests/control | 3 -
debian/tests/run-unit-test | 11 --
debian/upstream/metadata | 7 --
debian/watch | 3 -
man/bind.Rd | 29 +++++
man/gtable.Rd | 116 ++++++++++++++++++
man/gtable_add_cols.Rd | 41 +++++++
man/gtable_add_grob.Rd | 40 ++++++
man/gtable_add_padding.Rd | 32 +++++
man/gtable_add_rows.Rd | 41 +++++++
man/gtable_add_space.Rd | 24 ++++
man/gtable_col.Rd | 40 ++++++
man/gtable_filter.Rd | 43 +++++++
man/gtable_height.Rd | 15 +++
man/gtable_matrix.Rd | 54 ++++++++
man/gtable_row.Rd | 40 ++++++
man/gtable_show_layout.Rd | 15 +++
man/gtable_spacer.Rd | 21 ++++
man/gtable_trim.Rd | 32 +++++
man/gtable_width.Rd | 15 +++
man/is.gtable.Rd | 15 +++
man/print.gtable.Rd | 19 +++
man/z_arrange_gtables.Rd | 22 ++++
man/z_normalise.Rd | 23 ++++
tests/testthat.R | 4 +
tests/testthat/Rplots.pdf | Bin 0 -> 3830 bytes
tests/testthat/helper-grobs.r | 5 +
tests/testthat/helper-units.r | 6 +
tests/testthat/test-bind.r | 34 ++++++
tests/testthat/test-layout.r | 154 +++++++++++++++++++++++
tests/testthat/test-subsetting.r | 183 +++++++++++++++++++++++++++
tests/testthat/test-z-order.r | 82 +++++++++++++
59 files changed, 2362 insertions(+), 130 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..0d43d50
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,19 @@
+Package: gtable
+Version: 0.2.0
+Title: Arrange 'Grobs' in Tables
+Description: Tools to make it easier to work with "tables" of 'grobs'.
+Authors at R: person("Hadley", "Wickham", , "hadley at rstudio.com", c("aut", "cre"))
+Depends: R (>= 2.14)
+Imports: grid
+Suggests: testthat, covr
+License: GPL-2
+Collate: 'add-grob.r' 'add-rows-cols.r' 'add-space.r' 'grid.r'
+ 'gtable-layouts.r' 'gtable.r' 'rbind-cbind.r' 'utils.r'
+ 'trim.r' 'filter.r' 'align.r' 'padding.r' 'z.r'
+RoxygenNote: 5.0.1
+NeedsCompilation: no
+Packaged: 2016-02-26 13:06:10 UTC; hadley
+Author: Hadley Wickham [aut, cre]
+Maintainer: Hadley Wickham <hadley at rstudio.com>
+Repository: CRAN
+Date/Publication: 2016-02-26 15:23:14
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..222b06c
--- /dev/null
+++ b/MD5
@@ -0,0 +1,45 @@
+834c2d74c10a205f7cc75e6d11a27437 *DESCRIPTION
+24953d6374fd57d6378ea80fc6e5d0a3 *NAMESPACE
+1739646c3828af237b0f19a478cffe97 *NEWS.md
+aa2d8709ce2b301b8ea881d3496fcf55 *R/add-grob.r
+c1425f3b373b0599bf3fa011a7c0556d *R/add-rows-cols.r
+6b08411d0f18bb3dde965d4ab5386da9 *R/add-space.r
+7dfc1ac440b155a85bafc89afe132fca *R/align.r
+d48fb44491240e37551ba41efc82f05b *R/filter.r
+8ee72ad011f0aeefac64f7ba2901ef87 *R/grid.r
+4d96b8d175bf678993ba1040787a9702 *R/gtable-layouts.r
+18986f2b1e7299b2bace2103a1f1a354 *R/gtable.r
+1d01fb56456d45bac11d2a4dcbe05802 *R/padding.r
+06795e1197e28f1bb5744498dba02390 *R/rbind-cbind.r
+4b0ac4a9825b044026e7876424c55bd7 *R/trim.r
+dd8dd039d5b71ccca2668f927acb68d2 *R/utils.r
+1d504b5fcc6c82b8e7e8aa299b215581 *R/z.r
+397255a4b35061779dd5f6c6cd629b8f *README.md
+40f82d8bf9184dfd7122db82f5fa433a *man/bind.Rd
+0a42b01e10d3117d37fbc230e8e6f971 *man/gtable.Rd
+831fed7c891354b2aafc4cc663f4c4f1 *man/gtable_add_cols.Rd
+ec2648c0df22ac8b384592e45214e3ef *man/gtable_add_grob.Rd
+01199e8e89d1abd1c4f513fb2f97506f *man/gtable_add_padding.Rd
+207a726839308e7793d49c65fb7b5077 *man/gtable_add_rows.Rd
+73648b7763f5b73af715cb7f9967030a *man/gtable_add_space.Rd
+a50fc29dfc159bf448a19b94deeba398 *man/gtable_col.Rd
+bf87b34e484fabf5b21d9cf2f5ee2970 *man/gtable_filter.Rd
+d40446b4cf809b989d7b1c8a10928f1f *man/gtable_height.Rd
+5327269a58767b4e4f945eaa973f8781 *man/gtable_matrix.Rd
+05db7f3774dc814808bae44b9bb9aa89 *man/gtable_row.Rd
+cda657bddd395e10142bc824b719ad86 *man/gtable_show_layout.Rd
+77752908335dba386d9b07df474c16cb *man/gtable_spacer.Rd
+4e30951dac9d1c7c7ca803de9ee45249 *man/gtable_trim.Rd
+04428210fe7c892ed5917831884d7e4d *man/gtable_width.Rd
+0c1353fe67a0c7225d471f7e205141f5 *man/is.gtable.Rd
+08b8d71ed27f60e8cb5714d76accce10 *man/print.gtable.Rd
+be91124ea54f780027bec87ba0048d1f *man/z_arrange_gtables.Rd
+3e4c814df6dcb53c34872add3907309a *man/z_normalise.Rd
+3d2bbcf840223423f0471d741a6a33da *tests/testthat.R
+b3e512f11e296324c3f4ef75991a3d13 *tests/testthat/Rplots.pdf
+c3b9c9e87a6e6c5e4b63fcb87a909a15 *tests/testthat/helper-grobs.r
+c3e0b00fedce833baccb19f1941b714f *tests/testthat/helper-units.r
+c315b57f2b0397beb11679f27448019d *tests/testthat/test-bind.r
+9f95edcd48968ecf13d4a288ec9c256e *tests/testthat/test-layout.r
+750bb81e504099eb456d5802d2eb6cb8 *tests/testthat/test-subsetting.r
+322fd392f79b8e530830af4f80799997 *tests/testthat/test-z-order.r
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..5af29f1
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,36 @@
+# Generated by roxygen2: do not edit by hand
+
+S3method("[",gtable)
+S3method("dimnames<-",gtable)
+S3method(cbind,gtable)
+S3method(dim,gtable)
+S3method(dimnames,gtable)
+S3method(heightDetails,gtable)
+S3method(length,gtable)
+S3method(makeContent,gtable)
+S3method(makeContext,gTableChild)
+S3method(makeContext,gtable)
+S3method(plot,gtable)
+S3method(print,gtable)
+S3method(rbind,gtable)
+S3method(t,gtable)
+S3method(widthDetails,gtable)
+export(gtable)
+export(gtable_add_col_space)
+export(gtable_add_cols)
+export(gtable_add_grob)
+export(gtable_add_padding)
+export(gtable_add_row_space)
+export(gtable_add_rows)
+export(gtable_col)
+export(gtable_col_spacer)
+export(gtable_filter)
+export(gtable_height)
+export(gtable_matrix)
+export(gtable_row)
+export(gtable_row_spacer)
+export(gtable_show_layout)
+export(gtable_trim)
+export(gtable_width)
+export(is.gtable)
+import(grid)
diff --git a/NEWS.md b/NEWS.md
new file mode 100644
index 0000000..a36a5ec
--- /dev/null
+++ b/NEWS.md
@@ -0,0 +1,21 @@
+# gtable 0.2.0
+
+* Switch from `preDrawDetails()` and `postDrawDetails()` methods to
+ `makeContent()` and `makeContext()` methods (@pmur002, #50).
+ This is a better approach facilitiated by changes in grid. Learn more
+ at <https://journal.r-project.org/archive/2013-2/murrell.pdf>.
+
+* Added a `NEWS.md` file to track changes to the package.
+
+* Partial argument matches have been fixed.
+
+* Import grid instead of depending on it.
+
+# gtable 0.1.2
+
+* `print.gtable` now prints the z order of the grobs, and it no longer
+ sort the names by z order. Previously, the layout names were sorted by
+ z order, but the grobs weren't. This resulted in a mismatch between
+ the names and the grobs. It's better to not sort by z by default,
+ since that doesn't match how indexing works. The `zsort` option allows
+ the output to be sorted by z.
diff --git a/R/add-grob.r b/R/add-grob.r
new file mode 100644
index 0000000..5f1d5fa
--- /dev/null
+++ b/R/add-grob.r
@@ -0,0 +1,69 @@
+#' Add a single grob, possibly spanning multiple rows or columns.
+#'
+#' This only adds grobs into the table - it doesn't affect the table in
+#' any way. In the gtable model, grobs always fill up the complete table
+#' cell. If you want custom justification you might need to
+#'
+#' @param x a \code{\link{gtable}} object
+#' @param grobs a single grob or a list of grobs
+#' @param t a numeric vector giving the top extent of the grobs
+#' @param l a numeric vector giving the left extent of the grobs
+#' @param b a numeric vector giving the bottom extent of the grobs
+#' @param r a numeric vector giving the right extent of the grobs
+#' @param z a numeric vector giving the order in which the grobs should be
+#' plotted. Use \code{Inf} (the default) to plot above or \code{-Inf}
+#' below all existing grobs. By default positions are on the integers,
+#' giving plenty of room to insert new grobs between existing grobs.
+#' @param clip should drawing be clipped to the specified cells
+#' (\code{"on"}), the entire table (\code{"inherit"}), or not at all
+#' (\code{"off"})
+#' @param name name of the grob - used to modify the grob name before it's
+#' plotted.
+#' @export
+gtable_add_grob <- function(x, grobs, t, l, b = t, r = l, z = Inf, clip = "on", name = x$name)
+{
+ stopifnot(is.gtable(x))
+ if (is.grob(grobs)) grobs <- list(grobs)
+ stopifnot(is.list(grobs))
+
+ # Check that inputs have the right length
+ if(!all(vapply(list(t, r, b, l, z, clip, name), len_same_or_1,
+ logical(1), grobs))) {
+ stop("Not all inputs have either length 1 or same length same as 'grobs'")
+ }
+
+ # If z is just one value, replicate to same length as grobs
+ if (length(z) == 1) {
+ z <- rep(z, length(grobs))
+ }
+
+ # Get the existing z values from x$layout, and new non-Inf z-values
+ zval <- c(x$layout$z, z[!is.infinite(z)])
+ if (length(zval) == 0) {
+ # If there are no existing finite z values, set these so that
+ # -Inf values get assigned ..., -2, -1, 0 and
+ # +Inf values get assigned 1, 2, 3, ...
+ zmin <- 1
+ zmax <- 0
+ } else {
+ zmin <- min(zval)
+ zmax <- max(zval)
+ }
+ z[z == -Inf] <- zmin - rev(seq_len(sum(z == -Inf)))
+ z[z == Inf] <- zmax + seq_len(sum(z == Inf))
+
+ t <- neg_to_pos(t, nrow(x))
+ b <- neg_to_pos(b, nrow(x))
+ l <- neg_to_pos(l, ncol(x))
+ r <- neg_to_pos(r, ncol(x))
+
+ layout <- data.frame(t = t, l = l, b = b, r = r, z = z,
+ clip = clip, name = name,
+ stringsAsFactors = FALSE)
+ stopifnot(length(grobs) == nrow(layout))
+
+ x$grobs <- c(x$grobs, grobs)
+ x$layout <- rbind(x$layout, layout)
+
+ x
+}
diff --git a/R/add-rows-cols.r b/R/add-rows-cols.r
new file mode 100644
index 0000000..c4fac2b
--- /dev/null
+++ b/R/add-rows-cols.r
@@ -0,0 +1,85 @@
+#' Add new rows in specified position.
+#'
+#' @param x a \code{\link{gtable}} object
+#' @param heights a unit vector giving the heights of the new rows
+#' @param pos new row will be added below this position. Defaults to
+#' adding row on bottom. \code{0} adds on the top.
+#' @export
+#' @examples
+#' library(grid)
+#' rect <- rectGrob(gp = gpar(fill = "#00000080"))
+#' tab <- gtable(unit(rep(1, 3), "null"), unit(rep(1, 3), "null"))
+#' tab <- gtable_add_grob(tab, rect, t = 1, l = 1, r = 3)
+#' tab <- gtable_add_grob(tab, rect, t = 1, b = 3, l = 1)
+#' tab <- gtable_add_grob(tab, rect, t = 1, b = 3, l = 3)
+#' dim(tab)
+#' plot(tab)
+#'
+#' # Grobs will continue to span over new rows if added in the middle
+#' tab2 <- gtable_add_rows(tab, unit(1, "null"), 1)
+#' dim(tab2)
+#' plot(tab2)
+#'
+#' # But not when added to top (0) or bottom (-1, the default)
+#' tab3 <- gtable_add_rows(tab, unit(1, "null"))
+#' tab3 <- gtable_add_rows(tab3, unit(1, "null"), 0)
+#' dim(tab3)
+#' plot(tab3)
+gtable_add_rows <- function(x, heights, pos = -1) {
+ stopifnot(is.gtable(x))
+ stopifnot(length(pos) == 1)
+ n <- length(heights)
+
+ pos <- neg_to_pos(pos, nrow(x))
+
+ # Shift existing rows down
+ x$heights <- insert.unit(x$heights, heights, pos)
+ x$layout$t <- ifelse(x$layout$t > pos, x$layout$t + n, x$layout$t)
+ x$layout$b <- ifelse(x$layout$b > pos, x$layout$b + n, x$layout$b)
+
+ x
+}
+
+#' Add new columns in specified position.
+#'
+#' @param x a \code{\link{gtable}} object
+#' @param widths a unit vector giving the widths of the new columns
+#' @param pos new row will be added below this position. Defaults to
+#' adding col on right. \code{0} adds on the left.
+#' @export
+#' @examples
+#' library(grid)
+#' rect <- rectGrob(gp = gpar(fill = "#00000080"))
+#' tab <- gtable(unit(rep(1, 3), "null"), unit(rep(1, 3), "null"))
+#' tab <- gtable_add_grob(tab, rect, t = 1, l = 1, r = 3)
+#' tab <- gtable_add_grob(tab, rect, t = 1, b = 3, l = 1)
+#' tab <- gtable_add_grob(tab, rect, t = 1, b = 3, l = 3)
+#' dim(tab)
+#' plot(tab)
+#'
+#' # Grobs will continue to span over new rows if added in the middle
+#' tab2 <- gtable_add_cols(tab, unit(1, "null"), 1)
+#' dim(tab2)
+#' plot(tab2)
+#'
+#' # But not when added to left (0) or right (-1, the default)
+#' tab3 <- gtable_add_cols(tab, unit(1, "null"))
+#' tab3 <- gtable_add_cols(tab3, unit(1, "null"), 0)
+#' dim(tab3)
+#' plot(tab3)
+gtable_add_cols <- function(x, widths, pos = -1) {
+ stopifnot(is.gtable(x))
+ stopifnot(length(pos) == 1)
+ n <- length(widths)
+
+ pos <- neg_to_pos(pos, ncol(x))
+
+ # Shift existing columns right
+ x$widths <- insert.unit(x$widths, widths, pos)
+ x$layout$l <- ifelse(x$layout$l > pos, x$layout$l + n, x$layout$l)
+ x$layout$r <- ifelse(x$layout$r > pos, x$layout$r + n, x$layout$r)
+
+ x
+}
+
+
diff --git a/R/add-space.r b/R/add-space.r
new file mode 100644
index 0000000..eaa1a93
--- /dev/null
+++ b/R/add-space.r
@@ -0,0 +1,44 @@
+#' Add row/column spacing.
+#'
+#' Adds \code{width} space between the columns or \code{height} space between
+#' the rows.
+#'
+#' @name gtable_add_space
+#' @param x a gtable object
+NULL
+
+#' @param width a vector of units of length 1 or ncol - 1
+#' @export
+#' @rdname gtable_add_space
+gtable_add_col_space <- function(x, width) {
+ stopifnot(is.gtable(x))
+ n <- ncol(x) - 1
+ if (n == 0) return(x)
+
+ stopifnot(length(width) == 1 || length(width) == n)
+ width <- rep(width, length.out = n)
+
+ for(i in rev(seq_len(n))) {
+ x <- gtable_add_cols(x, width[i], pos = i)
+ }
+
+ x
+}
+
+#' @param height a vector of units of length 1 or nrow - 1
+#' @export
+#' @rdname gtable_add_space
+gtable_add_row_space <- function(x, height) {
+ stopifnot(is.gtable(x))
+ n <- nrow(x) - 1
+ if (n == 0) return(x)
+
+ stopifnot(length(height) == 1 || length(height) == n)
+ height <- rep(height, length.out = n)
+
+ for(i in rev(seq_len(n))) {
+ x <- gtable_add_rows(x, height[i], pos = i)
+ }
+
+ x
+}
diff --git a/R/align.r b/R/align.r
new file mode 100644
index 0000000..d968ee1
--- /dev/null
+++ b/R/align.r
@@ -0,0 +1,119 @@
+# Code does not currently work - need to thinking about how indexing a gtable
+# should work in more detail. How do the grobs move around?
+
+# Join two gtables together based on row/column names.
+#
+# @inheritParams gtable_align
+# @param along dimension to align along, \code{1} = rows, \code{2} = cols.
+# Join will occur perpendicular to this direction.
+# @examples
+# rect <- rectGrob(gp = gpar(fill = "black"))
+# circ <- circleGrob(gp = gpar(fill = "red"))
+# a <- gtable_col("a", list(rect, circ), width = unit(5, "cm"))
+# rownames(a) <- c("top", "mid")
+# b <- gtable_col("b", list(circ, rect), width = unit(5, "cm"))
+# rownames(b) <- c("mid", "bot")
+#
+# # Commented out example below because it causes R CMD check to fail
+# # when this function is not exported. Uncomment when this function
+# # is fixed and exported again.
+# # gtable_join(a, b)
+gtable_join <- function(x, y, along = 1L, join = "left") {
+ aligned <- gtable_align(x, y, along = along, join = join)
+ switch(along,
+ cbind(aligned$x, aligned$y),
+ rbind(aligned$x, aligned$y),
+ stop("along > 2 no implemented"))
+}
+
+# Align two gtables based on their row/col names.
+#
+# @param x \code{\link{gtable}}
+# @param y \code{\link{gtable}}
+# @param along dimension to align along, \code{1} = rows, \code{2} = cols.
+# @param join when x and y have different names, how should the difference
+# be resolved? \code{inner} keep names that appear in both, \code{outer}
+# keep names that appear in either, \code{left} keep names from \code{x},
+# and \code{right} keep names from \code{y}.
+# @seealso \code{\link{gtable_join}} to return the two gtables combined
+# in to a single gtable.
+# @return a list with elements \code{x} and \code{y} corresponding to the
+# input gtables with extra rows/columns so that they now align.
+gtable_align <- function(x, y, along = 1L, join = "left") {
+ join <- match.arg(join, c("left", "right", "inner", "outer"))
+
+ names_x <- dimnames(x)[[along]]
+ names_y <- dimnames(y)[[along]]
+
+ if (is.null(names_x) || is.null(names_y)) {
+ stop("Both gtables must have names along dimension to be aligned")
+ }
+
+ idx <- switch(join,
+ left = names_x,
+ right = names_y,
+ inner = intersect(names_x, names_y),
+ outer = union(names_x, names_y)
+ )
+
+ list(
+ x = gtable_reindex(x, idx, along),
+ y = gtable_reindex(y, idx, along)
+ )
+}
+
+# Reindex a gtable.
+#
+# @keywords internal
+# @examples
+# gt <- gtable(heights = unit(rep(1, 3), "cm"), rownames = c("a", "b", "c"))
+# rownames(gtable:::gtable_reindex(gt, c("a", "b", "c")))
+# rownames(gtable:::gtable_reindex(gt, c("a", "b")))
+# rownames(gtable:::gtable_reindex(gt, c("a")))
+# rownames(gtable:::gtable_reindex(gt, c("a", "d", "e")))
+gtable_reindex <- function(x, index, along = 1) {
+ stopifnot(is.character(index))
+ if (length(dim(x)) > 2L || along > 2L) {
+ stop("reindex only supports 2d objects")
+ }
+ old_index <- switch(along, rownames(x), colnames(x))
+ stopifnot(!is.null(old_index))
+
+ if (identical(index, old_index)) {
+ return(x)
+ }
+
+ if (!(old_index %contains% index)) {
+ missing <- setdiff(index, old_index)
+ # Create and add dummy space rows
+
+ if (along == 1L) {
+ spacer <- gtable(
+ widths = unit(rep(0, ncol(x)), "cm"),
+ heights = rep_along(unit(0, "cm"), missing),
+ rownames = missing)
+ x <- rbind(x, spacer, size = "first")
+ } else if (along == 2L){
+ spacer <- gtable(
+ heights = unit(rep(0, nrow(x)), "cm"),
+ widths = rep_along(unit(0, "cm"), missing),
+ colnames = missing)
+
+ x <- cbind(x, spacer, size = "first")
+ }
+ }
+
+
+ # Reorder & subset
+
+ switch(along,
+ x[index, ],
+ x[, index])
+}
+
+"%contains%" <- function(x, y) all(y %in% x)
+
+rep_along <- function(x, y) {
+ if (length(y) == 0) return(NULL)
+ rep(x, length(y))
+}
diff --git a/R/filter.r b/R/filter.r
new file mode 100644
index 0000000..414d30b
--- /dev/null
+++ b/R/filter.r
@@ -0,0 +1,30 @@
+#' Filter cells by name.
+#'
+#' @param x a gtable object
+#' @inheritParams base::grepl
+#' @param trim if \code{TRUE}, \code{\link{gtable_trim}} will be used to trim
+#' off any empty cells.
+#' @export
+#' @examples
+#' library(grid)
+#' gt <- gtable(unit(rep(5, 3), c("cm")), unit(5, "cm"))
+#' rect <- rectGrob(gp = gpar(fill = "black"))
+#' circ <- circleGrob(gp = gpar(fill = "red"))
+#'
+#' gt <- gtable_add_grob(gt, rect, 1, 1, name = "rect")
+#' gt <- gtable_add_grob(gt, circ, 1, 3, name = "circ")
+#'
+#' plot(gtable_filter(gt, "rect"))
+#' plot(gtable_filter(gt, "rect", trim = FALSE))
+#' plot(gtable_filter(gt, "circ"))
+#' plot(gtable_filter(gt, "circ", trim = FALSE))
+gtable_filter <- function(x, pattern, fixed = FALSE, trim = TRUE) {
+
+ matches <- grepl(pattern, x$layout$name, fixed = fixed)
+ x$layout <- x$layout[matches, , drop = FALSE]
+ x$grobs <- x$grobs[matches]
+
+ if (trim) x <- gtable_trim(x)
+
+ x
+}
diff --git a/R/grid.r b/R/grid.r
new file mode 100644
index 0000000..96caec7
--- /dev/null
+++ b/R/grid.r
@@ -0,0 +1,81 @@
+#' Visualise the layout of a gtable.
+#'
+#' @export
+#' @param x a gtable object
+gtable_show_layout <- function(x) {
+ stopifnot(is.gtable(x))
+
+ grid.show.layout(gtable_layout(x))
+}
+
+gtable_layout <- function(x) {
+ stopifnot(is.gtable(x))
+
+ grid.layout(
+ nrow = nrow(x), heights = x$heights,
+ ncol = ncol(x), widths = x$widths,
+ respect = x$respect
+ )
+}
+
+vpname <- function(row) {
+ paste(row$name, ".", row$t, "-", row$r, "-", row$b, "-", row$l, sep = "")
+}
+
+#' @export
+widthDetails.gtable <- function(x) absolute.size(gtable_width(x))
+
+#' @export
+heightDetails.gtable <- function(x) absolute.size(gtable_height(x))
+
+#' @export
+makeContext.gtable <- function(x) {
+ layoutvp <- viewport(layout = gtable_layout(x), name = x$name)
+ if (is.null(x$vp)) {
+ x$vp <- layoutvp
+ } else {
+ x$vp <- vpStack(x$vp, layoutvp)
+ }
+ x
+}
+
+#' @export
+makeContent.gtable <- function(x) {
+ children_vps <- mapply(child_vp,
+ vp_name = vpname(x$layout),
+ t = x$layout$t, r = x$layout$r,
+ b = x$layout$b, l = x$layout$l,
+ clip = x$layout$clip,
+ SIMPLIFY = FALSE)
+ x$grobs <- mapply(wrap_gtableChild, x$grobs, children_vps,
+ SIMPLIFY = FALSE)
+ setChildren(x, do.call("gList", x$grobs[order(x$layout$z)]))
+}
+
+#' @export
+makeContext.gTableChild <- function(x) {
+ if (is.null(x$vp)) {
+ x$vp <- x$wrapvp
+ } else {
+ x$vp <- vpStack(x$wrapvp, x$vp)
+ }
+ # A gTableChild extends an arbitrary grob class
+ # so allow existing makeContext() behaviour of
+ # original grob class to still occur
+ NextMethod()
+}
+
+# Return the viewport for a child grob in a gtable
+child_vp <- function(vp_name, t, r, b, l, clip) {
+ viewport(name = vp_name, layout.pos.row = t:b,
+ layout.pos.col = l:r, clip = clip)
+}
+
+# Turn a grob into a gtableChild, and store information about the
+# viewport used within the gtable
+wrap_gtableChild <- function(grob, vp) {
+ grob$wrapvp <- vp
+ grob$name <- vp$name
+ class(grob) <- c("gTableChild", class(grob))
+ grob
+}
diff --git a/R/gtable-layouts.r b/R/gtable-layouts.r
new file mode 100644
index 0000000..8af20cd
--- /dev/null
+++ b/R/gtable-layouts.r
@@ -0,0 +1,136 @@
+#' Create a single column gtable.
+#'
+#' @inheritParams gtable
+#' @inheritParams gtable_add_grob
+#' @param width a unit vector giving the width of this column
+#' @param vp a grid viewport object (or NULL).
+#' @export
+#' @examples
+#' library(grid)
+#' a <- rectGrob(gp = gpar(fill = "red"))
+#' b <- circleGrob()
+#' c <- linesGrob()
+#' gt <- gtable_col("demo", list(a, b, c))
+#' gt
+#' plot(gt)
+#' gtable_show_layout(gt)
+gtable_col <- function(name, grobs, width = NULL, heights = NULL,
+ z = NULL, vp = NULL) {
+ width <- width %||% unit(max(unlist(lapply(grobs, width_cm))), "cm")
+ heights <- heights %||% rep(unit(1, "null"), length(grobs))
+
+ # z is either NULL, or a vector of the same length as grobs
+ stopifnot(is.null(z) || length(z) == length(grobs))
+ if (is.null(z))
+ z <- Inf
+
+ table <- gtable(name = name, vp = vp)
+
+ table <- gtable_add_rows(table, heights)
+ table <- gtable_add_cols(table, width)
+ table <- gtable_add_grob(table, grobs, t = seq_along(grobs), l = 1,
+ z = z, clip = "off")
+
+ table
+}
+
+#' Create a single row gtable.
+#'
+#' @inheritParams gtable
+#' @inheritParams gtable_add_grob
+#' @param height a unit vector giving the height of this row
+#' @param vp a grid viewport object (or NULL).
+#' @export
+#' @examples
+#' library(grid)
+#' a <- rectGrob(gp = gpar(fill = "red"))
+#' b <- circleGrob()
+#' c <- linesGrob()
+#' gt <- gtable_row("demo", list(a, b, c))
+#' gt
+#' plot(gt)
+#' gtable_show_layout(gt)
+gtable_row <- function(name, grobs, height = NULL, widths = NULL,
+ z = NULL, vp = NULL) {
+ height <- height %||% unit(max(unlist(lapply(grobs, height_cm))), "cm")
+ widths <- widths %||% rep(unit(1, "null"), length(grobs))
+
+ # z is either NULL, or a vector of the same length as grobs
+ stopifnot(is.null(z) || length(z) == length(grobs))
+ if (is.null(z))
+ z <- Inf
+
+ table <- gtable(name = name, vp = vp)
+
+ table <- gtable_add_cols(table, widths)
+ table <- gtable_add_rows(table, height)
+ table <- gtable_add_grob(table, grobs, l = seq_along(grobs), t = 1,
+ z = z, clip = "off")
+
+ table
+}
+
+#' Create a gtable from a matrix of grobs.
+#'
+#' @export
+#' @inheritParams gtable
+#' @inheritParams gtable_add_grob
+#' @param z a numeric matrix of the same dimensions as \code{grobs},
+#' specifying the order that the grobs are drawn.
+#' @param vp a grid viewport object (or NULL).
+#' @examples
+#' library(grid)
+#' a <- rectGrob(gp = gpar(fill = "red"))
+#' b <- circleGrob()
+#' c <- linesGrob()
+#'
+#' row <- matrix(list(a, b, c), nrow = 1)
+#' col <- matrix(list(a, b, c), ncol = 1)
+#' mat <- matrix(list(a, b, c, nullGrob()), nrow = 2)
+#'
+#' gtable_matrix("demo", row, unit(c(1, 1, 1), "null"), unit(1, "null"))
+#' gtable_matrix("demo", col, unit(1, "null"), unit(c(1, 1, 1), "null"))
+#' gtable_matrix("demo", mat, unit(c(1, 1), "null"), unit(c(1, 1), "null"))
+#'
+#' # Can specify z ordering
+#' z <- matrix(c(3, 1, 2, 4), nrow = 2)
+#' gtable_matrix("demo", mat, unit(c(1, 1), "null"), unit(c(1, 1), "null"), z = z)
+gtable_matrix <- function(name, grobs, widths = NULL, heights = NULL,
+ z = NULL, respect = FALSE, clip = "on", vp = NULL) {
+
+ table <- gtable(name = name, respect = respect, vp = vp)
+
+ stopifnot(length(widths) == ncol(grobs))
+ stopifnot(length(heights) == nrow(grobs))
+ # z is either NULL or a matrix of the same dimensions as grobs
+ stopifnot(is.null(z) || identical(dim(grobs), dim(z)))
+ if (is.null(z))
+ z <- Inf
+
+ table <- gtable_add_cols(table, widths)
+ table <- gtable_add_rows(table, heights)
+
+ table <- gtable_add_grob(table, grobs, t = c(row(grobs)), l = c(col(grobs)),
+ z = as.vector(z), clip = clip)
+
+ table
+}
+
+#' Create a row/col spacer gtable.
+#'
+#' @name gtable_spacer
+NULL
+
+#' @param widths unit vector of widths
+#' @rdname gtable_spacer
+#' @export
+gtable_row_spacer <- function(widths) {
+ gtable_add_cols(gtable(), widths)
+}
+
+#' @param heights unit vector of heights
+#' @rdname gtable_spacer
+#' @export
+gtable_col_spacer <- function(heights) {
+ gtable_add_rows(gtable(), heights)
+}
diff --git a/R/gtable.r b/R/gtable.r
new file mode 100644
index 0000000..9a137f6
--- /dev/null
+++ b/R/gtable.r
@@ -0,0 +1,258 @@
+#' gtable
+#'
+#' @import grid
+#' @docType package
+#' @name gtable
+NULL
+
+#' Create a new grob table.
+#'
+#' A grob table captures all the information needed to layout grobs in a table
+#' structure. It supports row and column spanning, offers some tools to
+#' automatically figure out the correct dimensions, and makes it easy to
+#' align and combine multiple tables.
+#'
+#' Each grob is put in its own viewport - grobs in the same location are
+#' not combined into one cell. Each grob takes up the entire cell viewport
+#' so justification control is not available.
+#'
+#' It constructs both the viewports and the gTree needed to display the table.
+#'
+#' @section Components:
+#'
+#' There are three basics components to a grob table: the specification of
+#' table (cell heights and widths), the layout (for each grob, its position,
+#' name and other settings), and global parameters.
+#'
+#' It's easier to understand how \code{gtable} works if in your head you keep
+#' the table separate from it's contents. Each cell can have 0, 1, or many
+#' grobs inside. Each grob must belong to at least one cell, but can span
+#' across many cells.
+#'
+#' @section Layout:
+#'
+#' The layout details are stored in a data frame with one row for each grob,
+#' and columns:
+#'
+#' \itemize{
+#' \item \code{t} top extent of grob
+#' \item \code{r} right extent of grob
+#' \item \code{b} bottom extent of
+#' \item \code{l} left extent of grob
+#' \item \code{z} the z-order of the grob - used to reorder the grobs
+#' before they are rendered
+#' \item \code{clip} a string, specifying how the grob should be clipped:
+#' either \code{"on"}, \code{"off"} or \code{"inherit"}
+#' \item \code{name}, a character vector used to name each grob and its
+#' viewport
+#' }
+#'
+#' You should not need to modify this data frame directly - instead use
+#' functions like \code{gtable_add_grob}.
+#'
+#' @param widths a unit vector giving the width of each column
+#' @param heights a unit vector giving the height of each row
+#' @param respect a logical vector of length 1: should the aspect ratio of
+#' height and width specified in null units be respected. See
+#' \code{\link{grid.layout}} for more details
+#' @param name a string giving the name of the table. This is used to name
+#' the layout viewport
+#' @param rownames,colnames character vectors of row and column names, used
+#' for characteric subsetting, particularly for \code{gtable_align},
+#' and \code{gtable_join}.
+#' @param vp a grid viewport object (or NULL).
+#' @export
+#' @aliases gtable-package
+#' @seealso \code{\link{gtable_row}}, \code{\link{gtable_col}} and
+#' \code{\link{gtable_matrix}} for convenient ways of creating gtables.
+#' @examples
+#' library(grid)
+#' a <- gtable(unit(1:3, c("cm")), unit(5, "cm"))
+#' a
+#' gtable_show_layout(a)
+#'
+#' # Add a grob:
+#' rect <- rectGrob(gp = gpar(fill = "black"))
+#' a <- gtable_add_grob(a, rect, 1, 1)
+#' a
+#' plot(a)
+#'
+#' # gtables behave like matrices:
+#' dim(a)
+#' t(a)
+#' plot(t(a))
+#'
+#' # when subsetting, grobs are retained if their extents lie in the
+#' # rows/columns that retained.
+#'
+#' b <- gtable(unit(c(2, 2, 2), "cm"), unit(c(2, 2, 2), "cm"))
+#' b <- gtable_add_grob(b, rect, 2, 2)
+#' b[1, ]
+#' b[, 1]
+#' b[2, 2]
+#'
+#' # gtable have row and column names
+#' rownames(b) <- 1:3
+#' rownames(b)[2] <- 200
+#' colnames(b) <- letters[1:3]
+#' dimnames(b)
+gtable <- function(widths = list(), heights = list(), respect = FALSE,
+ name = "layout", rownames = NULL, colnames = NULL, vp = NULL) {
+
+ if (length(widths) > 0) {
+ stopifnot(is.unit(widths))
+ stopifnot(is.null(colnames) || length(colnames == length(widths)))
+ }
+ if (length(heights) > 0) {
+ stopifnot(is.unit(heights))
+ stopifnot(is.null(rownames) || length(rownames == length(heights)))
+ }
+
+ layout <- data.frame(
+ t = numeric(), l = numeric(), b = numeric(), r = numeric(), z = numeric(),
+ clip = character(), name = character(), stringsAsFactors = FALSE)
+
+ if (!is.null(vp)) {
+ vp <- viewport(name = name,
+ x = vp$x, y = vp$y,
+ width = vp$width, height = vp$height,
+ just = vp$just, gp = vp$gp, xscale = vp$xscale,
+ yscale = vp$yscale, angle = vp$angle, clip = vp$clip)
+ }
+
+ gTree(
+ grobs = list(), layout = layout, widths = widths,
+ heights = heights, respect = respect, name = name,
+ rownames = rownames, colnames = colnames, vp = vp,
+ cl = "gtable")
+}
+
+#' Print a gtable object
+#'
+#' @param x A gtable object.
+#' @param zsort Sort by z values? Default \code{FALSE}.
+#' @param ... Other arguments (not used by this method).
+#' @export
+#' @method print gtable
+print.gtable <- function(x, zsort = FALSE, ...) {
+ cat("TableGrob (", nrow(x), " x ", ncol(x), ") \"", x$name, "\": ",
+ length(x$grobs), " grobs\n", sep = "")
+
+ if (nrow(x$layout) == 0) return()
+
+ pos <- as.data.frame(format(as.matrix(x$layout[c("t", "r", "b", "l")])),
+ stringsAsFactors = FALSE)
+ grobNames <- vapply(x$grobs, as.character, character(1))
+
+ info <- data.frame(
+ z = x$layout$z,
+ cells = paste("(", pos$t, "-", pos$b, ",", pos$l, "-", pos$r, ")", sep =""),
+ name = x$layout$name,
+ grob = grobNames
+ )
+ if (zsort) info <- info[order(x$layout$z), ]
+
+ print(info)
+}
+
+
+#' @export
+dim.gtable <- function(x) c(length(x$heights), length(x$widths))
+
+#' @export
+dimnames.gtable <- function(x, ...) list(x$rownames, x$colnames)
+
+#' @export
+"dimnames<-.gtable" <- function(x, value) {
+ x$rownames <- value[[1]]
+ x$colnames <- value[[2]]
+
+ if (anyDuplicated(x$rownames)) stop("rownames must be distinct",
+ call. = FALSE)
+ if (anyDuplicated(x$colnames)) stop("colnames must be distinct",
+ call. = FALSE)
+
+ x
+}
+
+#' @export
+plot.gtable <- function(x, ...) {
+ grid.newpage()
+ grid.rect(gp = gpar(fill = "grey95"))
+ grid <- seq(0, 1, length = 20)
+ grid.grill(h = grid, v = grid, gp = gpar(col = "white"))
+ grid.draw(x)
+}
+
+#' Is this a gtable?
+#'
+#' @param x object to test
+#' @export
+is.gtable <- function(x) {
+ inherits(x, "gtable")
+}
+
+#' @export
+t.gtable <- function(x) {
+ new <- x
+
+ new$layout$t <- x$layout$l
+ new$layout$r <- x$layout$b
+ new$layout$b <- x$layout$r
+ new$layout$l <- x$layout$t
+
+ new$widths <- x$heights
+ new$heights <- x$widths
+
+ new
+}
+
+#' @export
+"[.gtable" <- function(x, i, j) {
+ # Convert indicies to (named) numeric
+ rows <- stats::setNames(seq_along(x$heights), rownames(x))[i]
+ cols <- stats::setNames(seq_along(x$widths), colnames(x))[j]
+
+ i <- seq_along(x$heights) %in% seq_along(x$heights)[rows]
+ j <- seq_along(x$widths) %in% seq_along(x$widths)[cols]
+
+ x$heights <- x$heights[rows]
+ x$rownames <- x$rownames[rows]
+ x$widths <- x$widths[cols]
+ x$colnames <- x$colnames[cols]
+
+ keep <- x$layout$t %in% rows & x$layout$b %in% rows &
+ x$layout$l %in% cols & x$layout$r %in% cols
+ x$grobs <- x$grobs[keep]
+
+ adj_rows <- cumsum(!i)
+ adj_cols <- cumsum(!j)
+
+ x$layout$r <- x$layout$r - adj_cols[x$layout$r]
+ x$layout$l <- x$layout$l - adj_cols[x$layout$l]
+ x$layout$t <- x$layout$t - adj_rows[x$layout$t]
+ x$layout$b <- x$layout$b - adj_rows[x$layout$b]
+
+ # Drop the unused rows from layout
+ x$layout <- x$layout[keep, ]
+ x
+}
+
+#' @export
+length.gtable <- function(x) length(x$grobs)
+
+#' Returns the height of a gtable, in the gtable's units
+#'
+#' Note that unlike heightDetails.gtable, this can return relative units.
+#'
+#' @param x A gtable object
+#' @export
+gtable_height <- function(x) sum(x$heights)
+
+#' Returns the width of a gtable, in the gtable's units
+#'
+#' Note that unlike widthDetails.gtable, this can return relative units.
+#'
+#' @param x A gtable object
+#' @export
+gtable_width <- function(x) sum(x$widths)
diff --git a/R/padding.r b/R/padding.r
new file mode 100644
index 0000000..f19b193
--- /dev/null
+++ b/R/padding.r
@@ -0,0 +1,29 @@
+#' Add padding around edges of table.
+#'
+#' @param x a \code{\link{gtable}} object
+#' @param padding vector of length 4: top, right, bottom, left. Normal
+#' recycling rules apply.
+#' @export
+#' @examples
+#' library(grid)
+#' gt <- gtable(unit(1, "null"), unit(1, "null"))
+#' gt <- gtable_add_grob(gt, rectGrob(gp = gpar(fill = "black")), 1, 1)
+#'
+#' plot(gt)
+#' plot(cbind(gt, gt))
+#' plot(rbind(gt, gt))
+#'
+#' pad <- gtable_add_padding(gt, unit(1, "cm"))
+#' plot(pad)
+#' plot(cbind(pad, pad))
+#' plot(rbind(pad, pad))
+gtable_add_padding <- function(x, padding) {
+ padding <- rep(padding, length.out = 4)
+
+ x <- gtable_add_rows(x, pos = 0, heights = padding[1])
+ x <- gtable_add_cols(x, pos = -1, widths = padding[2])
+ x <- gtable_add_rows(x, pos = -1, heights = padding[3])
+ x <- gtable_add_cols(x, pos = 0, widths = padding[4])
+ x
+}
+
diff --git a/R/rbind-cbind.r b/R/rbind-cbind.r
new file mode 100644
index 0000000..38adae8
--- /dev/null
+++ b/R/rbind-cbind.r
@@ -0,0 +1,85 @@
+#' Row and column binding for gtables.
+#'
+#' @param ... gtables to combine (\code{x} and \code{y})
+#' @param size How should the widths (for rbind) and the heights (for cbind)
+#' be combined across the gtables: take values from \code{first},
+#' or \code{last} gtable, or compute the \code{min} or \code{max} values.
+#' Defaults to \code{max}.
+#' @param z A numeric vector indicating the relative z values of each gtable.
+#' The z values of each object in the resulting gtable will be modified
+#' to fit this order. If \code{NULL}, then the z values of obects within
+#' each gtable will not be modified.
+#' @name bind
+NULL
+
+#' @rdname bind
+#' @method rbind gtable
+#' @export
+rbind.gtable <- function(..., size = "max", z = NULL) {
+ gtables <- list(...)
+ if (!is.null(z)) {
+ gtables <- z_arrange_gtables(gtables, z)
+ }
+ Reduce(function(x, y) rbind_gtable(x, y, size = size), gtables)
+}
+
+rbind_gtable <- function(x, y, size = "max") {
+ stopifnot(ncol(x) == ncol(y))
+ if (nrow(x) == 0) return(y)
+ if (nrow(y) == 0) return(x)
+
+ y$layout$t <- y$layout$t + nrow(x)
+ y$layout$b <- y$layout$b + nrow(x)
+ x$layout <- rbind(x$layout, y$layout)
+
+ x$heights <- insert.unit(x$heights, y$heights)
+ x$rownames <- c(x$rownames, y$rownames)
+
+ size <- match.arg(size, c("first", "last", "max", "min"))
+ x$widths <- switch(size,
+ first = x$widths,
+ last = y$widths,
+ min = compare_unit(x$widths, y$widths, pmin),
+ max = compare_unit(x$widths, y$widths, pmax)
+ )
+
+ x$grobs <- append(x$grobs, y$grobs)
+
+ x
+}
+
+#' @rdname bind
+#' @method cbind gtable
+#' @export
+cbind.gtable <- function(..., size = "max", z = NULL) {
+ gtables <- list(...)
+ if (!is.null(z)) {
+ gtables <- z_arrange_gtables(gtables, z)
+ }
+ Reduce(function(x, y) cbind_gtable(x, y, size = size), gtables)
+}
+
+cbind_gtable <- function(x, y, size = "max") {
+ stopifnot(nrow(x) == nrow(y))
+ if (ncol(x) == 0) return(y)
+ if (ncol(y) == 0) return(x)
+
+ y$layout$l <- y$layout$l + ncol(x)
+ y$layout$r <- y$layout$r + ncol(x)
+ x$layout <- rbind(x$layout, y$layout)
+
+ x$widths <- insert.unit(x$widths, y$widths)
+ x$colnames <- c(x$colnames, y$colnames)
+
+ size <- match.arg(size, c("first", "last", "max", "min"))
+ x$heights <- switch(size,
+ first = x$heights,
+ last = y$heights,
+ min = compare_unit(x$heights, y$heights, pmin),
+ max = compare_unit(x$heights, y$heights, pmax)
+ )
+
+ x$grobs <- append(x$grobs, y$grobs)
+
+ x
+}
diff --git a/R/trim.r b/R/trim.r
new file mode 100644
index 0000000..72964d8
--- /dev/null
+++ b/R/trim.r
@@ -0,0 +1,36 @@
+#' Trim off empty cells.
+#'
+#' @param x a gtable object
+#' @export
+#' @examples
+#' library(grid)
+#' rect <- rectGrob(gp = gpar(fill = "black"))
+#' base <- gtable(unit(c(2, 2, 2), "cm"), unit(c(2, 2, 2), "cm"))
+#'
+#' center <- gtable_add_grob(base, rect, 2, 2)
+#' plot(center)
+#' plot(gtable_trim(center))
+#'
+#' col <- gtable_add_grob(base, rect, 1, 2, 3, 2)
+#' plot(col)
+#' plot(gtable_trim(col))
+#'
+#' row <- gtable_add_grob(base, rect, 2, 1, 2, 3)
+#' plot(row)
+#' plot(gtable_trim(row))
+gtable_trim <- function(x) {
+ stopifnot(is.gtable(x))
+
+ w <- range(x$layout$l, x$layout$r)
+ h <- range(x$layout$t, x$layout$b)
+
+ x$widths <- x$widths[seq.int(w[1], w[2])]
+ x$heights <- x$heights[seq.int(h[1], h[2])]
+
+ x$layout$l <- x$layout$l - w[1] + 1
+ x$layout$r <- x$layout$r - w[1] + 1
+ x$layout$t <- x$layout$t - h[1] + 1
+ x$layout$b <- x$layout$b - h[1] + 1
+
+ x
+}
diff --git a/R/utils.r b/R/utils.r
new file mode 100644
index 0000000..0a3034a
--- /dev/null
+++ b/R/utils.r
@@ -0,0 +1,72 @@
+
+neg_to_pos <- function(x, max) {
+ ifelse(x >= 0, x, max + 1 + x)
+}
+
+compare_unit <- function(x, y, comp = `=`) {
+ if (length(x) == 0) return(y)
+ if (length(y) == 0) return(x)
+
+ x_val <- unclass(x)
+ y_val <- unclass(y)
+
+ x_unit <- attr(x, "unit")
+ y_unit <- attr(x, "unit")
+
+ if (!all(x_unit == y_unit)) {
+ stop("Comparison of units with different types currently not supported")
+ }
+
+ unit(comp(x_val, y_val), x_unit)
+}
+
+
+insert.unit <- function (x, values, after = length(x)) {
+ lengx <- length(x)
+ if (lengx == 0) return(values)
+ if (length(values) == 0) return(x)
+
+ if (after <= 0) {
+ unit.c(values, x)
+ } else if (after >= lengx) {
+ unit.c(x, values)
+ } else {
+ unit.c(x[1L:after], values, x[(after + 1L):lengx])
+ }
+}
+
+"%||%" <- function(a, b) {
+ if (!is.null(a)) a else b
+}
+
+width_cm <- function(x) {
+ if (is.grob(x)) {
+ convertWidth(grobWidth(x), "cm", TRUE)
+ } else if (is.list(x)) {
+ vapply(x, width_cm, numeric(1))
+ } else if (is.unit(x)) {
+ convertWidth(x, "cm", TRUE)
+ } else {
+ stop("Unknown input")
+ }
+}
+height_cm <- function(x) {
+ if (is.grob(x)) {
+ convertWidth(grobHeight(x), "cm", TRUE)
+ } else if (is.list(x)) {
+ vapply(x, height_cm, numeric(1))
+ } else if (is.unit(x)) {
+ convertHeight(x, "cm", TRUE)
+ } else {
+ stop("Unknown input")
+ }
+}
+
+# Check that x is same length as g, or length 1
+len_same_or_1 <- function(x, g) {
+ if(length(x) == 1 || length(x) == length(g)) {
+ TRUE
+ } else {
+ FALSE
+ }
+}
diff --git a/R/z.r b/R/z.r
new file mode 100644
index 0000000..103aafa
--- /dev/null
+++ b/R/z.r
@@ -0,0 +1,45 @@
+#' Normalise z values within a gtable object
+#'
+#' The z values within a gtable object can be any numeric values.
+#' This function will change them to integers (starting from 1),
+#' preserving the original order.
+#'
+#' Ties are handled by the \code{"first"} method: the first occurrence
+#' of a value wins.
+#'
+#' @param x A gtable object
+#' @param i The z value to start counting up from (default is 1)
+z_normalise <- function(x, i = 1) {
+ x$layout$z <- rank(x$layout$z, ties.method = "first") + i - 1
+ x
+}
+
+
+#' Arrange the z values within gtable objects
+#'
+#' This is usually used before rbinding or cbinding the gtables together.
+#' The resulting z values will be normalized.
+#'
+#' Ties are handled by the \code{"first"} method: the first occurrence
+#' of a value wins.
+#'
+#' @param gtables A list of gtable objects
+#' @param z A numeric vector of relative z values
+z_arrange_gtables <- function(gtables, z) {
+ if (length(gtables) != length(z)) {
+ stop("'gtables' and 'z' must be the same length")
+ }
+
+ # Keep track of largest z value encountered so far
+ zmax <- 0
+ # Go through each gtable, in the order of z
+ for (i in order(z)) {
+ # max() gives a warning if zero-length input
+ if (nrow(gtables[[i]]$layout) > 0) {
+ gtables[[i]] <- z_normalise(gtables[[i]], zmax + 1)
+ zmax <- max(gtables[[i]]$layout$z)
+ }
+ }
+
+ gtables
+}
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..42816b6
--- /dev/null
+++ b/README.md
@@ -0,0 +1,7 @@
+# gtable
+
+[](https://travis-ci.org/hadley/gtable)
+[](http://cran.r-project.org/package=gtable)
+[](https://codecov.io/github/hadley/gtable?branch=master)
+
+gtable provides internal tools used to draw ggplot2 graphics.
diff --git a/debian/README.Debian b/debian/README.Debian
deleted file mode 100644
index 4d4750a..0000000
--- a/debian/README.Debian
+++ /dev/null
@@ -1,7 +0,0 @@
-r-cran-gtable for Debian
-------------------------
-
-This package can be tested by loading it into R with the command
-'library(gtable)' in order to confirm its integrity.
-
- -- Ivo Maintz <ivo at maintz.de> Mon, 10 Dec 2012 10:03:04 +0100
diff --git a/debian/README.test b/debian/README.test
deleted file mode 100644
index 8d70ca3..0000000
--- a/debian/README.test
+++ /dev/null
@@ -1,9 +0,0 @@
-Notes on how this package can be tested.
-────────────────────────────────────────
-
-This package can be tested by running the provided test:
-
-cd tests
-LC_ALL=C R --no-save < testthat.R
-
-in order to confirm its integrity.
diff --git a/debian/changelog b/debian/changelog
deleted file mode 100644
index a2a8a81..0000000
--- a/debian/changelog
+++ /dev/null
@@ -1,22 +0,0 @@
-gtable (0.2.0-1) unstable; urgency=medium
-
- * New upstream version
- * Ivo Maintz is MIA, take over package into team maintenance
- * cme fix dpkg-control
- * add autopkgtest
- * canonical homepage for cran
-
- -- Andreas Tille <tille at debian.org> Tue, 18 Oct 2016 12:45:51 +0200
-
-gtable (0.1.2-1.1) unstable; urgency=low
-
- * Non-maintainer upload
- * Rebuild for R 3.0 (Closes: #706995)
-
- -- Don Armstrong <don at debian.org> Wed, 08 May 2013 15:13:25 -0700
-
-gtable (0.1.2-1) unstable; urgency=low
-
- * Initial release (Closes: #700861)
-
- -- Ivo Maintz <ivo at maintz.de> Sun, 24 Feb 2013 16:24:01 +0100
diff --git a/debian/compat b/debian/compat
deleted file mode 100644
index ec63514..0000000
--- a/debian/compat
+++ /dev/null
@@ -1 +0,0 @@
-9
diff --git a/debian/control b/debian/control
deleted file mode 100644
index b1a21b7..0000000
--- a/debian/control
+++ /dev/null
@@ -1,27 +0,0 @@
-Source: gtable
-Maintainer: Debian Med Packaging Team <debian-med-packaging at lists.alioth.debian.org>
-Uploaders: Andreas Tille <tille at debian.org>
-Section: gnu-r
-Priority: optional
-Build-Depends: debhelper (>= 9.0.0),
- cdbs,
- r-base-dev
-Standards-Version: 3.9.8
-Vcs-Browser: https://anonscm.debian.org/viewvc/debian-med/trunk/packages/R/r-cran-gtable/trunk/
-Vcs-Svn: svn://anonscm.debian.org/debian-med/trunk/packages/R/r-cran-gtable/trunk/
-Homepage: https://cran.r-project.org/package=gtable
-
-Package: r-cran-gtable
-Architecture: all
-Depends: ${shlibs:Depends},
- ${misc:Depends},
- ${R:Depends}
-Suggests: r-cran-plyr
-Description: Arrange grobs in tables
- A grob table captures all the information needed to layout grobs in a
- table structure. It supports row and column spanning, offers some
- tools to automatically figure out the correct dimensions, and makes it
- easy to align and combine multiple tables.
- Each grob is put in its own viewport - grobs in the same location are
- not combined into one cell. Each grob takes up the entire cell viewport
- so justification control is not available.
diff --git a/debian/copyright b/debian/copyright
deleted file mode 100644
index 659611c..0000000
--- a/debian/copyright
+++ /dev/null
@@ -1,28 +0,0 @@
-Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
-Upstream-Name: gtable
-Source: http://cran.r-project.org/web/packages/gtable/index.html
-
-Files: *
-Copyright: 2012 Hadley Wickham <h.wickham at gmail.com>
-License: GPL-2.0+
-
-Files: debian/*
-Copyright: 2012 Ivo Maintz <ivo at maintz.de>
-License: GPL-2.0+
-
-License: GPL-2.0+
- This package is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- .
- This package is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- .
- You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>
- .
- On Debian systems, the complete text of the GNU General
- Public License version 2 can be found in "/usr/share/common-licenses/GPL-2".
diff --git a/debian/docs b/debian/docs
deleted file mode 100644
index af15354..0000000
--- a/debian/docs
+++ /dev/null
@@ -1,4 +0,0 @@
-NEWS.md
-tests
-debian/README.test
-debian/tests/run-unit-test
diff --git a/debian/rules b/debian/rules
deleted file mode 100755
index 8c50502..0000000
--- a/debian/rules
+++ /dev/null
@@ -1,7 +0,0 @@
-#!/usr/bin/make -f
-# -*- makefile -*-
-
-include /usr/share/R/debian/r-cran.mk
-
-install/$(package)::
- chmod 644 debian/$(package)/usr/lib/R/site-library/$(cranName)/INDEX
diff --git a/debian/source/format b/debian/source/format
deleted file mode 100644
index 163aaf8..0000000
--- a/debian/source/format
+++ /dev/null
@@ -1 +0,0 @@
-3.0 (quilt)
diff --git a/debian/tests/control b/debian/tests/control
deleted file mode 100644
index b044b0c..0000000
--- a/debian/tests/control
+++ /dev/null
@@ -1,3 +0,0 @@
-Tests: run-unit-test
-Depends: @, r-cran-testthat
-Restrictions: allow-stderr
diff --git a/debian/tests/run-unit-test b/debian/tests/run-unit-test
deleted file mode 100644
index 568b640..0000000
--- a/debian/tests/run-unit-test
+++ /dev/null
@@ -1,11 +0,0 @@
-#!/bin/sh -e
-
-pkg=r-cran-gtable
-
-if [ "$ADTTMP" = "" ] ; then
- ADTTMP=`mktemp -d /tmp/${pkg}-test.XXXXXX`
- trap "rm -rf $ADTTMP" 0 INT QUIT ABRT PIPE TERM
-fi
-cd $ADTTMP
-cp -a /usr/share/doc/${pkg}/tests/* $ADTTMP
-LC_ALL=C R --no-save < testthat.R
diff --git a/debian/upstream/metadata b/debian/upstream/metadata
deleted file mode 100644
index 222a1f4..0000000
--- a/debian/upstream/metadata
+++ /dev/null
@@ -1,7 +0,0 @@
-Archive: CRAN
-Contact: Hadley Wickham <h.wickham at gmail.com>
-Download: http://cran.r-project.org/src/contrib/
-Homepage: http://cran.r-project.org/web/packages/gtable/
-CRAN: gtable
-Name: gtable
-Watch: http://cran.r-project.org/src/contrib/gtable_([\d.-]*)\.tar.gz
diff --git a/debian/watch b/debian/watch
deleted file mode 100644
index 0d0dd1e..0000000
--- a/debian/watch
+++ /dev/null
@@ -1,3 +0,0 @@
-version=3
-opts="uversionmangle=s/-/./" \
-http://cran.r-project.org/src/contrib/gtable_([\d.-]*)\.tar.gz
diff --git a/man/bind.Rd b/man/bind.Rd
new file mode 100644
index 0000000..07b0539
--- /dev/null
+++ b/man/bind.Rd
@@ -0,0 +1,29 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/rbind-cbind.r
+\name{bind}
+\alias{bind}
+\alias{cbind.gtable}
+\alias{rbind.gtable}
+\title{Row and column binding for gtables.}
+\usage{
+\method{rbind}{gtable}(..., size = "max", z = NULL)
+
+\method{cbind}{gtable}(..., size = "max", z = NULL)
+}
+\arguments{
+\item{...}{gtables to combine (\code{x} and \code{y})}
+
+\item{size}{How should the widths (for rbind) and the heights (for cbind)
+be combined across the gtables: take values from \code{first},
+or \code{last} gtable, or compute the \code{min} or \code{max} values.
+Defaults to \code{max}.}
+
+\item{z}{A numeric vector indicating the relative z values of each gtable.
+The z values of each object in the resulting gtable will be modified
+to fit this order. If \code{NULL}, then the z values of obects within
+each gtable will not be modified.}
+}
+\description{
+Row and column binding for gtables.
+}
+
diff --git a/man/gtable.Rd b/man/gtable.Rd
new file mode 100644
index 0000000..6fca4f5
--- /dev/null
+++ b/man/gtable.Rd
@@ -0,0 +1,116 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gtable.r
+\docType{package}
+\name{gtable}
+\alias{gtable}
+\alias{gtable-package}
+\title{gtable}
+\usage{
+gtable(widths = list(), heights = list(), respect = FALSE,
+ name = "layout", rownames = NULL, colnames = NULL, vp = NULL)
+}
+\arguments{
+\item{widths}{a unit vector giving the width of each column}
+
+\item{heights}{a unit vector giving the height of each row}
+
+\item{respect}{a logical vector of length 1: should the aspect ratio of
+height and width specified in null units be respected. See
+\code{\link{grid.layout}} for more details}
+
+\item{name}{a string giving the name of the table. This is used to name
+the layout viewport}
+
+\item{rownames, colnames}{character vectors of row and column names, used
+for characteric subsetting, particularly for \code{gtable_align},
+and \code{gtable_join}.}
+
+\item{vp}{a grid viewport object (or NULL).}
+}
+\description{
+gtable
+
+A grob table captures all the information needed to layout grobs in a table
+structure. It supports row and column spanning, offers some tools to
+automatically figure out the correct dimensions, and makes it easy to
+align and combine multiple tables.
+}
+\details{
+Each grob is put in its own viewport - grobs in the same location are
+not combined into one cell. Each grob takes up the entire cell viewport
+so justification control is not available.
+
+It constructs both the viewports and the gTree needed to display the table.
+}
+\section{Components}{
+
+
+There are three basics components to a grob table: the specification of
+table (cell heights and widths), the layout (for each grob, its position,
+name and other settings), and global parameters.
+
+It's easier to understand how \code{gtable} works if in your head you keep
+the table separate from it's contents. Each cell can have 0, 1, or many
+grobs inside. Each grob must belong to at least one cell, but can span
+across many cells.
+}
+
+\section{Layout}{
+
+
+The layout details are stored in a data frame with one row for each grob,
+and columns:
+
+\itemize{
+ \item \code{t} top extent of grob
+ \item \code{r} right extent of grob
+ \item \code{b} bottom extent of
+ \item \code{l} left extent of grob
+ \item \code{z} the z-order of the grob - used to reorder the grobs
+ before they are rendered
+ \item \code{clip} a string, specifying how the grob should be clipped:
+ either \code{"on"}, \code{"off"} or \code{"inherit"}
+ \item \code{name}, a character vector used to name each grob and its
+ viewport
+}
+
+You should not need to modify this data frame directly - instead use
+functions like \code{gtable_add_grob}.
+}
+\examples{
+library(grid)
+a <- gtable(unit(1:3, c("cm")), unit(5, "cm"))
+a
+gtable_show_layout(a)
+
+# Add a grob:
+rect <- rectGrob(gp = gpar(fill = "black"))
+a <- gtable_add_grob(a, rect, 1, 1)
+a
+plot(a)
+
+# gtables behave like matrices:
+dim(a)
+t(a)
+plot(t(a))
+
+# when subsetting, grobs are retained if their extents lie in the
+# rows/columns that retained.
+
+b <- gtable(unit(c(2, 2, 2), "cm"), unit(c(2, 2, 2), "cm"))
+b <- gtable_add_grob(b, rect, 2, 2)
+b[1, ]
+b[, 1]
+b[2, 2]
+
+# gtable have row and column names
+rownames(b) <- 1:3
+rownames(b)[2] <- 200
+colnames(b) <- letters[1:3]
+dimnames(b)
+}
+\seealso{
+\code{\link{gtable_row}}, \code{\link{gtable_col}} and
+ \code{\link{gtable_matrix}} for convenient ways of creating gtables.
+}
+
diff --git a/man/gtable_add_cols.Rd b/man/gtable_add_cols.Rd
new file mode 100644
index 0000000..648234d
--- /dev/null
+++ b/man/gtable_add_cols.Rd
@@ -0,0 +1,41 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/add-rows-cols.r
+\name{gtable_add_cols}
+\alias{gtable_add_cols}
+\title{Add new columns in specified position.}
+\usage{
+gtable_add_cols(x, widths, pos = -1)
+}
+\arguments{
+\item{x}{a \code{\link{gtable}} object}
+
+\item{widths}{a unit vector giving the widths of the new columns}
+
+\item{pos}{new row will be added below this position. Defaults to
+adding col on right. \code{0} adds on the left.}
+}
+\description{
+Add new columns in specified position.
+}
+\examples{
+library(grid)
+rect <- rectGrob(gp = gpar(fill = "#00000080"))
+tab <- gtable(unit(rep(1, 3), "null"), unit(rep(1, 3), "null"))
+tab <- gtable_add_grob(tab, rect, t = 1, l = 1, r = 3)
+tab <- gtable_add_grob(tab, rect, t = 1, b = 3, l = 1)
+tab <- gtable_add_grob(tab, rect, t = 1, b = 3, l = 3)
+dim(tab)
+plot(tab)
+
+# Grobs will continue to span over new rows if added in the middle
+tab2 <- gtable_add_cols(tab, unit(1, "null"), 1)
+dim(tab2)
+plot(tab2)
+
+# But not when added to left (0) or right (-1, the default)
+tab3 <- gtable_add_cols(tab, unit(1, "null"))
+tab3 <- gtable_add_cols(tab3, unit(1, "null"), 0)
+dim(tab3)
+plot(tab3)
+}
+
diff --git a/man/gtable_add_grob.Rd b/man/gtable_add_grob.Rd
new file mode 100644
index 0000000..7aeb1dc
--- /dev/null
+++ b/man/gtable_add_grob.Rd
@@ -0,0 +1,40 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/add-grob.r
+\name{gtable_add_grob}
+\alias{gtable_add_grob}
+\title{Add a single grob, possibly spanning multiple rows or columns.}
+\usage{
+gtable_add_grob(x, grobs, t, l, b = t, r = l, z = Inf, clip = "on",
+ name = x$name)
+}
+\arguments{
+\item{x}{a \code{\link{gtable}} object}
+
+\item{grobs}{a single grob or a list of grobs}
+
+\item{t}{a numeric vector giving the top extent of the grobs}
+
+\item{l}{a numeric vector giving the left extent of the grobs}
+
+\item{b}{a numeric vector giving the bottom extent of the grobs}
+
+\item{r}{a numeric vector giving the right extent of the grobs}
+
+\item{z}{a numeric vector giving the order in which the grobs should be
+ plotted. Use \code{Inf} (the default) to plot above or \code{-Inf}
+ below all existing grobs. By default positions are on the integers,
+giving plenty of room to insert new grobs between existing grobs.}
+
+\item{clip}{should drawing be clipped to the specified cells
+(\code{"on"}), the entire table (\code{"inherit"}), or not at all
+(\code{"off"})}
+
+\item{name}{name of the grob - used to modify the grob name before it's
+plotted.}
+}
+\description{
+This only adds grobs into the table - it doesn't affect the table in
+any way. In the gtable model, grobs always fill up the complete table
+cell. If you want custom justification you might need to
+}
+
diff --git a/man/gtable_add_padding.Rd b/man/gtable_add_padding.Rd
new file mode 100644
index 0000000..78346b9
--- /dev/null
+++ b/man/gtable_add_padding.Rd
@@ -0,0 +1,32 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/padding.r
+\name{gtable_add_padding}
+\alias{gtable_add_padding}
+\title{Add padding around edges of table.}
+\usage{
+gtable_add_padding(x, padding)
+}
+\arguments{
+\item{x}{a \code{\link{gtable}} object}
+
+\item{padding}{vector of length 4: top, right, bottom, left. Normal
+recycling rules apply.}
+}
+\description{
+Add padding around edges of table.
+}
+\examples{
+library(grid)
+gt <- gtable(unit(1, "null"), unit(1, "null"))
+gt <- gtable_add_grob(gt, rectGrob(gp = gpar(fill = "black")), 1, 1)
+
+plot(gt)
+plot(cbind(gt, gt))
+plot(rbind(gt, gt))
+
+pad <- gtable_add_padding(gt, unit(1, "cm"))
+plot(pad)
+plot(cbind(pad, pad))
+plot(rbind(pad, pad))
+}
+
diff --git a/man/gtable_add_rows.Rd b/man/gtable_add_rows.Rd
new file mode 100644
index 0000000..3b87fe2
--- /dev/null
+++ b/man/gtable_add_rows.Rd
@@ -0,0 +1,41 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/add-rows-cols.r
+\name{gtable_add_rows}
+\alias{gtable_add_rows}
+\title{Add new rows in specified position.}
+\usage{
+gtable_add_rows(x, heights, pos = -1)
+}
+\arguments{
+\item{x}{a \code{\link{gtable}} object}
+
+\item{heights}{a unit vector giving the heights of the new rows}
+
+\item{pos}{new row will be added below this position. Defaults to
+adding row on bottom. \code{0} adds on the top.}
+}
+\description{
+Add new rows in specified position.
+}
+\examples{
+library(grid)
+rect <- rectGrob(gp = gpar(fill = "#00000080"))
+tab <- gtable(unit(rep(1, 3), "null"), unit(rep(1, 3), "null"))
+tab <- gtable_add_grob(tab, rect, t = 1, l = 1, r = 3)
+tab <- gtable_add_grob(tab, rect, t = 1, b = 3, l = 1)
+tab <- gtable_add_grob(tab, rect, t = 1, b = 3, l = 3)
+dim(tab)
+plot(tab)
+
+# Grobs will continue to span over new rows if added in the middle
+tab2 <- gtable_add_rows(tab, unit(1, "null"), 1)
+dim(tab2)
+plot(tab2)
+
+# But not when added to top (0) or bottom (-1, the default)
+tab3 <- gtable_add_rows(tab, unit(1, "null"))
+tab3 <- gtable_add_rows(tab3, unit(1, "null"), 0)
+dim(tab3)
+plot(tab3)
+}
+
diff --git a/man/gtable_add_space.Rd b/man/gtable_add_space.Rd
new file mode 100644
index 0000000..33a7d7a
--- /dev/null
+++ b/man/gtable_add_space.Rd
@@ -0,0 +1,24 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/add-space.r
+\name{gtable_add_space}
+\alias{gtable_add_col_space}
+\alias{gtable_add_row_space}
+\alias{gtable_add_space}
+\title{Add row/column spacing.}
+\usage{
+gtable_add_col_space(x, width)
+
+gtable_add_row_space(x, height)
+}
+\arguments{
+\item{x}{a gtable object}
+
+\item{width}{a vector of units of length 1 or ncol - 1}
+
+\item{height}{a vector of units of length 1 or nrow - 1}
+}
+\description{
+Adds \code{width} space between the columns or \code{height} space between
+the rows.
+}
+
diff --git a/man/gtable_col.Rd b/man/gtable_col.Rd
new file mode 100644
index 0000000..522bcb1
--- /dev/null
+++ b/man/gtable_col.Rd
@@ -0,0 +1,40 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gtable-layouts.r
+\name{gtable_col}
+\alias{gtable_col}
+\title{Create a single column gtable.}
+\usage{
+gtable_col(name, grobs, width = NULL, heights = NULL, z = NULL,
+ vp = NULL)
+}
+\arguments{
+\item{name}{a string giving the name of the table. This is used to name
+the layout viewport}
+
+\item{grobs}{a single grob or a list of grobs}
+
+\item{width}{a unit vector giving the width of this column}
+
+\item{heights}{a unit vector giving the height of each row}
+
+\item{z}{a numeric vector giving the order in which the grobs should be
+ plotted. Use \code{Inf} (the default) to plot above or \code{-Inf}
+ below all existing grobs. By default positions are on the integers,
+giving plenty of room to insert new grobs between existing grobs.}
+
+\item{vp}{a grid viewport object (or NULL).}
+}
+\description{
+Create a single column gtable.
+}
+\examples{
+library(grid)
+a <- rectGrob(gp = gpar(fill = "red"))
+b <- circleGrob()
+c <- linesGrob()
+gt <- gtable_col("demo", list(a, b, c))
+gt
+plot(gt)
+gtable_show_layout(gt)
+}
+
diff --git a/man/gtable_filter.Rd b/man/gtable_filter.Rd
new file mode 100644
index 0000000..46a9d88
--- /dev/null
+++ b/man/gtable_filter.Rd
@@ -0,0 +1,43 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/filter.r
+\name{gtable_filter}
+\alias{gtable_filter}
+\title{Filter cells by name.}
+\usage{
+gtable_filter(x, pattern, fixed = FALSE, trim = TRUE)
+}
+\arguments{
+\item{x}{a gtable object}
+
+\item{pattern}{character string containing a \link{regular expression}
+ (or character string for \code{fixed = TRUE}) to be matched
+ in the given character vector. Coerced by
+ \code{\link{as.character}} to a character string if possible. If a
+ character vector of length 2 or more is supplied, the first element
+ is used with a warning. Missing values are allowed except for
+ \code{regexpr} and \code{gregexpr}.}
+
+\item{fixed}{logical. If \code{TRUE}, \code{pattern} is a string to be
+ matched as is. Overrides all conflicting arguments.}
+
+\item{trim}{if \code{TRUE}, \code{\link{gtable_trim}} will be used to trim
+off any empty cells.}
+}
+\description{
+Filter cells by name.
+}
+\examples{
+library(grid)
+gt <- gtable(unit(rep(5, 3), c("cm")), unit(5, "cm"))
+rect <- rectGrob(gp = gpar(fill = "black"))
+circ <- circleGrob(gp = gpar(fill = "red"))
+
+gt <- gtable_add_grob(gt, rect, 1, 1, name = "rect")
+gt <- gtable_add_grob(gt, circ, 1, 3, name = "circ")
+
+plot(gtable_filter(gt, "rect"))
+plot(gtable_filter(gt, "rect", trim = FALSE))
+plot(gtable_filter(gt, "circ"))
+plot(gtable_filter(gt, "circ", trim = FALSE))
+}
+
diff --git a/man/gtable_height.Rd b/man/gtable_height.Rd
new file mode 100644
index 0000000..855a9b5
--- /dev/null
+++ b/man/gtable_height.Rd
@@ -0,0 +1,15 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gtable.r
+\name{gtable_height}
+\alias{gtable_height}
+\title{Returns the height of a gtable, in the gtable's units}
+\usage{
+gtable_height(x)
+}
+\arguments{
+\item{x}{A gtable object}
+}
+\description{
+Note that unlike heightDetails.gtable, this can return relative units.
+}
+
diff --git a/man/gtable_matrix.Rd b/man/gtable_matrix.Rd
new file mode 100644
index 0000000..3d7a24a
--- /dev/null
+++ b/man/gtable_matrix.Rd
@@ -0,0 +1,54 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gtable-layouts.r
+\name{gtable_matrix}
+\alias{gtable_matrix}
+\title{Create a gtable from a matrix of grobs.}
+\usage{
+gtable_matrix(name, grobs, widths = NULL, heights = NULL, z = NULL,
+ respect = FALSE, clip = "on", vp = NULL)
+}
+\arguments{
+\item{name}{a string giving the name of the table. This is used to name
+the layout viewport}
+
+\item{grobs}{a single grob or a list of grobs}
+
+\item{widths}{a unit vector giving the width of each column}
+
+\item{heights}{a unit vector giving the height of each row}
+
+\item{z}{a numeric matrix of the same dimensions as \code{grobs},
+specifying the order that the grobs are drawn.}
+
+\item{respect}{a logical vector of length 1: should the aspect ratio of
+height and width specified in null units be respected. See
+\code{\link{grid.layout}} for more details}
+
+\item{clip}{should drawing be clipped to the specified cells
+(\code{"on"}), the entire table (\code{"inherit"}), or not at all
+(\code{"off"})}
+
+\item{vp}{a grid viewport object (or NULL).}
+}
+\description{
+Create a gtable from a matrix of grobs.
+}
+\examples{
+library(grid)
+a <- rectGrob(gp = gpar(fill = "red"))
+b <- circleGrob()
+c <- linesGrob()
+
+row <- matrix(list(a, b, c), nrow = 1)
+col <- matrix(list(a, b, c), ncol = 1)
+mat <- matrix(list(a, b, c, nullGrob()), nrow = 2)
+
+gtable_matrix("demo", row, unit(c(1, 1, 1), "null"), unit(1, "null"))
+gtable_matrix("demo", col, unit(1, "null"), unit(c(1, 1, 1), "null"))
+gtable_matrix("demo", mat, unit(c(1, 1), "null"), unit(c(1, 1), "null"))
+
+# Can specify z ordering
+z <- matrix(c(3, 1, 2, 4), nrow = 2)
+gtable_matrix("demo", mat, unit(c(1, 1), "null"), unit(c(1, 1), "null"), z = z)
+}
+
diff --git a/man/gtable_row.Rd b/man/gtable_row.Rd
new file mode 100644
index 0000000..b7f9443
--- /dev/null
+++ b/man/gtable_row.Rd
@@ -0,0 +1,40 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gtable-layouts.r
+\name{gtable_row}
+\alias{gtable_row}
+\title{Create a single row gtable.}
+\usage{
+gtable_row(name, grobs, height = NULL, widths = NULL, z = NULL,
+ vp = NULL)
+}
+\arguments{
+\item{name}{a string giving the name of the table. This is used to name
+the layout viewport}
+
+\item{grobs}{a single grob or a list of grobs}
+
+\item{height}{a unit vector giving the height of this row}
+
+\item{widths}{a unit vector giving the width of each column}
+
+\item{z}{a numeric vector giving the order in which the grobs should be
+ plotted. Use \code{Inf} (the default) to plot above or \code{-Inf}
+ below all existing grobs. By default positions are on the integers,
+giving plenty of room to insert new grobs between existing grobs.}
+
+\item{vp}{a grid viewport object (or NULL).}
+}
+\description{
+Create a single row gtable.
+}
+\examples{
+library(grid)
+a <- rectGrob(gp = gpar(fill = "red"))
+b <- circleGrob()
+c <- linesGrob()
+gt <- gtable_row("demo", list(a, b, c))
+gt
+plot(gt)
+gtable_show_layout(gt)
+}
+
diff --git a/man/gtable_show_layout.Rd b/man/gtable_show_layout.Rd
new file mode 100644
index 0000000..37351dd
--- /dev/null
+++ b/man/gtable_show_layout.Rd
@@ -0,0 +1,15 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/grid.r
+\name{gtable_show_layout}
+\alias{gtable_show_layout}
+\title{Visualise the layout of a gtable.}
+\usage{
+gtable_show_layout(x)
+}
+\arguments{
+\item{x}{a gtable object}
+}
+\description{
+Visualise the layout of a gtable.
+}
+
diff --git a/man/gtable_spacer.Rd b/man/gtable_spacer.Rd
new file mode 100644
index 0000000..01068ce
--- /dev/null
+++ b/man/gtable_spacer.Rd
@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gtable-layouts.r
+\name{gtable_spacer}
+\alias{gtable_col_spacer}
+\alias{gtable_row_spacer}
+\alias{gtable_spacer}
+\title{Create a row/col spacer gtable.}
+\usage{
+gtable_row_spacer(widths)
+
+gtable_col_spacer(heights)
+}
+\arguments{
+\item{widths}{unit vector of widths}
+
+\item{heights}{unit vector of heights}
+}
+\description{
+Create a row/col spacer gtable.
+}
+
diff --git a/man/gtable_trim.Rd b/man/gtable_trim.Rd
new file mode 100644
index 0000000..b5f21fc
--- /dev/null
+++ b/man/gtable_trim.Rd
@@ -0,0 +1,32 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/trim.r
+\name{gtable_trim}
+\alias{gtable_trim}
+\title{Trim off empty cells.}
+\usage{
+gtable_trim(x)
+}
+\arguments{
+\item{x}{a gtable object}
+}
+\description{
+Trim off empty cells.
+}
+\examples{
+library(grid)
+rect <- rectGrob(gp = gpar(fill = "black"))
+base <- gtable(unit(c(2, 2, 2), "cm"), unit(c(2, 2, 2), "cm"))
+
+center <- gtable_add_grob(base, rect, 2, 2)
+plot(center)
+plot(gtable_trim(center))
+
+col <- gtable_add_grob(base, rect, 1, 2, 3, 2)
+plot(col)
+plot(gtable_trim(col))
+
+row <- gtable_add_grob(base, rect, 2, 1, 2, 3)
+plot(row)
+plot(gtable_trim(row))
+}
+
diff --git a/man/gtable_width.Rd b/man/gtable_width.Rd
new file mode 100644
index 0000000..84482aa
--- /dev/null
+++ b/man/gtable_width.Rd
@@ -0,0 +1,15 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gtable.r
+\name{gtable_width}
+\alias{gtable_width}
+\title{Returns the width of a gtable, in the gtable's units}
+\usage{
+gtable_width(x)
+}
+\arguments{
+\item{x}{A gtable object}
+}
+\description{
+Note that unlike widthDetails.gtable, this can return relative units.
+}
+
diff --git a/man/is.gtable.Rd b/man/is.gtable.Rd
new file mode 100644
index 0000000..c05cc81
--- /dev/null
+++ b/man/is.gtable.Rd
@@ -0,0 +1,15 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gtable.r
+\name{is.gtable}
+\alias{is.gtable}
+\title{Is this a gtable?}
+\usage{
+is.gtable(x)
+}
+\arguments{
+\item{x}{object to test}
+}
+\description{
+Is this a gtable?
+}
+
diff --git a/man/print.gtable.Rd b/man/print.gtable.Rd
new file mode 100644
index 0000000..c56320a
--- /dev/null
+++ b/man/print.gtable.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gtable.r
+\name{print.gtable}
+\alias{print.gtable}
+\title{Print a gtable object}
+\usage{
+\method{print}{gtable}(x, zsort = FALSE, ...)
+}
+\arguments{
+\item{x}{A gtable object.}
+
+\item{zsort}{Sort by z values? Default \code{FALSE}.}
+
+\item{...}{Other arguments (not used by this method).}
+}
+\description{
+Print a gtable object
+}
+
diff --git a/man/z_arrange_gtables.Rd b/man/z_arrange_gtables.Rd
new file mode 100644
index 0000000..de05889
--- /dev/null
+++ b/man/z_arrange_gtables.Rd
@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/z.r
+\name{z_arrange_gtables}
+\alias{z_arrange_gtables}
+\title{Arrange the z values within gtable objects}
+\usage{
+z_arrange_gtables(gtables, z)
+}
+\arguments{
+\item{gtables}{A list of gtable objects}
+
+\item{z}{A numeric vector of relative z values}
+}
+\description{
+This is usually used before rbinding or cbinding the gtables together.
+The resulting z values will be normalized.
+}
+\details{
+Ties are handled by the \code{"first"} method: the first occurrence
+of a value wins.
+}
+
diff --git a/man/z_normalise.Rd b/man/z_normalise.Rd
new file mode 100644
index 0000000..9091df8
--- /dev/null
+++ b/man/z_normalise.Rd
@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/z.r
+\name{z_normalise}
+\alias{z_normalise}
+\title{Normalise z values within a gtable object}
+\usage{
+z_normalise(x, i = 1)
+}
+\arguments{
+\item{x}{A gtable object}
+
+\item{i}{The z value to start counting up from (default is 1)}
+}
+\description{
+The z values within a gtable object can be any numeric values.
+This function will change them to integers (starting from 1),
+preserving the original order.
+}
+\details{
+Ties are handled by the \code{"first"} method: the first occurrence
+of a value wins.
+}
+
diff --git a/tests/testthat.R b/tests/testthat.R
new file mode 100644
index 0000000..807b29d
--- /dev/null
+++ b/tests/testthat.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(gtable)
+
+test_check("gtable")
diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf
new file mode 100644
index 0000000..09b0766
Binary files /dev/null and b/tests/testthat/Rplots.pdf differ
diff --git a/tests/testthat/helper-grobs.r b/tests/testthat/helper-grobs.r
new file mode 100644
index 0000000..98c2fc6
--- /dev/null
+++ b/tests/testthat/helper-grobs.r
@@ -0,0 +1,5 @@
+library(grid)
+grob1 <- rectGrob()
+grob2 <- circleGrob()
+grob3 <- linesGrob()
+grob4 <- polygonGrob()
diff --git a/tests/testthat/helper-units.r b/tests/testthat/helper-units.r
new file mode 100644
index 0000000..8516978
--- /dev/null
+++ b/tests/testthat/helper-units.r
@@ -0,0 +1,6 @@
+library(grid)
+cm <- unit(1, "cm")
+cm2 <- unit(2, "cm")
+cm5 <- unit(5, "cm")
+
+null <- unit(1, "null")
diff --git a/tests/testthat/test-bind.r b/tests/testthat/test-bind.r
new file mode 100644
index 0000000..40f6bb9
--- /dev/null
+++ b/tests/testthat/test-bind.r
@@ -0,0 +1,34 @@
+context("Bind")
+
+test_that("Number of rows grow with rbind", {
+
+ lay1 <- gtable_add_rows(gtable(), cm)
+ lay2 <- gtable_add_rows(gtable(), rep(cm, 2))
+
+ expect_that(nrow(rbind(lay1, lay2)), equals(3))
+ expect_that(nrow(rbind(lay2, lay1)), equals(3))
+})
+
+test_that("Number of cols grow with cbind", {
+
+ lay1 <- gtable_add_cols(gtable(), cm)
+ lay2 <- gtable_add_cols(gtable(), rep(cm, 2))
+
+ expect_that(ncol(cbind(lay1, lay2)), equals(3))
+ expect_that(ncol(cbind(lay2, lay1)), equals(3))
+})
+
+test_that("Heights and widths vary with size parameter", {
+ col1 <- gtable_col("col1", list(grob1), cm, cm)
+ col2 <- gtable_col("col1", list(grob1), cm2, cm2)
+
+ expect_equal(cbind(col1, col2, size = "first")$heights, cm)
+ expect_equal(cbind(col1, col2, size = "last")$heights, cm2)
+ expect_equal(cbind(col1, col2, size = "min")$heights, cm)
+ expect_equal(cbind(col1, col2, size = "max")$heights, cm2)
+
+ expect_equal(rbind(col1, col2, size = "first")$widths, cm)
+ expect_equal(rbind(col1, col2, size = "last")$widths, cm2)
+ expect_equal(rbind(col1, col2, size = "min")$widths, cm)
+ expect_equal(rbind(col1, col2, size = "max")$widths, cm2)
+})
diff --git a/tests/testthat/test-layout.r b/tests/testthat/test-layout.r
new file mode 100644
index 0000000..d046cce
--- /dev/null
+++ b/tests/testthat/test-layout.r
@@ -0,0 +1,154 @@
+library(testthat)
+
+# Find location of a grob
+gtable_find <- function(x, grob) {
+ pos <- vapply(x$grobs, identical, logical(1), grob)
+ x$layout[pos, ]
+}
+
+loc_df <- function(t, l, b, r) {
+ data.frame(t, l, b, r, z = 1, clip = "on", name = "layout",
+ stringsAsFactors = FALSE)
+}
+
+context("gtable")
+
+test_that("Number of rows grows with add_rows", {
+ layout <- gtable()
+ expect_that(nrow(layout), equals(0))
+
+ layout <- gtable_add_rows(layout, unit(1, "cm"))
+ expect_that(nrow(layout), equals(1))
+
+ layout <- gtable_add_rows(layout, unit(1, "cm"))
+ layout <- gtable_add_rows(layout, unit(1, "cm"))
+ expect_that(nrow(layout), equals(3))
+
+ layout <- gtable_add_rows(layout, unit(1:2, "cm"))
+ expect_that(nrow(layout), equals(5))
+})
+
+
+test_that("Number of columns grows with add_cols", {
+ layout <- gtable()
+ expect_that(ncol(layout), equals(0))
+
+ layout <- gtable_add_cols(layout, unit(1, "cm"))
+ expect_that(ncol(layout), equals(1))
+
+ layout <- gtable_add_cols(layout, unit(c(1, 1), "cm"))
+ expect_that(ncol(layout), equals(3))
+
+ layout <- gtable_add_cols(layout, unit(1:2, "cm"))
+ expect_that(ncol(layout), equals(5))
+})
+
+
+test_that("Setting and getting works", {
+ layout <- gtable_add_cols(gtable_add_rows(gtable(), cm), cm)
+
+ layout <- gtable_add_grob(layout, grob1, 1, 1)
+ loc <- gtable_find(layout, grob1)
+
+ expect_that(nrow(loc), equals(1))
+ expect_that(loc$t, equals(1))
+ expect_that(loc$r, equals(1))
+ expect_that(loc$b, equals(1))
+ expect_that(loc$l, equals(1))
+})
+
+test_that("Spanning grobs continue to span after row insertion", {
+ layout <- gtable_add_cols(gtable_add_rows(gtable(), rep(cm, 3)), rep(cm, 3))
+ layout <- gtable_add_grob(layout, grob1, 1, 1, 3, 3)
+
+ within <- gtable_add_rows(gtable_add_cols(layout, cm, pos = 2), cm, pos = 2)
+ loc <- gtable_find(within, grob1)
+
+ expect_that(loc, equals(loc_df(t = 1, l = 1, b = 4, r = 4)))
+
+ top_left <- layout
+ top_left <- gtable_add_cols(top_left, cm, pos = 0)
+ top_left <- gtable_add_rows(top_left, cm, pos = 0)
+
+ loc <- gtable_find(top_left, grob1)
+ expect_that(loc, equals(loc_df(t = 2, l = 2, b = 4, r = 4)))
+
+ bottom_right <- layout
+ bottom_right <- gtable_add_cols(bottom_right, cm)
+ bottom_right <- gtable_add_rows(bottom_right, cm)
+
+ loc <- gtable_find(bottom_right, grob1)
+ expect_that(loc, equals(loc_df(t = 1, l = 1, b = 3, r = 3)))
+})
+
+
+test_that("n + 1 new rows/cols after spacing", {
+ layout <- gtable()
+ layout <- gtable_add_rows(layout, rep(cm, 3))
+ layout <- gtable_add_cols(layout, rep(cm, 3))
+
+ layout <- gtable_add_col_space(layout, cm)
+ expect_that(ncol(layout), equals(5))
+
+ layout <- gtable_add_row_space(layout, cm)
+ expect_that(ncol(layout), equals(5))
+})
+
+test_that("Spacing adds rows/cols in correct place", {
+ layout <- gtable()
+ layout <- gtable_add_rows(layout, rep(cm, 2))
+ layout <- gtable_add_cols(layout, rep(cm, 2))
+
+ layout <- gtable_add_col_space(layout, null)
+ layout <- gtable_add_row_space(layout, null)
+
+ expect_that(as.vector(layout$heights), equals(rep(1, 3)))
+ expect_that(attr(layout$heights, "unit"), equals(c("cm", "null", "cm")))
+
+ expect_that(as.vector(layout$widths), equals(rep(1, 3)))
+ expect_that(attr(layout$widths, "unit"), equals(c("cm", "null", "cm")))
+
+})
+
+test_that("Negative positions place from end", {
+ layout <- gtable()
+ layout <- gtable_add_rows(layout, rep(cm, 3))
+ layout <- gtable_add_cols(layout, rep(cm, 3))
+
+ col_span <- gtable_add_grob(layout, grob1, t = 1, l = 1, r = -1)
+ expect_that(gtable_find(col_span, grob1),
+ equals(loc_df(t = 1, l = 1, b = 1, r = 3)))
+
+ row_span <- gtable_add_grob(layout, grob1, t = 1, l = 1, b = -1)
+ expect_that(gtable_find(row_span, grob1),
+ equals(loc_df(t = 1, l = 1, b = 3, r = 1)))
+})
+
+test_that("Adding multiple grobs", {
+ grobs <- rep(list(grob1), 8)
+
+ # With z = Inf, and t value for each grob
+ tval <- c(1, 2, 3, 1, 2, 3, 1, 2)
+ layout <- gtable_add_cols(gtable_add_rows(gtable(), rep(cm, 3)), rep(cm, 3))
+ layout <- gtable_add_grob(layout, grobs, tval, 1, 3, 3, z = Inf)
+ expect_equal(layout$layout$t, tval)
+ expect_equal(layout$layout$z, 1:8)
+
+ # With z = -Inf
+ layout <- gtable_add_cols(gtable_add_rows(gtable(), rep(cm, 3)), rep(cm, 3))
+ layout <- gtable_add_grob(layout, grobs, 1, 1, 3, 3, z = -Inf)
+ expect_equal(layout$layout$z, -7:0)
+
+ # Mixing Inf and non-Inf z values
+ zval <- c(Inf, Inf, 6, 0, -Inf, Inf, -2, -Inf)
+ layout <- gtable_add_cols(gtable_add_rows(gtable(), rep(cm, 3)), rep(cm, 3))
+ layout <- gtable_add_grob(layout, grobs, 1, 1, 3, 3, z = zval)
+ expect_equal(layout$layout$z, c(7, 8, 6, 0, -4, 9, -2, -3))
+
+ # Error if inputs are not length 1 or same length as grobs
+ layout <- gtable_add_cols(gtable_add_rows(gtable(), rep(cm, 3)), rep(cm, 3))
+ expect_error(gtable_add_grob(layout, grobs, c(1:3), 1, 3, 3))
+ expect_error(gtable_add_grob(layout, grobs, tval, 1:2, 3, 3))
+ expect_error(gtable_add_grob(layout, grobs, tval, 1, 3, 3, z = 1:4))
+
+})
diff --git a/tests/testthat/test-subsetting.r b/tests/testthat/test-subsetting.r
new file mode 100644
index 0000000..3faf110
--- /dev/null
+++ b/tests/testthat/test-subsetting.r
@@ -0,0 +1,183 @@
+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()
+
+unrowname <- function(x) {
+ rownames(x) <- NULL
+ x
+}
+
+# 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) {
+ 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)] ?
+})
diff --git a/tests/testthat/test-z-order.r b/tests/testthat/test-z-order.r
new file mode 100644
index 0000000..f8aba58
--- /dev/null
+++ b/tests/testthat/test-z-order.r
@@ -0,0 +1,82 @@
+context("z-order")
+
+# z tests for gtable_add_grob are in test-layout.r, mixed with other tests
+
+
+test_that("z order for row, column, and matrix layouts", {
+ zorder <- c(3, 1, 2, 4)
+
+ # ==== column ====
+ gt <- gtable_col("test", list(grob1, grob2, grob3, grob4))
+ # z for positions 1 2 3 4 (left to right) should equal 1:4
+ expect_equal(gt$layout$z[gt$layout$t], 1:4)
+
+ gt <- gtable_col("test", list(grob1, grob2, grob3, grob4), z = zorder)
+ # z for position 1 2 3 4 (left to right) should equal zorder
+ expect_equal(gt$layout$z[gt$layout$t], zorder)
+
+ # ==== row ====
+ gt <- gtable_row("test", list(grob1, grob2, grob3, grob4))
+ # z for positions 1 2 3 4 (top to bottom) should equal 1:4
+ expect_equal(gt$layout$z[gt$layout$l], 1:4)
+
+ gt <- gtable_row("test", list(grob1, grob2, grob3, grob4), z = zorder)
+ # z for position 1 2 3 4 (top to bottom) should equal zorder
+ expect_equal(gt$layout$z[gt$layout$l], zorder)
+
+ # ==== matrix ====
+ gt <- gtable_matrix("test", matrix(list(grob1, grob2, grob3, grob4),
+ nrow = 2), unit(c(1, 1), "null"), unit(c(1, 1), "null"))
+ # Get the position. Should be: 1 3
+ # 2 4
+ loc <- 2 * (gt$layout$l - 1) + gt$layout$t
+ # z for positions 1:4 should equal 1:4
+ expect_equal(gt$layout$z[loc], 1:4)
+
+ gt <- gtable_matrix("test", matrix(list(grob1, grob2, grob3, grob4),
+ nrow = 2), unit(c(1, 1), "null"), unit(c(1, 1), "null"),
+ z = matrix(zorder, nrow = 2))
+ # Get the position. Should be: 1 3
+ # 2 4
+ loc <- 2 * (gt$layout$l - 1) + gt$layout$t
+ # z for positions 1:4 should equal zorder
+ expect_equal(gt$layout$z[loc], zorder)
+
+})
+
+
+test_that("z_normalise works properly", {
+ # Non-integer starting zorder, in funny order
+ zorder <- c(0.001, -4, 0, 1e6)
+ gt <- gtable_col("test", list(grob1, grob2, grob3, grob4), z = zorder)
+ expect_equal(gt$layout$z, zorder)
+ gt1 <- z_normalise(gt)
+ expect_equal(sort(gt1$layout$z), 1:4)
+
+ # OK with empty layout (zero rows in data frame)
+ gt <- gtable(unit(1:3, c("cm")), unit(c(2,4), "cm"))
+ gt1 <- z_normalise(gt)
+ expect_equal(nrow(gt1$layout), 0)
+})
+
+
+
+test_that("z_arrange_gtables properly sets z values", {
+ gt <- list(
+ gtable_col("test1", list(grob1, grob2, grob3), z = c(.9, .3, .6)),
+ gtable_col("test2", list(grob4, grob1, grob2), z = c(1, 3, 2)),
+ gtable_col("test3", list(grob3, grob4, grob1), z = c(2, 3, 1))
+ )
+
+ # Arrange the z values of each gtable
+ gt1 <- z_arrange_gtables(gt, c(3, 2, 1))
+ expect_equal(gt1[[1]]$layout$z, c(9, 7, 8))
+ expect_equal(gt1[[2]]$layout$z, c(4, 6, 5))
+ expect_equal(gt1[[3]]$layout$z, c(2, 3, 1))
+
+ # Check that it works with cbind and rbind (which call z_arrange_gtables)
+ gt1 <- cbind(gt[[1]], gt[[2]], gt[[3]], z = c(3, 2, 1))
+ expect_equal(gt1$layout$z, c(9, 7, 8, 4, 6, 5, 2, 3, 1))
+ gt1 <- rbind(gt[[1]], gt[[2]], gt[[3]], z = c(3, 2, 1))
+ expect_equal(gt1$layout$z, c(9, 7, 8, 4, 6, 5, 2, 3, 1))
+})
\ No newline at end of file
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-gtable.git
More information about the debian-med-commit
mailing list