1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
#' Trim off empty cells.
#'
#' This function detects rows and columns that does not contain any grobs and
#' removes thewm from the gtable. If the rows and/or columns removed had a
#' non-zero height/width the relative layout of the gtable may change.
#'
#' @param x a gtable object
#'
#' @return A gtable object
#'
#' @family gtable modification
#'
#' @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) {
check_gtable(x)
if (length(x) == 0) {
return(gtable(respect = x$respect, name = x$name, vp = x$vp))
}
layout <- unclass(x$layout)
w <- range(layout$l, layout$r)
h <- range(layout$t, layout$b)
x$widths <- x$widths[seq.int(w[1], w[2])]
x$heights <- x$heights[seq.int(h[1], h[2])]
layout$l <- layout$l - w[1] + 1
layout$r <- layout$r - w[1] + 1
layout$t <- layout$t - h[1] + 1
layout$b <- layout$b - h[1] + 1
x$layout <- new_data_frame(layout)
x
}
|
