1## ----setup, echo=FALSE, results='hide'-----------------------------------
2library(knitr)
3opts_chunk$set(message=FALSE, fig.width=4, fig.height=2)
4
5## ----basic---------------------------------------------------------------
6library(gridExtra)
7library(grid)
8d <- head(iris[,1:3])
9grid.table(d)
10
11## ----annotations, fig.height=3-------------------------------------------
12d[2,3] <- "this is very wwwwwide"
13d[1,2] <- "this\nis\ntall"
14colnames(d) <- c("alpha*integral(xdx,a,infinity)",
15                 "this text\nis high", 'alpha/beta')
16
17tt <- ttheme_default(colhead=list(fg_params = list(parse=TRUE)))
18grid.table(d, theme=tt)
19
20
21## ----theme, fig.width=8--------------------------------------------------
22tt1 <- ttheme_default()
23tt2 <- ttheme_minimal()
24tt3 <- ttheme_minimal(
25  core=list(bg_params = list(fill = blues9[1:4], col=NA),
26            fg_params=list(fontface=3)),
27  colhead=list(fg_params=list(col="navyblue", fontface=4L)),
28  rowhead=list(fg_params=list(col="orange", fontface=3L)))
29
30grid.arrange(
31  tableGrob(iris[1:4, 1:2], theme=tt1),
32  tableGrob(iris[1:4, 1:2], theme=tt2),
33  tableGrob(iris[1:4, 1:2], theme=tt3),
34  nrow=1)
35
36## ----recycling-----------------------------------------------------------
37t1 <- ttheme_default(core=list(
38        fg_params=list(fontface=c(rep("plain", 4), "bold.italic")),
39        bg_params = list(fill=c(rep(c("grey95", "grey90"),
40                                    length.out=4), "#6BAED6"),
41                         alpha = rep(c(1,0.5), each=5))
42        ))
43
44grid.table(iris[1:5, 1:3], theme = t1)
45
46## ----justify, fig.width=8------------------------------------------------
47tt1 <- ttheme_default()
48tt2 <- ttheme_default(core=list(fg_params=list(hjust=1, x=0.9)),
49                      rowhead=list(fg_params=list(hjust=1, x=0.95)))
50tt3 <- ttheme_default(core=list(fg_params=list(hjust=0, x=0.1)),
51                      rowhead=list(fg_params=list(hjust=0, x=0)))
52grid.arrange(
53  tableGrob(mtcars[1:4, 1:2], theme=tt1),
54  tableGrob(mtcars[1:4, 1:2], theme=tt2),
55  tableGrob(mtcars[1:4, 1:2], theme=tt3),
56  nrow=1)
57
58## ----sizes, fig.width=8--------------------------------------------------
59g <- g2 <- tableGrob(iris[1:4, 1:3], cols = NULL, rows=NULL)
60g2$widths <- unit(rep(1/ncol(g2), ncol(g2)), "npc")
61grid.arrange(rectGrob(), rectGrob(), nrow=1)
62grid.arrange(g, g2, nrow=1, newpage = FALSE)
63
64## ----align, fig.width=6, fig.height=3------------------------------------
65d1 <- PlantGrowth[1:3,1, drop=FALSE]
66d2 <- PlantGrowth[1:2,1:2]
67
68g1 <- tableGrob(d1)
69g2 <- tableGrob(d2)
70
71haligned <- gtable_combine(g1,g2, along=1)
72valigned <- gtable_combine(g1,g2, along=2)
73grid.newpage()
74grid.arrange(haligned, valigned, ncol=2)
75
76## ----numberingDemo1------------------------------------------------------
77library(gtable)
78g <- tableGrob(iris[1:4, 1:3], rows = NULL)
79g <- gtable_add_grob(g,
80		grobs = rectGrob(gp = gpar(fill = NA, lwd = 2)),
81		t = 2, b = nrow(g), l = 1, r = ncol(g))
82g <- gtable_add_grob(g,
83		grobs = rectGrob(gp = gpar(fill = NA, lwd = 2)),
84		t = 1, l = 1, r = ncol(g))
85grid.draw(g)
86
87## ----numberingDemo2------------------------------------------------------
88g <- tableGrob(iris[1:4, 1:3])
89g <- gtable_add_grob(g,
90		grobs = rectGrob(gp = gpar(fill = NA, lwd = 2)),
91		t = 2, b = nrow(g), l = 1, r = ncol(g))
92g <- gtable_add_grob(g,
93		grobs = rectGrob(gp = gpar(fill = NA, lwd = 2)),
94		t = 1, l = 1, r = ncol(g))
95grid.draw(g)
96
97## ----segments1-----------------------------------------------------------
98g <- tableGrob(iris[1:4, 1:3])
99g <- gtable_add_grob(g,
100		grobs = segmentsGrob( # line across the bottom
101			x0 = unit(0,"npc"),
102			y0 = unit(0,"npc"),
103			x1 = unit(1,"npc"),
104			y1 = unit(0,"npc"),
105			gp = gpar(lwd = 2.0)),
106		t = 3, b = 3, l = 3, r = 3)
107grid.draw(g)
108
109## ----segments2-----------------------------------------------------------
110g <- tableGrob(iris[1:4, 1:3])
111g <- gtable_add_grob(g,
112		grobs = segmentsGrob( # line across the bottom
113      x0 = unit(0,"npc"),
114			y0 = unit(0,"npc"),
115			x1 = unit(0,"npc"),
116			y1 = unit(1,"npc"),
117			gp = gpar(lwd = 2.0)),
118		t = 3, b = 3, l = 3, r = 3)
119grid.draw(g)
120
121## ----segments3-----------------------------------------------------------
122g <- tableGrob(iris[1:4, 1:3])
123g <- gtable_add_grob(g,
124		grobs = grobTree(
125			segmentsGrob( # diagonal line ul -> lr
126				x0 = unit(0,"npc"),
127				y0 = unit(1,"npc"),
128				x1 = unit(1,"npc"),
129				y1 = unit(0,"npc"),
130				gp = gpar(lwd = 2.0)),
131			segmentsGrob( # diagonal line ll -> ur
132				x0 = unit(0,"npc"),
133				y0 = unit(0,"npc"),
134				x1 = unit(1,"npc"),
135				y1 = unit(1,"npc"),
136				gp = gpar(lwd = 2.0))),
137		t = 3, b = 3, l = 3, r = 3)
138grid.draw(g)
139
140## ----separators, fig.width=8---------------------------------------------
141g <- tableGrob(head(iris), theme = ttheme_minimal())
142separators <- replicate(ncol(g) - 2,
143                     segmentsGrob(x1 = unit(0, "npc"), gp=gpar(lty=2)),
144                     simplify=FALSE)
145## add vertical lines on the left side of columns (after 2nd)
146g <- gtable::gtable_add_grob(g, grobs = separators,
147                     t = 2, b = nrow(g), l = seq_len(ncol(g)-2)+2)
148grid.draw(g)
149
150## ----highlight-----------------------------------------------------------
151g <- tableGrob(iris[1:4, 1:3])
152find_cell <- function(table, row, col, name="core-fg"){
153  l <- table$layout
154  which(l$t==row & l$l==col & l$name==name)
155}
156
157ind <- find_cell(g, 3, 2, "core-fg")
158ind2 <- find_cell(g, 2, 3, "core-bg")
159g$grobs[ind][[1]][["gp"]] <- gpar(fontsize=15, fontface="bold")
160g$grobs[ind2][[1]][["gp"]] <- gpar(fill="darkolivegreen1", col = "darkolivegreen4", lwd=5)
161grid.draw(g)
162
163## ----ftable, fig.width=6-------------------------------------------------
164grid.ftable <- function(d, padding = unit(4, "mm"), ...) {
165
166  nc <- ncol(d)
167  nr <- nrow(d)
168
169  ## character table with added row and column names
170  extended_matrix <- cbind(c("", rownames(d)),
171                           rbind(colnames(d),
172                                 as.matrix(d)))
173
174  ## string width and height
175  w <- apply(extended_matrix, 2, strwidth, "inch")
176  h <- apply(extended_matrix, 2, strheight, "inch")
177
178  widths <- apply(w, 2, max)
179  heights <- apply(h, 1, max)
180
181  padding <- convertUnit(padding, unitTo = "in", valueOnly = TRUE)
182
183  x <- cumsum(widths + padding) - 0.5 * padding
184  y <- cumsum(heights + padding) - padding
185
186  rg <- rectGrob(x = unit(x - widths/2, "in"),
187                 y = unit(1, "npc") - unit(rep(y, each = nc + 1), "in"),
188                 width = unit(widths + padding, "in"),
189                 height = unit(heights + padding, "in"))
190
191  tg <- textGrob(c(t(extended_matrix)), x = unit(x - widths/2, "in"),
192                 y = unit(1, "npc") - unit(rep(y, each = nc + 1), "in"),
193                 just = "center")
194
195  g <- gTree(children = gList(rg, tg), ...,
196             x = x, y = y, widths = widths, heights = heights)
197
198  grid.draw(g)
199  invisible(g)
200}
201
202grid.newpage()
203grid.ftable(head(iris, 4), gp = gpar(fill = rep(c("grey90", "grey95"), each = 6)))
204
205