gtable/0000755000176000001440000000000012057634771011554 5ustar ripleyusersgtable/MD50000644000176000001440000000426612057634771012074 0ustar ripleyusersb81fc96ac2b39b0f70401d4f493a011c *DESCRIPTION aceff3cac159b84c2301a916425f5bb9 *NAMESPACE 87ec502e2754ffe60370d2b945b114d2 *NEWS aa2d8709ce2b301b8ea881d3496fcf55 *R/add-grob.r a3934688cb46d87a212f19a2ccdeb320 *R/add-rows-cols.r 2e99bd0f88a2aac5becadd942d92062b *R/add-space.r 94620d21a0d192a9b8caadb388347d90 *R/align.r 77cd910b23e4260e50029091d34283af *R/filter.r 3c4d1c5c6a4693f93c3e7c5e30fea90d *R/grid.r acafba5a5073f924fa0169a97e8d5c1c *R/gtable-layouts.r 5e6b094ab70064795b3dd7db83d4ffaa *R/gtable.r 1b46efbe71745d129c6a6034141ac3eb *R/padding.r 0cf68b5d9b21412cc318c0c878b6646d *R/rbind-cbind.r 3d6f7e2babbdd7bde1d09db90ade24b3 *R/trim.r f99e08ad7dd7fc50cc3fed8984845c5b *R/utils.r 1d504b5fcc6c82b8e7e8aa299b215581 *R/z.r d4038fe2389d89f42602aab100f37334 *inst/tests/helper-grobs.r 529e88d1f05f6a633dd68ad02dcf0001 *inst/tests/helper-units.r c315b57f2b0397beb11679f27448019d *inst/tests/test-bind.r 9f95edcd48968ecf13d4a288ec9c256e *inst/tests/test-layout.r 422622d93fb628919439fd9f22e8a549 *inst/tests/test-subsetting.r 322fd392f79b8e530830af4f80799997 *inst/tests/test-z-order.r 495df46bc966e9d48bf8f8ac0c724d54 *man/bind.Rd 37a3a03b500ef6d20a21bc378ca3fac9 *man/gtable.Rd 3941ea35bd50999359938253ecefc21f *man/gtable_add_cols.Rd 1caf4b916a6b18fa94ac722d8dcfc8a5 *man/gtable_add_grob.Rd 8c54fbb1228002dc7c6b0d3a9c4d5901 *man/gtable_add_padding.Rd 0372f7bc2f76f59a579f4a79deacf8d0 *man/gtable_add_rows.Rd ba028c61f47a29d598c6ca18ad86bf30 *man/gtable_add_space.Rd 45f385b8e02865ed79481dd7cc5d9d43 *man/gtable_col.Rd 8f6801e2e8c570626da0ab13b5942b20 *man/gtable_filter.Rd 83d47aeea7ffee23e80b87ca4723d003 *man/gtable_height.Rd bd8748bfe0f21c37534f40dee8f807a2 *man/gtable_matrix.Rd d3634ed8f858d9a7e3b0a3fec7bb484b *man/gtable_row.Rd ccf60fbc0f78eedb6032cd156b92174d *man/gtable_show_layout.Rd c10bb024e479195497aee5d02efdcc5b *man/gtable_spacer.Rd cba8ca38810e61ba86309c0d55a1a995 *man/gtable_trim.Rd d8257c34950ebeec8a8465ce8670085e *man/gtable_width.Rd 8b8b5e451db347726445b25439ac097d *man/is.gtable.Rd acdfd5ad891db98f177b7f480ca2ab30 *man/print.gtable.Rd e1e8c8450df614a6bdd56b679ecdd74c *man/z_arrange_gtables.Rd 444a2ea9a33f20d3d61dbb3c32d1a9e7 *man/z_normalise.Rd 351ec868144d09e329474de7f9a2c9c8 *tests/test-all.R gtable/tests/0000755000176000001440000000000011507203335012701 5ustar ripleyusersgtable/tests/test-all.R0000644000176000001440000000007111677415004014555 0ustar ripleyuserslibrary(testthat) library(gtable) test_package("gtable")gtable/R/0000755000176000001440000000000012057501556011747 5ustar ripleyusersgtable/R/z.r0000644000176000001440000000251611775344342012413 0ustar ripleyusers#' 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 } gtable/R/utils.r0000644000176000001440000000273011775344342013300 0ustar ripleyusers 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 } } gtable/R/trim.r0000644000176000001440000000153511677402017013110 0ustar ripleyusers#' Trim off empty cells. #' #' @param x a gtable object #' @export #' @examples #' 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 } gtable/R/rbind-cbind.r0000644000176000001440000000460411775344342014315 0ustar ripleyusers#' 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 } gtable/R/padding.r0000644000176000001440000000147111775344342013547 0ustar ripleyusers#' 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 #' 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 = 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 } gtable/R/gtable.r0000644000176000001440000001707412057501514013373 0ustar ripleyusers#' 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 #' accross 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 #' 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) } grob( 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) } #' @S3method dim gtable dim.gtable <- function(x) c(length(x$heights), length(x$widths)) #' @S3method dimnames gtable dimnames.gtable <- function(x, ...) list(x$rownames, x$colnames) #' @S3method dimnames<- gtable "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 } #' @S3method plot gtable 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") } #' @S3method t gtable 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 } #' @S3method [ gtable "[.gtable" <- function(x, i, j) { # Convert indicies to (named) numeric rows <- setNames(seq_along(x$heights), rownames(x))[i] cols <- 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 } #' @S3method length gtable 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)gtable/R/gtable-layouts.r0000644000176000001440000000754012003550302015054 0ustar ripleyusers#' 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 #' 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 #' 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 #' 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) } gtable/R/grid.r0000644000176000001440000000462612021223054013050 0ustar ripleyusers#' 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 = "") } #' @S3method widthDetails gtable widthDetails.gtable <- function(x) absolute.size(gtable_width(x)) #' @S3method heightDetails gtable heightDetails.gtable <- function(x) absolute.size(gtable_height(x)) #' @S3method grid.draw gtable grid.draw.gtable <- function(x, recording = TRUE) { if (length(x$grobs) == 0) return(invisible()) 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) if (inherits(x, "gTableChild")) { gt <- gTree(children = do.call("gList", x$grobs[order(x$layout$z)]), cl = c("gTableParent", "gTableChild"), vp = x$vp, wrapvp = x$wrapvp, layoutvp = viewport(layout = gtable_layout(x), name = x$name)) } else { gt <- gTree(children = do.call("gList", x$grobs[order(x$layout$z)]), cl = c("gTableParent"), vp = x$vp, layoutvp = viewport(layout = gtable_layout(x), name = x$name)) } grid.draw(gt) invisible() } #' @S3method grid.draw gTableChild grid.draw.gTableChild <- function(x, recording) { pushViewport(x$wrapvp, recording = FALSE) NextMethod() upViewport(recording = FALSE) } #' @S3method preDrawDetails gTableParent preDrawDetails.gTableParent <- function(x) { pushViewport(x$layoutvp, recording = FALSE) } #' @S3method postDrawDetails gTableParent postDrawDetails.gTableParent <- function(x) { upViewport(recording = FALSE) } # 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 } gtable/R/filter.r0000644000176000001440000000160711721725470013423 0ustar ripleyusers#' 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 #' 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 } gtable/R/align.r0000644000176000001440000000757712003550302013224 0ustar ripleyusers# 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 <- rownames(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) # spacer <- x[rep_along(NA, missing), ] # rownames(spacer) <- missing x <- rbind(x, spacer, size = "first") } else { spacer <- gtable( heights = unit(rep(0, ncol(x)), "cm"), widths = rep_along(unit(0, "cm"), missing), colnames = missing) # spacer <- x[, rep_along(NA, missing)] # colnames(spacer) <- 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)) } gtable/R/add-space.r0000644000176000001440000000172211721701433013746 0ustar ripleyusers#' 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 = 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 = n) for(i in rev(seq_len(n))) { x <- gtable_add_rows(x, height[i], pos = i) } x } gtable/R/add-rows-cols.r0000644000176000001440000000524611677422162014621 0ustar ripleyusers#' 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 #' 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 #' 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 } gtable/R/add-grob.r0000644000176000001440000000502311775344342013615 0ustar ripleyusers#' 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 } gtable/NEWS0000644000176000001440000000074112057501521012237 0ustar ripleyusersVersion 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. gtable/NAMESPACE0000644000176000001440000000153012021223054012745 0ustar ripleyusersS3method("[",gtable) S3method("dimnames<-",gtable) S3method(cbind,gtable) S3method(dim,gtable) S3method(dimnames,gtable) S3method(grid.draw,gTableChild) S3method(grid.draw,gtable) S3method(heightDetails,gtable) S3method(length,gtable) S3method(plot,gtable) S3method(postDrawDetails,gTableParent) S3method(preDrawDetails,gTableParent) 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) gtable/man/0000755000176000001440000000000012057501514012313 5ustar ripleyusersgtable/man/z_normalise.Rd0000644000176000001440000000100111775344342015126 0ustar ripleyusers\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. } gtable/man/z_arrange_gtables.Rd0000644000176000001440000000075211775344342016271 0ustar ripleyusers\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. } gtable/man/print.gtable.Rd0000644000176000001440000000051112057501514015170 0ustar ripleyusers\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 } gtable/man/is.gtable.Rd0000644000176000001440000000024411721732774014465 0ustar ripleyusers\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? } gtable/man/gtable_width.Rd0000644000176000001440000000040712003550302015226 0ustar ripleyusers\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. } gtable/man/gtable_trim.Rd0000644000176000001440000000104111721732774015102 0ustar ripleyusers\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{ 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/man/gtable_spacer.Rd0000644000176000001440000000053511721732774015413 0ustar ripleyusers\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. } gtable/man/gtable_show_layout.Rd0000644000176000001440000000034011721732774016505 0ustar ripleyusers\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. } gtable/man/gtable_row.Rd0000644000176000001440000000174612003550302014725 0ustar ripleyusers\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{height}{a unit vector giving the height of this row} \item{vp}{a grid viewport object (or NULL).} \item{name}{a string giving the name of the table. This is used to name the layout viewport} \item{widths}{a unit vector giving the width of each column} \item{grobs}{a single grob or a list of 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.} } \description{ Create a single row gtable. } \examples{ 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/man/gtable_matrix.Rd0000644000176000001440000000315512003550302015416 0ustar ripleyusers\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{z}{a numeric matrix of the same dimensions as \code{grobs}, specifying the order that the grobs are drawn.} \item{vp}{a grid viewport object (or NULL).} \item{name}{a string giving the name of the table. This is used to name the layout viewport} \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{grobs}{a single grob or a list of grobs} \item{clip}{should drawing be clipped to the specified cells (\code{"on"}), the entire table (\code{"inherit"}), or not at all (\code{"off"})} } \description{ Create a gtable from a matrix of grobs. } \examples{ 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/man/gtable_height.Rd0000644000176000001440000000041412003550302015355 0ustar ripleyusers\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. } gtable/man/gtable_filter.Rd0000644000176000001440000000242711721732774015425 0ustar ripleyusers\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{trim}{if \code{TRUE}, \code{\link{gtable_trim}} will be used to trim off any empty cells.} \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.} } \description{ Filter cells by name. } \examples{ 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/man/gtable_col.Rd0000644000176000001440000000175412003550302014672 0ustar ripleyusers\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{width}{a unit vector giving the width of this column} \item{vp}{a grid viewport object (or NULL).} \item{name}{a string giving the name of the table. This is used to name the layout viewport} \item{heights}{a unit vector giving the height of each row} \item{grobs}{a single grob or a list of 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.} } \description{ Create a single column gtable. } \examples{ 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/man/gtable_add_space.Rd0000644000176000001440000000074411721732774016043 0ustar ripleyusers\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. } gtable/man/gtable_add_rows.Rd0000644000176000001440000000205511721732774015737 0ustar ripleyusers\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{ 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/man/gtable_add_padding.Rd0000644000176000001440000000116211721732774016351 0ustar ripleyusers\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{ 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/man/gtable_add_grob.Rd0000644000176000001440000000247711721732774015706 0ustar ripleyusers\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 } gtable/man/gtable_add_cols.Rd0000644000176000001440000000206311721732774015704 0ustar ripleyusers\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{ 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/man/gtable.Rd0000644000176000001440000000640212003550302014030 0ustar ripleyusers\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 accross 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{ 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. } gtable/man/bind.Rd0000644000176000001440000000154011775344342013530 0ustar ripleyusers\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. } gtable/inst/0000755000176000001440000000000011677414762012534 5ustar ripleyusersgtable/inst/tests/0000755000176000001440000000000012021223054013646 5ustar ripleyusersgtable/inst/tests/test-z-order.r0000644000176000001440000000560411775344342016420 0ustar ripleyuserscontext("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)) })gtable/inst/tests/test-subsetting.r0000644000176000001440000001413412021223054017200 0ustar ripleyuserscontext("Subsetting") base <- gtable(unit(rep(1, 3), "null"), unit(rep(1, 3), "null")) rownames(base) <- LETTERS[1:3] colnames(base) <- letters[1:3] test_that("dimensions correct after subsetting", { expect_equal(dim(base[, ]), c(3, 3)) expect_equal(dim(base[1:3, 1:3]), c(3, 3)) expect_equal(dim(base[T, T]), c(3, 3)) expect_equal(dim(base[c("A", "B", "C"), c("a", "b", "c")]), c(3, 3)) expect_equal(dim(base[1, 1]), c(1, 1)) expect_equal(dim(base[c(T, F, F), c(T, F, F)]), c(1, 1)) expect_equal(dim(base[-(2:3), -(2:3)]), c(1, 1)) expect_equal(dim(base["A", "b"]), c(1, 1)) expect_equal(dim(base[1:2, 2:3]), c(2, 2)) }) rect <- rectGrob() mid <- gtable_add_grob(base, rect, 2, 2) row <- gtable_add_grob(base, rect, 2, l = 1, r = 3) col <- gtable_add_grob(base, rect, 2, t = 1, b = 3) tlbr <- function(x) unname(unlist(x$layout[c("t", "l", "b", "r")])) test_that("grobs moved to correct location", { expect_equal(tlbr(mid[2, 2]), c(1, 1, 1, 1)) expect_equal(tlbr(mid[2:3, 2:3]), c(1, 1, 1, 1)) expect_equal(tlbr(mid[1:2, 1:2]), c(2, 2, 2, 2)) expect_equal(tlbr(mid[1:3, 1:3]), c(2, 2, 2, 2)) }) test_that("spanning grobs kept if ends kept", { expect_equal(length(row[, -2]), 1) expect_equal(tlbr(row[, -2]), c(2, 1, 2, 2)) expect_equal(length(col[-2, ]), 1) expect_equal(tlbr(col[-2, ]), c(1, 2, 2, 2)) expect_equal(length(row[, 1]), 0) expect_equal(length(col[1, ]), 0) }) # Detailed tests for indexing with [.gtable ---------------------------------- # Some of these tests can be confusing; if you need to see # what's going on, run grid.draw(gt) # Make a bunch of grobs g1 <- rectGrob() g2 <- circleGrob() g3 <- polygonGrob() g4 <- linesGrob() g5 <- circleGrob() g6 <- rectGrob() # Check that two gtable objects are the same. # This allows for differences in how units are stored and other subtle # changes that don't affect appearance. equal_gtable <- function(a, b) { require(plyr) identical(a$grobs, b$grobs) && # Normalized z values are the same (ensuring same render order) # Also ignore row names all.equal(unrowname(z_normalise(a)$layout), unrowname(z_normalise(b)$layout)) && # Test widths/heights for equality. # This is the best way I could think of, but it's not very nice all(convertUnit(a$widths - b$widths, "cm", valueOnly = TRUE) == 0) && all(convertUnit(a$heights - b$heights, "cm", valueOnly = TRUE) == 0) && all.equal(a$respect, b$respect) && all.equal(a$rownames, b$rownames) && all.equal(a$colnames, b$colnames) } # This will create a new gtable made with gtable_matrix # using the specified cols and rows from grobmat. # The sizes of the rows/cols are the same as the index values (but in cm) make_gt <- function(grobmat, rows, cols) { gtable_matrix("test", grobmat[rows, cols, drop = FALSE], heights=unit(rows, "cm"), widths=unit(cols, "cm") ) } test_that("Indexing with single-cell grobs", { # Make a 2x3 gtable where each cell has one grob grobmat <- matrix(list(g1, g2, g3, g4, g5, g6), nrow=2) gt <- make_gt(grobmat, 1:2, 1:3) # Indexing in ways that don't change gt expect_true(equal_gtable(gt, gt[1:2, 1:3])) expect_true(equal_gtable(gt, gt[])) expect_true(equal_gtable(gt, gt[1:2, ])) expect_true(equal_gtable(gt, gt[, 1:3])) # New table from contiguous cells expect_true(equal_gtable(gt[1, 1], make_gt(grobmat, 1, 1))) expect_true(equal_gtable(gt[2, 2], make_gt(grobmat, 2, 2))) expect_true(equal_gtable(gt[1:2, 1], make_gt(grobmat, 1:2, 1))) expect_true(equal_gtable(gt[1:2, 2], make_gt(grobmat, 1:2, 2))) expect_true(equal_gtable(gt[1, 1:3], make_gt(grobmat, 1, 1:3))) expect_true(equal_gtable(gt[1, 1:2], make_gt(grobmat, 1, 1:2))) expect_true(equal_gtable(gt[1:2, 1:2], make_gt(grobmat, 1:2, 1:2))) expect_true(equal_gtable(gt[1:2, 2:3], make_gt(grobmat, 1:2, 2:3))) # New table from non-contiguous cells expect_true(equal_gtable(gt[1, c(1, 3)], make_gt(grobmat, 1, c(1, 3)))) expect_true(equal_gtable(gt[1:2, c(1, 3)], make_gt(grobmat, 1:2, c(1, 3)))) }) test_that("Indexing with names", { # Make a 2x3 gtable where each cell has one grob grobmat <- matrix(list(g1, g2, g3, g4, g5, g6), nrow=2) gt <- make_gt(grobmat, 1:2, 1:3) dimnames(gt) <- list(c("a","b"), c("x","y","z")) expect_true(equal_gtable(gt, gt[c("a","b"), c("x","y","z")])) expect_true(equal_gtable(gt[1, ], gt["a", ])) expect_true(equal_gtable(gt[, 2], gt[, "y"])) expect_true(equal_gtable(gt[, 2:3], gt[, c("y","z")])) expect_true(equal_gtable(gt[1, 1:2], gt["a", c("x","y")])) expect_true(equal_gtable(gt[1, 1:2], gt["a", 1:2])) }) # Make a gtable with grobs that span cells make_span_gt <- function(rows, cols) { # Make gtable with one grob at (1:1, 1:3) and another at (1:2, 1:2) gt <- gtable(name = "test", heights=unit(rows, "cm"), widths=unit(cols, "cm") ) if (all(1 %in% rows) && all(c(1,3) %in% cols)) { gt <- gtable_add_grob(gt, g3, 1, 1, 1, length(cols)) } if (all(1:2 %in% rows) && all(c(1,2) %in% cols)) { gt <- gtable_add_grob(gt, g4, 1, 1, 2, 2) } gt } test_that("Indexing with grobs that span cells", { # Make a gtable with two grobs that span cells gt <- make_span_gt(1:2, 1:3) # Indexing in ways that don't change gt expect_true(equal_gtable(gt, gt[1:2, 1:3])) # If a cell at the end of a grob is dropped, drop the grob # These should drop all grobs expect_true(equal_gtable(gt[1, 2], make_span_gt(1, 2))) expect_equal(length(gt[1, 2]$grobs), 0) expect_true(equal_gtable(gt[1:2, 2], make_span_gt(1:2, 2))) expect_equal(length(gt[1:2, 2]$grobs), 0) # These should preserve one of the grobs expect_true(equal_gtable(gt[1:2, 1:2], make_span_gt(1:2, 1:2))) expect_equal(length(gt[1:2, 1:2]$grobs), 1) expect_true(equal_gtable(gt[1, 1:3], make_span_gt(1, 1:3))) expect_equal(length(gt[1, 1:3]$grobs), 1) # If a cell in the middle of a grob is dropped, don't drop the grob expect_true(equal_gtable(gt[1, c(1,3)], make_span_gt(1, c(1,3)))) expect_equal(length(gt[1, c(1,3)]$grobs), 1) # Currently undefined behavior: # What happens when you do repeat rows/cols, like gt[1, c(1,1,1,3)] ? # What happens when order is non-monotonic, like gt[1, c(3,1,2)] ? })gtable/inst/tests/test-layout.r0000644000176000001440000001154311775344342016352 0ustar ripleyuserslibrary(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)) }) gtable/inst/tests/test-bind.r0000644000176000001440000000220311677443524015745 0ustar ripleyuserscontext("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) }) gtable/inst/tests/helper-units.r0000644000176000001440000000012711677442125016472 0ustar ripleyuserscm <- unit(1, "cm") cm2 <- unit(2, "cm") cm5 <- unit(5, "cm") null <- unit(1, "null") gtable/inst/tests/helper-grobs.r0000644000176000001440000000012611775344342016444 0ustar ripleyusersgrob1 <- rectGrob() grob2 <- circleGrob() grob3 <- linesGrob() grob4 <- polygonGrob() gtable/DESCRIPTION0000644000176000001440000000111312057634771013256 0ustar ripleyusersPackage: gtable Type: Package Title: Arrange grobs in tables. Version: 0.1.2 Author: Hadley Wickham Maintainer: Hadley Wickham Description: Tools to make it easier to work with "tables" of grobs. Depends: R (>= 2.14), grid Suggests: testthat, plyr 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' Packaged: 2012-12-04 23:12:46 UTC; hadley Repository: CRAN Date/Publication: 2012-12-05 13:11:37