Nothing
## ----setup, echo=FALSE, results='hide'-----------------------------------
library(knitr)
opts_chunk$set(message=FALSE, fig.width=4, fig.height=2)
## ----basic---------------------------------------------------------------
library(gridExtra)
library(grid)
d <- head(iris[,1:3])
grid.table(d)
## ----annotations, fig.height=3-------------------------------------------
d[2,3] <- "this is very wwwwwide"
d[1,2] <- "this\nis\ntall"
colnames(d) <- c("alpha*integral(xdx,a,infinity)",
"this text\nis high", 'alpha/beta')
tt <- ttheme_default(colhead=list(fg_params = list(parse=TRUE)))
grid.table(d, theme=tt)
## ----theme, fig.width=8--------------------------------------------------
tt1 <- ttheme_default()
tt2 <- ttheme_minimal()
tt3 <- ttheme_minimal(
core=list(bg_params = list(fill = blues9[1:4], col=NA),
fg_params=list(fontface=3)),
colhead=list(fg_params=list(col="navyblue", fontface=4L)),
rowhead=list(fg_params=list(col="orange", fontface=3L)))
grid.arrange(
tableGrob(iris[1:4, 1:2], theme=tt1),
tableGrob(iris[1:4, 1:2], theme=tt2),
tableGrob(iris[1:4, 1:2], theme=tt3),
nrow=1)
## ----recycling-----------------------------------------------------------
t1 <- ttheme_default(core=list(
fg_params=list(fontface=c(rep("plain", 4), "bold.italic")),
bg_params = list(fill=c(rep(c("grey95", "grey90"),
length.out=4), "#6BAED6"),
alpha = rep(c(1,0.5), each=5))
))
grid.table(iris[1:5, 1:3], theme = t1)
## ----justify, fig.width=8------------------------------------------------
tt1 <- ttheme_default()
tt2 <- ttheme_default(core=list(fg_params=list(hjust=1, x=0.9)),
rowhead=list(fg_params=list(hjust=1, x=0.95)))
tt3 <- ttheme_default(core=list(fg_params=list(hjust=0, x=0.1)),
rowhead=list(fg_params=list(hjust=0, x=0)))
grid.arrange(
tableGrob(mtcars[1:4, 1:2], theme=tt1),
tableGrob(mtcars[1:4, 1:2], theme=tt2),
tableGrob(mtcars[1:4, 1:2], theme=tt3),
nrow=1)
## ----sizes, fig.width=8--------------------------------------------------
g <- g2 <- tableGrob(iris[1:4, 1:3], cols = NULL, rows=NULL)
g2$widths <- unit(rep(1/ncol(g2), ncol(g2)), "npc")
grid.arrange(rectGrob(), rectGrob(), nrow=1)
grid.arrange(g, g2, nrow=1, newpage = FALSE)
## ----align, fig.width=6, fig.height=3------------------------------------
d1 <- PlantGrowth[1:3,1, drop=FALSE]
d2 <- PlantGrowth[1:2,1:2]
g1 <- tableGrob(d1)
g2 <- tableGrob(d2)
haligned <- gtable_combine(g1,g2, along=1)
valigned <- gtable_combine(g1,g2, along=2)
grid.newpage()
grid.arrange(haligned, valigned, ncol=2)
## ----numberingDemo1------------------------------------------------------
library(gtable)
g <- tableGrob(iris[1:4, 1:3], rows = NULL)
g <- gtable_add_grob(g,
grobs = rectGrob(gp = gpar(fill = NA, lwd = 2)),
t = 2, b = nrow(g), l = 1, r = ncol(g))
g <- gtable_add_grob(g,
grobs = rectGrob(gp = gpar(fill = NA, lwd = 2)),
t = 1, l = 1, r = ncol(g))
grid.draw(g)
## ----numberingDemo2------------------------------------------------------
g <- tableGrob(iris[1:4, 1:3])
g <- gtable_add_grob(g,
grobs = rectGrob(gp = gpar(fill = NA, lwd = 2)),
t = 2, b = nrow(g), l = 1, r = ncol(g))
g <- gtable_add_grob(g,
grobs = rectGrob(gp = gpar(fill = NA, lwd = 2)),
t = 1, l = 1, r = ncol(g))
grid.draw(g)
## ----segments1-----------------------------------------------------------
g <- tableGrob(iris[1:4, 1:3])
g <- gtable_add_grob(g,
grobs = segmentsGrob( # line across the bottom
x0 = unit(0,"npc"),
y0 = unit(0,"npc"),
x1 = unit(1,"npc"),
y1 = unit(0,"npc"),
gp = gpar(lwd = 2.0)),
t = 3, b = 3, l = 3, r = 3)
grid.draw(g)
## ----segments2-----------------------------------------------------------
g <- tableGrob(iris[1:4, 1:3])
g <- gtable_add_grob(g,
grobs = segmentsGrob( # line across the bottom
x0 = unit(0,"npc"),
y0 = unit(0,"npc"),
x1 = unit(0,"npc"),
y1 = unit(1,"npc"),
gp = gpar(lwd = 2.0)),
t = 3, b = 3, l = 3, r = 3)
grid.draw(g)
## ----segments3-----------------------------------------------------------
g <- tableGrob(iris[1:4, 1:3])
g <- gtable_add_grob(g,
grobs = grobTree(
segmentsGrob( # diagonal line ul -> lr
x0 = unit(0,"npc"),
y0 = unit(1,"npc"),
x1 = unit(1,"npc"),
y1 = unit(0,"npc"),
gp = gpar(lwd = 2.0)),
segmentsGrob( # diagonal line ll -> ur
x0 = unit(0,"npc"),
y0 = unit(0,"npc"),
x1 = unit(1,"npc"),
y1 = unit(1,"npc"),
gp = gpar(lwd = 2.0))),
t = 3, b = 3, l = 3, r = 3)
grid.draw(g)
## ----separators, fig.width=8---------------------------------------------
g <- tableGrob(head(iris), theme = ttheme_minimal())
separators <- replicate(ncol(g) - 2,
segmentsGrob(x1 = unit(0, "npc"), gp=gpar(lty=2)),
simplify=FALSE)
## add vertical lines on the left side of columns (after 2nd)
g <- gtable::gtable_add_grob(g, grobs = separators,
t = 2, b = nrow(g), l = seq_len(ncol(g)-2)+2)
grid.draw(g)
## ----highlight-----------------------------------------------------------
g <- tableGrob(iris[1:4, 1:3])
find_cell <- function(table, row, col, name="core-fg"){
l <- table$layout
which(l$t==row & l$l==col & l$name==name)
}
ind <- find_cell(g, 3, 2, "core-fg")
ind2 <- find_cell(g, 2, 3, "core-bg")
g$grobs[ind][[1]][["gp"]] <- gpar(fontsize=15, fontface="bold")
g$grobs[ind2][[1]][["gp"]] <- gpar(fill="darkolivegreen1", col = "darkolivegreen4", lwd=5)
grid.draw(g)
## ----ftable, fig.width=6-------------------------------------------------
grid.ftable <- function(d, padding = unit(4, "mm"), ...) {
nc <- ncol(d)
nr <- nrow(d)
## character table with added row and column names
extended_matrix <- cbind(c("", rownames(d)),
rbind(colnames(d),
as.matrix(d)))
## string width and height
w <- apply(extended_matrix, 2, strwidth, "inch")
h <- apply(extended_matrix, 2, strheight, "inch")
widths <- apply(w, 2, max)
heights <- apply(h, 1, max)
padding <- convertUnit(padding, unitTo = "in", valueOnly = TRUE)
x <- cumsum(widths + padding) - 0.5 * padding
y <- cumsum(heights + padding) - padding
rg <- rectGrob(x = unit(x - widths/2, "in"),
y = unit(1, "npc") - unit(rep(y, each = nc + 1), "in"),
width = unit(widths + padding, "in"),
height = unit(heights + padding, "in"))
tg <- textGrob(c(t(extended_matrix)), x = unit(x - widths/2, "in"),
y = unit(1, "npc") - unit(rep(y, each = nc + 1), "in"),
just = "center")
g <- gTree(children = gList(rg, tg), ...,
x = x, y = y, widths = widths, heights = heights)
grid.draw(g)
invisible(g)
}
grid.newpage()
grid.ftable(head(iris, 4), gp = gpar(fill = rep(c("grey90", "grey95"), each = 6)))
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.