options(htmlTable.pretty_indentation = TRUE)
mx <- paste("value ", 1:6) %>%
matrix(ncol = 3)
colnames(mx) <- c("A", "B", "C") %>%
paste("header", .)
rownames(mx) <- letters[1:2]
## col.rgroup does not break css.group
setHtmlTableTheme(theme = "Google")
mx %>%
addHtmlTableStyle(css.rgroup = "font-weight:900; background-color:#f2f2f2;",
align = "|l|r|c|r|",
spacer.celltype = "skip") %>%
htmlTable(n.rgroup = c(2),
rgroup = c("Nice!"),
n.cgroup = list(c(1, 2),
c(2,1)),
cgroup = list(c("1:1", "1:2-3"),
c("2:1-2", "2:3")))
mx %>%
addHtmlTableStyle(css.cgroup = "font-weight:900; background-color:#f2f2f2; vertical-align:middle;",
align = "|l|r|c|r|",
spacer.celltype = "single_empty") %>%
htmlTable(n.rgroup = c(2),
rgroup = c("Nice!"),
n.cgroup = list(c(1, 2),
c(2,1)),
cgroup = list(c("1:1", "1:2-3"),
c("2:1-2", "2:3")))
mx %>%
addHtmlTableStyle(align = "|l|r|c|r|",
align.header = "|c|c|c|",
spacer.celltype = "double") %>%
htmlTable(n.rgroup = c(2),
rgroup = c("Nice!"),
n.cgroup = list(c(1, 2),
c(2,1)),
cgroup = list(c("1:1", "1:2-3"),
c("2:1-2", "2:3")))
mx %>%
set_colnames(c("A<br />first", "B", "C") %>%
paste("header", .)) %>%
addHtmlTableStyle(align = "|l|r|c|r|",
spacer.celltype = "double") %>%
htmlTable(n.rgroup = c(2),
rgroup = c("Vertical alignment in header check"),
n.cgroup = list(c(1, 2),
c(2,1)),
cgroup = list(c("1:1<br />vertical check", "1:2-3"),
c("2:1-2", "2:3")))
colnames(mx) <- NULL
htmlTable(mx)
htmlTable(mx[1,,drop = FALSE])
htmlTable(mx, n.rgroup = 2, rgroup = "A")
htmlTable(mx, tspanner = "AA", n.tspanner = 2,
n.rgroup = 2, rgroup = "A")
htmlTable(mx, tspanner = "AA", n.tspanner = 2,
padding.tspanner = " ",
n.rgroup = 2, rgroup = "A")
htmlTable(mx, tspanner = "AA", n.tspanner = 2)
htmlTable(mx, n.rgroup = 2, rgroup = "A", padding.rgroup = "")
# This will cause the table to look strange
# but forcing >/< is a bigger constraint
# that may be undesirable for more advanced users.
mx[1,1] <- "< = <"
mx[1,2] <- "2<sup>2</sup>"
mx[1,3] <- "<span style=\"font-weight: 900\">3</span>"
mx[2,1] <- "<td>"
htmlTable(mx)
mx <- matrix(1:9, ncol = 3)
colnames(mx) <- LETTERS[1:3]
rownames(mx) <- letters[1:3]
mx_3_times <- rbind(mx,
mx,
mx)
htmlTable(mx_3_times,
css.tspanner.sep = "border-top: 2px solid red;",
rgroup = rep(c("Group a", "Group b and c"), times = 3),
n.rgroup = rep(c(1,2), times = 3),
tspanner = c("First", "Second", "Third"),
n.tspanner = rep(nrow(mx), times = 3),
rowlabel = '',
col.rgroup = c('white','lightblue1'),
tfoot = "Some footer text",
caption = "Caption text")
htmlTable(mx_3_times,
css.tspanner.sep = c("border-top: 2px solid red;",
"border-top: 2px solid blue;"),
rgroup = rep(c("Group a", "Group b and c"), times = 3),
n.rgroup = rep(c(1,2), times = 3),
tspanner = c("First", "Second", "Third"),
n.tspanner = rep(nrow(mx), times = 3),
rowlabel = '',
col.rgroup = c('white','lightblue1'),
tfoot = "Some footer text",
caption = "Caption text")
htmlTable(mx_3_times,
css.tspanner.sep = c("border-top: 2px solid red;",
"border-top: 2px solid blue;"),
rgroup = rep(c("Group a", "Group b and c"), times = 3),
n.rgroup = rep(c(1,2), times = 3),
tspanner = c("First", "Second", "Third"),
n.tspanner = rep(nrow(mx), times = 3),
rowlabel = '',
col.rgroup = c('white','lightblue1'),
col.columns = c('none','#CCCCCC'),
tfoot = "Some footer text",
caption = "Caption text")
htmlTable(mx_3_times,
css.tspanner.sep = c("border-top: 2px solid red;",
"border-top: 12px solid blue;"),
rgroup = rep(c("Group a", "Group b and c"), times = 3),
n.rgroup = rep(c(1,2), times = 3),
tspanner = c("First", "Second", "Third"),
n.tspanner = rep(nrow(mx), times = 3),
rowlabel = '',
tfoot = "Some footer text",
caption = "Caption text")
htmlTable(mx_3_times,
css.tspanner = "color: purple; font-weight: bold;",
css.tspanner.sep = "border-top: 2px solid red;",
rgroup = rep(c("Group a", "Group b and c"), times = 3),
n.rgroup = rep(c(1,2), times = 3),
tspanner = c("First", "Second", "Third"),
n.tspanner = rep(nrow(mx), times = 3),
rowlabel = '',
tfoot = "Some footer text",
caption = "Caption text")
htmlTable(mx_3_times,
padding.tspanner = "+",
padding.rgroup = "-",
css.tspanner = "color: purple; font-weight: bold;",
css.tspanner.sep = "border-top: 2px solid red;",
rgroup = rep(c("Group a", "Group b and c"), times = 3),
n.rgroup = rep(c(1,2), times = 3),
tspanner = c("First", "Second", "Third"),
n.tspanner = rep(nrow(mx), times = 3),
rowlabel = '',
tfoot = "† Some footnote
‡ Another footnote",
caption = "Caption text")
rbind(
`Group A` = c(20, 380),
`Group B` = c(110, 1230),
`Group C` = c(2, 56),
`Group D` = c(17, 33),
`Group A` = c(40, 360),
`Group B` = c(230, 1100),
`Group C` = c(8, 50),
`Group D` = c(10, 40)
) %>%
apply(1, function(x) {
sapply(x, function(count) c(
txtInt(count),
sprintf("(%s)", txtRound(count/sum(x) * 100, 1)))) %>%
c(txtInt(sum(x)), .)
}) %>%
t %>%
htmlTable(header = c("Total", rep(c("No", "(%)"), times = 2)),
n.cgroup = list(c(1, 2, 2)),
cgroup = list(c("", "Cases", "Controls")),
rgroup = rep(c("Aspirin", "Intermittent compression"), times = 2),
n.rgroup = rep(2, times = 4),
tspanner = c("First experiment", "Second experiment"),
n.tspanner = c(2),
align = "r",
caption = "Extremely fake data")
library(tidyverse)
mtcars %>%
as_tibble(rownames = "rnames") %>%
pivot_longer(names_to = "per_metric",
cols = c(hp, mpg, qsec)) %>%
group_by(cyl, gear, per_metric) %>%
summarise(Mean = round(mean(value), 1),
SD = round(sd(value), 1),
Min = round(min(value), 1),
Max = round(max(value), 1),
.groups = 'drop') %>%
pivot_longer(names_to = "summary_stat",
cols = c(Mean, SD, Min, Max)) %>%
ungroup() %>%
mutate(gear = paste(gear, "Gears"),
cyl = paste(cyl, "Cylinders")) %>%
arrange(per_metric, summary_stat) %>%
addHtmlTableStyle(align = "r") %>%
tidyHtmlTable(header = gear,
cgroup = cyl,
rnames = summary_stat,
rgroup = per_metric,
skip_removal_warning = TRUE,
caption = "A full example of how to apply the tidyverse workflow to generate a table")
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.