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