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 <[email protected]> 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@R: person("Hadley", "Wickham", , "[email protected]", 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 <[email protected]> +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 <[email protected]> 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 <[email protected]> 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 <[email protected]> Wed, 08 May 2013 15:13:25 -0700 - -gtable (0.1.2-1) unstable; urgency=low - - * Initial release (Closes: #700861) - - -- Ivo Maintz <[email protected]> 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 <[email protected]> -Uploaders: Andreas Tille <[email protected]> -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 <[email protected]> -License: GPL-2.0+ - -Files: debian/* -Copyright: 2012 Ivo Maintz <[email protected]> -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 <[email protected]> -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 _______________________________________________ debian-med-commit mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/debian-med-commit
