gtable/0000755000175100001440000000000012664057722011541 5ustar hornikusersgtable/tests/0000755000175100001440000000000012654662334012703 5ustar hornikusersgtable/tests/testthat.R0000644000175100001440000000007012654662334014663 0ustar hornikuserslibrary(testthat) library(gtable) test_check("gtable") gtable/tests/testthat/0000755000175100001440000000000012664057722014543 5ustar hornikusersgtable/tests/testthat/Rplots.pdf0000644000175100001440000000736612664045505016531 0ustar hornikusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20160226065532) /ModDate (D:20160226065532) /Title (R Graphics Output) /Producer (R 3.2.3) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 21 /Filter /FlateDecode >> stream x3TR0TR( a.~Yendstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R ] /Count 1 /MediaBox [0 0 504 504] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <<>> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj xref 0 10 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000000383 00000 n 0000000466 00000 n 0000000567 00000 n 0000000600 00000 n 0000000212 00000 n 0000000292 00000 n 0000003295 00000 n trailer << /Size 10 /Info 1 0 R /Root 2 0 R >> startxref 3552 %%EOF gtable/tests/testthat/test-z-order.r0000644000175100001440000000560411775344342017271 0ustar hornikuserscontext("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/tests/testthat/helper-units.r0000644000175100001440000000014512542004776017341 0ustar hornikuserslibrary(grid) cm <- unit(1, "cm") cm2 <- unit(2, "cm") cm5 <- unit(5, "cm") null <- unit(1, "null") gtable/tests/testthat/helper-grobs.r0000644000175100001440000000014412542004766017311 0ustar hornikuserslibrary(grid) grob1 <- rectGrob() grob2 <- circleGrob() grob3 <- linesGrob() grob4 <- polygonGrob() gtable/tests/testthat/test-layout.r0000644000175100001440000001154311775344342017223 0ustar hornikuserslibrary(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/tests/testthat/test-subsetting.r0000644000175100001440000001417412664045504020074 0ustar hornikuserscontext("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)] ? }) gtable/tests/testthat/test-bind.r0000644000175100001440000000220311677443524016616 0ustar hornikuserscontext("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/NAMESPACE0000644000175100001440000000153212654662334012761 0ustar hornikusers# 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) gtable/NEWS.md0000644000175100001440000000150312664045335012633 0ustar hornikusers# 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 . * 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. gtable/R/0000755000175100001440000000000012664046702011736 5ustar hornikusersgtable/R/rbind-cbind.r0000644000175100001440000000457612542005240014273 0ustar hornikusers#' 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/z.r0000644000175100001440000000251611775344342012401 0ustar hornikusers#' 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/gtable.r0000644000175100001440000001670612656134342013370 0ustar hornikusers#' 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) gtable/R/grid.r0000644000175100001440000000405112654443304013044 0ustar hornikusers#' 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 } gtable/R/filter.r0000644000175100001440000000162112542004525013376 0ustar hornikusers#' 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 } gtable/R/padding.r0000644000175100001440000000151312654131024013516 0ustar hornikusers#' 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 } gtable/R/add-space.r0000644000175100001440000000173212654131024013734 0ustar hornikusers#' 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 } gtable/R/gtable-layouts.r0000644000175100001440000000760512542004525015055 0ustar hornikusers#' 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) } gtable/R/add-rows-cols.r0000644000175100001440000000527412542004354014577 0ustar hornikusers#' 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 } gtable/R/align.r0000644000175100001440000000744312654131024013212 0ustar hornikusers# 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)) } gtable/R/utils.r0000644000175100001440000000272212654132150013254 0ustar hornikusers 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/add-grob.r0000644000175100001440000000502311775344342013603 0ustar hornikusers#' 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/R/trim.r0000644000175100001440000000154612542004525013072 0ustar hornikusers#' 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 } gtable/README.md0000644000175100001440000000067412664046515013025 0ustar hornikusers# gtable [![Travis-CI Build Status](https://travis-ci.org/hadley/gtable.svg?branch=master)](https://travis-ci.org/hadley/gtable) [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/gtable)](http://cran.r-project.org/package=gtable) [![Coverage Status](https://img.shields.io/codecov/c/github/hadley/gtable/master.svg)](https://codecov.io/github/hadley/gtable?branch=master) gtable provides internal tools used to draw ggplot2 graphics. gtable/MD50000644000175100001440000000447112664057722012057 0ustar hornikusers834c2d74c10a205f7cc75e6d11a27437 *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 gtable/DESCRIPTION0000644000175100001440000000126412664057722013252 0ustar hornikusersPackage: 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", , "hadley@rstudio.com", c("aut", "cre")) Depends: R (>= 2.14) Imports: grid Suggests: testthat, covr License: GPL-2 Collate: 'add-grob.r' 'add-rows-cols.r' 'add-space.r' 'grid.r' 'gtable-layouts.r' 'gtable.r' 'rbind-cbind.r' 'utils.r' 'trim.r' 'filter.r' 'align.r' 'padding.r' 'z.r' RoxygenNote: 5.0.1 NeedsCompilation: no Packaged: 2016-02-26 13:06:10 UTC; hadley Author: Hadley Wickham [aut, cre] Maintainer: Hadley Wickham Repository: CRAN Date/Publication: 2016-02-26 15:23:14 gtable/man/0000755000175100001440000000000012654662327012316 5ustar hornikusersgtable/man/gtable_row.Rd0000644000175100001440000000206612653763223014732 0ustar hornikusers% 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) } gtable/man/gtable_spacer.Rd0000644000175100001440000000066212653763223015400 0ustar hornikusers% 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. } gtable/man/gtable_add_space.Rd0000644000175100001440000000106012653763223016017 0ustar hornikusers% 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. } gtable/man/gtable_show_layout.Rd0000644000175100001440000000045712653763223016502 0ustar hornikusers% 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. } gtable/man/gtable_width.Rd0000644000175100001440000000052612653763223015241 0ustar hornikusers% 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. } gtable/man/bind.Rd0000644000175100001440000000163412653763223013521 0ustar hornikusers% 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. } gtable/man/gtable_col.Rd0000644000175100001440000000207412653763223014677 0ustar hornikusers% 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) } gtable/man/z_arrange_gtables.Rd0000644000175100001440000000105412653763223016252 0ustar hornikusers% 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. } gtable/man/gtable_trim.Rd0000644000175100001440000000117612653763223015077 0ustar hornikusers% 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)) } gtable/man/gtable_height.Rd0000644000175100001440000000053312653763223015370 0ustar hornikusers% 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. } gtable/man/gtable_add_padding.Rd0000644000175100001440000000131612653763223016336 0ustar hornikusers% 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)) } gtable/man/is.gtable.Rd0000644000175100001440000000036512653763223014455 0ustar hornikusers% 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? } gtable/man/gtable.Rd0000644000175100001440000000643012653763223014042 0ustar hornikusers% 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. } gtable/man/gtable_add_rows.Rd0000644000175100001440000000221112653763223015715 0ustar hornikusers% 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) } gtable/man/gtable_add_cols.Rd0000644000175100001440000000221712653763223015671 0ustar hornikusers% 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) } gtable/man/gtable_filter.Rd0000644000175100001440000000257012653763223015410 0ustar hornikusers% 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)) } gtable/man/gtable_matrix.Rd0000644000175100001440000000326112653763223015425 0ustar hornikusers% 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) } gtable/man/z_normalise.Rd0000644000175100001440000000110112653763223015114 0ustar hornikusers% 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. } gtable/man/gtable_add_grob.Rd0000644000175100001440000000255112653763223015663 0ustar hornikusers% 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 } gtable/man/print.gtable.Rd0000644000175100001440000000062512653763223015175 0ustar hornikusers% 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 }