Tip

本章节的内容非常多！

19.1 PKG

Show/Hide Code 
library(tidyverse) # 数据处理和可视化
library(gt) # 表格
library(gtsummary) # 表格
library(gtExtras) # gt 扩展
library(htmltools) # HTML 工具
# install.packages('cardx') 
library(survival) # 生存分析
library(knitr) # 表格
library(kableExtra) # kable 拓展
library(DT) # 交互式表格
library(reactable) # 交互式表格
library(formattable) # 交互式表格
library(flextable) # Word/PPT 表格
library(rhandsontable) # 交互式编辑表格
library(modelsummary) # 模型摘要表格
library(huxtable) # LaTeX 表格

因为有的交互式表格，Quarto 无法正确加载，所有包装了函数，也放在了 wordcloud文件夹内:

Show/Hide Code 
# 因为有的交互式表格，无法正确加载，所有包装了函数，也放在了 wordcloud文件夹内
# 用法是embed_widget()包装一下，记得区块要写label

embed_widget <- function(widget, height = "400px", width = "100%") {
  # 步骤 1: 生成一个基于当前代码块标签的、独一无二的文件名
  # 这样可以防止多个小部件相互覆盖文件
  chunk_label <- opts_current$get('label')
  filename <- paste0("./wordcloud/wc-", chunk_label, ".html")
  
  # 步骤 2: 将小部件保存为一个独立的、自包含的HTML文件
  library(htmlwidgets)
  saveWidget(widget, filename, selfcontained = TRUE)
  
  # 步骤 3: 创建并返回一个指向该文件的 iframe HTML 标签
  tags$iframe(
    src = filename,
    height = height,
    width = width,
    style = "border:none;"
  )
}

R 的表格包有很多, 主要分为以下几类:

Table Package

19.2 gt family

包括 gt、gtsummary 和 gtExtras.

19.2.1 gt

gt (官方文档) 是兼容 tidyverse 的表格包:

19.2.1.1 基本

Show/Hide Code 
# 创建一个简单的数据框
data = data.frame(
  Country = c("USA", "China", "India", "Brazil"), # 国家名称
  Capitals = c("Washington D.C.", "Beijing", "New Delhi", "Brasília"), # 首都
  Population = c(331, 1441, 1393, 212), # 人口（百万）
  GDP = c(21.43, 14.34, 2.87, 1.49) # GDP（万亿美元）
)

gt(data)
Country Capitals Population GDP
USA Washington D.C. 331 21.43
China Beijing 1441 14.34
India New Delhi 1393 2.87
Brazil Brasília 212 1.49

使用 gt 包创建表格

19.2.1.2 标题

使用tab_header()函数可以添加标题和副标题(兼容markdown / html语法):

Show/Hide Code 
data |>
  gt() |>
  tab_header(
    title = html("<span style='color:red;'>A red title</span>"), # 使用 html 语法
    subtitle = md("Pretty *cool subtitle* too, `isn't it?`") # 使用 markdown 语法
  )
A red title
Pretty cool subtitle too, isn't it?
Country Capitals Population GDP
USA Washington D.C. 331 21.43
China Beijing 1441 14.34
India New Delhi 1393 2.87
Brazil Brasília 212 1.49

使用 gt 包创建表格并添加标题和副标题(markdown 语法)

甚至还可以用图像作为标题:

Show/Hide Code 
data |>
  gt() |>
  tab_header(
    title = md("**A table with an image as title**"),
    subtitle = html(
      "<div style='text-align:center;'><img src='./image/Rlogo.png' height='60'></div>"
    )
  )
A table with an image as title
Country Capitals Population GDP
USA Washington D.C. 331 21.43
China Beijing 1441 14.34
India New Delhi 1393 2.87
Brazil Brasília 212 1.49

使用 gt 包创建表格并添加图像作为标题

19.2.1.3 跨列标题

tab_spanner() 函数可以创建跨列的标题(合并单元格):

Show/Hide Code 
data |>
  gt() |>
   tab_spanner(
    label = "Number",
    columns = c(GDP, Population)) |>
  tab_spanner(
    label = "Label",
    columns = c(Country, Capitals)
  )
Label
Number
Country Capitals GDP Population
USA Washington D.C. 21.43 331
China Beijing 14.34 1441
India New Delhi 2.87 1393
Brazil Brasília 1.49 212

使用 gt 包创建表格并添加跨列标题

19.2.1.4 脚注

tab_footnote() 函数的 footnote 和 locations 参数添加引用:

Show/Hide Code 
# 创建一个包含行星信息的数据框
data = data.frame(
    Planet = c("Earth", "Mars", "Jupiter", "Venus"), # 行星名称
    Moons = c(1, 2, 79, 0), # 卫星数量
    Distance_from_Sun = c(149.6, 227.9, 778.3, 108.2), # 距离太阳距离（百万公里）
    Diameter = c(12742, 6779, 139822, 12104) # 直径（公里）
)

data |>
  gt() |>
  tab_footnote(
    footnote = md("Measured in **millions** of Km"),
    locations = cells_column_labels(columns = Distance_from_Sun)
  )
Planet Moons Distance_from_Sun1 Diameter
Earth 1 149.6 12742
Mars 2 227.9 6779
Jupiter 79 778.3 139822
Venus 0 108.2 12104
1 Measured in millions of Km

使用 gt 包为表格添加脚注

还可以添加多个角注:

Show/Hide Code 
# 使用 gt 包创建表格，并为不同的列和表格整体添加多个脚注
data |>
    gt() |>
    tab_footnote(
        footnote = md("Measured in **millions** of Km"), # 为 Distance_from_Sun 列添加脚注
        locations = cells_column_labels(columns = Distance_from_Sun)
    ) |>
    tab_footnote(
        footnote = md("Measured in **Km**"), # 为 Diameter 列添加脚注
        locations = cells_column_labels(columns = Diameter)
    ) |>
    tab_footnote(
        footnote = md("The original data are from *Some Organization*") # 为整个表格添加脚注
    ) |>
    opt_footnote_marks(marks = "LETTERS") # 设置脚注标记为大写字母
Planet Moons Distance_from_SunA DiameterB
Earth 1 149.6 12742
Mars 2 227.9 6779
Jupiter 79 778.3 139822
Venus 0 108.2 12104
The original data are from Some Organization
A Measured in millions of Km
B Measured in Km

使用 gt 包为表格添加多个脚注

19.2.2 gtsummary

gtsummary 是 gt 的一个扩展包, 主要用于创建统计摘要表格.

它连接了数据分析与表格创建之间的桥梁，允许用户直接从分析输出中无缝生成摘要表格, 特别适合医学和社会科学领域的研究报告。

19.2.2.1 回归模型摘要

tbl_regression() 函数可以创建回归模型的摘要表格:

Show/Hide Code 
# 示例数据
data("Titanic")
df = as.data.frame(Titanic)

# 建立logistics回归模型
model = glm(Survived ~ Age + Class + Sex + Freq, family = binomial, data = df)

# 使用 gtsummary 包创建表格
model |>
  tbl_regression()
Characteristic log(OR) 95% CI p-value
Age


    Child — —
    Adult 0.62 -1.0, 2.4 0.5
Class


    1st — —
    2nd -0.03 -2.0, 2.0 >0.9
    3rd 0.25 -1.8, 2.4 0.8
    Crew 0.27 -1.8, 2.4 0.8
Sex


    Male — —
    Female -0.37 -1.9, 1.1 0.6
Freq -0.01 -0.02, 0.00 0.3
Abbreviations: CI = Confidence Interval, OR = Odds Ratio

使用 tbl_regression() 创建回归模型摘要表格

增加更多统计量:

Show/Hide Code 
model |>
  tbl_regression(intercept = TRUE, conf.level = 0.9) |> # 增加截距和置信区间
  add_glance_source_note() |> # 添加模型摘要信息
  add_global_p()
Characteristic log(OR) 90% CI p-value
(Intercept) 0.10 -1.4, 1.6 >0.9
Age

0.5
    Child — —
    Adult 0.62 -0.78, 2.1
Class

>0.9
    1st — —
    2nd -0.03 -1.7, 1.7
    3rd 0.25 -1.5, 2.0
    Crew 0.27 -1.5, 2.0
Sex

0.6
    Male — —
    Female -0.37 -1.7, 0.89
Freq -0.01 -0.02, 0.00 0.2
Abbreviations: CI = Confidence Interval, OR = Odds Ratio
Null deviance = 44.4; Null df = 31; Log-likelihood = -21.3; AIC = 56.5; BIC = 66.8; Deviance = 42.5; Residual df = 25; No. Obs. = 32

使用 tbl_regression() 创建回归模型摘要表格并增加统计量

19.2.2.2 多模型合并

Show/Hide Code 
data(trial)

model_reglog <- glm(response ~ trt + grade, data = trial, family = binomial) |>
  tbl_regression()

model_cox  <- coxph(Surv(ttdeath, death) ~ trt + grade, data = trial) |>
  tbl_regression()

tbl_merge(
  list(model_reglog, model_cox),
  tab_spanner = c("**Tumor Response**", "**Time to Death**")
)
Characteristic
Tumor Response
Time to Death
log(OR) 95% CI p-value log(HR) 95% CI p-value
Chemotherapy Treatment





    Drug A — —
— —
    Drug B 0.19 -0.41, 0.81 0.5 0.22 -0.15, 0.59 0.2
Grade





    I — —
— —
    II -0.06 -0.82, 0.68 0.9 0.25 -0.22, 0.72 0.3
    III 0.08 -0.66, 0.82 0.8 0.52 0.07, 0.98 0.024
Abbreviations: CI = Confidence Interval, HR = Hazard Ratio, OR = Odds Ratio

使用 tbl_merge() 合并多个模型的回归结果表格

19.2.3 gtExtras

gtExtras 增强并扩展了 gt 包的功能。可以创建更复杂和美观的表格。

19.2.3.1 汇总原始数据

结合 grouped by, 制作 “每个单元格有很多数据” 的表格

Show/Hide Code 
data(iris)

# 创建一个包含鸢尾花数据的数据框
agg_iris = iris |>
  group_by(Species) |>
  summarize(
    Sepal.L = list(Sepal.Length),
    Sepal.W = list(Sepal.Width),
    Petal.L = list(Petal.Length),
    Petal.W = list(Petal.Width)
  )

# 使用 gtExtras 包创建表格
agg_iris |>
  gt()
Species Sepal.L Sepal.W Petal.L Petal.W
setosa 5.1, 4.9, 4.7, 4.6, 5.0, 5.4, 4.6, 5.0, 4.4, 4.9, 5.4, 4.8, 4.8, 4.3, 5.8, 5.7, 5.4, 5.1, 5.7, 5.1, 5.4, 5.1, 4.6, 5.1, 4.8, 5.0, 5.0, 5.2, 5.2, 4.7, 4.8, 5.4, 5.2, 5.5, 4.9, 5.0, 5.5, 4.9, 4.4, 5.1, 5.0, 4.5, 4.4, 5.0, 5.1, 4.8, 5.1, 4.6, 5.3, 5.0 3.5, 3.0, 3.2, 3.1, 3.6, 3.9, 3.4, 3.4, 2.9, 3.1, 3.7, 3.4, 3.0, 3.0, 4.0, 4.4, 3.9, 3.5, 3.8, 3.8, 3.4, 3.7, 3.6, 3.3, 3.4, 3.0, 3.4, 3.5, 3.4, 3.2, 3.1, 3.4, 4.1, 4.2, 3.1, 3.2, 3.5, 3.6, 3.0, 3.4, 3.5, 2.3, 3.2, 3.5, 3.8, 3.0, 3.8, 3.2, 3.7, 3.3 1.4, 1.4, 1.3, 1.5, 1.4, 1.7, 1.4, 1.5, 1.4, 1.5, 1.5, 1.6, 1.4, 1.1, 1.2, 1.5, 1.3, 1.4, 1.7, 1.5, 1.7, 1.5, 1.0, 1.7, 1.9, 1.6, 1.6, 1.5, 1.4, 1.6, 1.6, 1.5, 1.5, 1.4, 1.5, 1.2, 1.3, 1.4, 1.3, 1.5, 1.3, 1.3, 1.3, 1.6, 1.9, 1.4, 1.6, 1.4, 1.5, 1.4 0.2, 0.2, 0.2, 0.2, 0.2, 0.4, 0.3, 0.2, 0.2, 0.1, 0.2, 0.2, 0.1, 0.1, 0.2, 0.4, 0.4, 0.3, 0.3, 0.3, 0.2, 0.4, 0.2, 0.5, 0.2, 0.2, 0.4, 0.2, 0.2, 0.2, 0.2, 0.4, 0.1, 0.2, 0.2, 0.2, 0.2, 0.1, 0.2, 0.2, 0.3, 0.3, 0.2, 0.6, 0.4, 0.3, 0.2, 0.2, 0.2, 0.2
versicolor 7.0, 6.4, 6.9, 5.5, 6.5, 5.7, 6.3, 4.9, 6.6, 5.2, 5.0, 5.9, 6.0, 6.1, 5.6, 6.7, 5.6, 5.8, 6.2, 5.6, 5.9, 6.1, 6.3, 6.1, 6.4, 6.6, 6.8, 6.7, 6.0, 5.7, 5.5, 5.5, 5.8, 6.0, 5.4, 6.0, 6.7, 6.3, 5.6, 5.5, 5.5, 6.1, 5.8, 5.0, 5.6, 5.7, 5.7, 6.2, 5.1, 5.7 3.2, 3.2, 3.1, 2.3, 2.8, 2.8, 3.3, 2.4, 2.9, 2.7, 2.0, 3.0, 2.2, 2.9, 2.9, 3.1, 3.0, 2.7, 2.2, 2.5, 3.2, 2.8, 2.5, 2.8, 2.9, 3.0, 2.8, 3.0, 2.9, 2.6, 2.4, 2.4, 2.7, 2.7, 3.0, 3.4, 3.1, 2.3, 3.0, 2.5, 2.6, 3.0, 2.6, 2.3, 2.7, 3.0, 2.9, 2.9, 2.5, 2.8 4.7, 4.5, 4.9, 4.0, 4.6, 4.5, 4.7, 3.3, 4.6, 3.9, 3.5, 4.2, 4.0, 4.7, 3.6, 4.4, 4.5, 4.1, 4.5, 3.9, 4.8, 4.0, 4.9, 4.7, 4.3, 4.4, 4.8, 5.0, 4.5, 3.5, 3.8, 3.7, 3.9, 5.1, 4.5, 4.5, 4.7, 4.4, 4.1, 4.0, 4.4, 4.6, 4.0, 3.3, 4.2, 4.2, 4.2, 4.3, 3.0, 4.1 1.4, 1.5, 1.5, 1.3, 1.5, 1.3, 1.6, 1.0, 1.3, 1.4, 1.0, 1.5, 1.0, 1.4, 1.3, 1.4, 1.5, 1.0, 1.5, 1.1, 1.8, 1.3, 1.5, 1.2, 1.3, 1.4, 1.4, 1.7, 1.5, 1.0, 1.1, 1.0, 1.2, 1.6, 1.5, 1.6, 1.5, 1.3, 1.3, 1.3, 1.2, 1.4, 1.2, 1.0, 1.3, 1.2, 1.3, 1.3, 1.1, 1.3
virginica 6.3, 5.8, 7.1, 6.3, 6.5, 7.6, 4.9, 7.3, 6.7, 7.2, 6.5, 6.4, 6.8, 5.7, 5.8, 6.4, 6.5, 7.7, 7.7, 6.0, 6.9, 5.6, 7.7, 6.3, 6.7, 7.2, 6.2, 6.1, 6.4, 7.2, 7.4, 7.9, 6.4, 6.3, 6.1, 7.7, 6.3, 6.4, 6.0, 6.9, 6.7, 6.9, 5.8, 6.8, 6.7, 6.7, 6.3, 6.5, 6.2, 5.9 3.3, 2.7, 3.0, 2.9, 3.0, 3.0, 2.5, 2.9, 2.5, 3.6, 3.2, 2.7, 3.0, 2.5, 2.8, 3.2, 3.0, 3.8, 2.6, 2.2, 3.2, 2.8, 2.8, 2.7, 3.3, 3.2, 2.8, 3.0, 2.8, 3.0, 2.8, 3.8, 2.8, 2.8, 2.6, 3.0, 3.4, 3.1, 3.0, 3.1, 3.1, 3.1, 2.7, 3.2, 3.3, 3.0, 2.5, 3.0, 3.4, 3.0 6.0, 5.1, 5.9, 5.6, 5.8, 6.6, 4.5, 6.3, 5.8, 6.1, 5.1, 5.3, 5.5, 5.0, 5.1, 5.3, 5.5, 6.7, 6.9, 5.0, 5.7, 4.9, 6.7, 4.9, 5.7, 6.0, 4.8, 4.9, 5.6, 5.8, 6.1, 6.4, 5.6, 5.1, 5.6, 6.1, 5.6, 5.5, 4.8, 5.4, 5.6, 5.1, 5.1, 5.9, 5.7, 5.2, 5.0, 5.2, 5.4, 5.1 2.5, 1.9, 2.1, 1.8, 2.2, 2.1, 1.7, 1.8, 1.8, 2.5, 2.0, 1.9, 2.1, 2.0, 2.4, 2.3, 1.8, 2.2, 2.3, 1.5, 2.3, 2.0, 2.0, 1.8, 2.1, 1.8, 1.8, 1.8, 2.1, 1.6, 1.9, 2.0, 2.2, 1.5, 1.4, 2.3, 2.4, 1.8, 1.8, 2.1, 2.4, 2.3, 1.9, 2.3, 2.5, 2.3, 1.9, 2.0, 2.3, 1.8

结合 grouped by, 制作“每个单元格有很多数据”的表格

19.2.3.2 折线图

gt_plt_sparkline() 在表格单元格中创建折线图。

使用刚才的 agg_iris 汇总数据框:

Show/Hide Code 
agg_iris |>
  gt() |>
  gt_plt_sparkline(Sepal.L) |> # 在 Sepal.L 列中添加折线图
  gt_plt_sparkline(Sepal.W) |> # 在 Sepal.W 列中添加折线图
  gt_plt_sparkline(Petal.L) |> # 在 Petal.L 列中添加折线图
  gt_plt_sparkline(Petal.W)    # 在 Petal.W 列中添加折线图
Species Sepal.L Sepal.W Petal.L Petal.W
setosa 5.0 3.3 1.4 0.20
versicolor 5.7 2.8 4.1 1.3
virginica 5.9 3.0 5.1 1.8

使用 gt_plt_sparkline() 创建折线图

19.2.3.3 分布图

gt_plt_dist() 在表格单元中创建分布图。图表类型取决于 type 参数:

还是使用 agg_iris 汇总数据框:

Show/Hide Code 
agg_iris |>
  gt() |>
  gt_plt_dist(
    Sepal.L,
    type = "density" # 密度图
  ) |>
  gt_plt_dist(
    Sepal.W,
    type = "boxplot" # 箱线图
  ) |>
  gt_plt_dist(
    Petal.L,
    type = "histogram" # 直方图
  ) |>
  gt_plt_dist(
    Petal.W,
    type = "rug_strip" # 裸条图
  )
Species Sepal.L Sepal.W Petal.L Petal.W
setosa
versicolor
virginica

使用 gt_plt_dist() 创建分布图

19.2.3.4 条形图

gt_plt_bar_pct() 不需要汇总数据。这个图表实际上是一个得分条形图, 最大值是 100%

Show/Hide Code 
p <- head(iris) |>
  gt() |>
  gt_plt_bar_pct(
    Sepal.Length,
    labels = TRUE, # 显示百分比标签
    # scaled = FALSE # “我提供的是原始数值，它们还没有被处理成百分比，你需要自己动手去计算和缩放。”
    # scaled = TRUE # “你不需要做任何计算了。我提供给你的数值已经是最终百分比了，请直接使用。”

  ) |>
  gt_plt_bar_pct(
    Sepal.Width,
    labels=FALSE,
    fill = "forestgreen"
  )
p
Sepal.Length Sepal.Width Petal.Length Petal.Width Species
94.4%
1.4 0.2 setosa
90.7%
1.4 0.2 setosa
87%
1.3 0.2 setosa
85.2%
1.5 0.2 setosa
92.6%
1.4 0.2 setosa
100%
1.7 0.4 setosa

使用 gt_plt_bar_pct() 创建得分条形图

19.2.3.5 摘要图表

gt_plt_summary() 制作摘要图表,甚至还能交互查看,非常方便和美观

注意需要先指定列类型

Show/Hide Code 
iris |>
  gt_plt_summary()
iris
150 rows x 5 cols
Column Plot Overview Missing Mean Median SD
Sepal.Length 4.3 auto7.9 auto 0.0% 5.8 5.8 0.8
Sepal.Width 2.0 auto4.4 auto 0.0% 3.1 3.0 0.4
Petal.Length 1.0 auto6.9 auto 0.0% 3.8 4.3 1.8
Petal.Width 100 mauto2 auto 0.0% 1.2 1.3 0.8
Species setosa, versicolor and virginica
3 categories 0.0% — — —

使用 gt_plt_summary() 制作摘要图表

19.2.3.6 主题

Excel 主题:

Show/Hide Code 
head(mtcars) |>
  gt() |>
  gt_theme_excel()
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

gt_theme_excel() Excel 主题

538(FiveThirtyEight) 主题:

Show/Hide Code 
head(mtcars) |>
  gt() |>
  gt_theme_538()
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

gt_theme_538() 538(FiveThirtyEight) 主题

ESPN 主题:

Show/Hide Code 
head(mtcars) |>
  gt() |>
  gt_theme_espn()
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

gt_theme_espn() ESPN 主题

NY Times 主题:

Show/Hide Code 
head(mtcars) |>
  gt() |>
  gt_theme_nytimes()
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

gt_theme_nytimes() NY Times 主题

点阵 (dot matrix) 主题:

Show/Hide Code 
head(mtcars) |>
  gt() |>
  gt_theme_dot_matrix()
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

gt_theme_dot_matrix() 点阵 (dot matrix) 主题

黑暗主题:

Show/Hide Code 
head(mtcars) |>
  gt() |>
  gt_theme_dark()
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

gt_theme_dark() 黑暗主题

PFF 主题:

Show/Hide Code 
head(mtcars) |>
  gt() |>
  gt_theme_pff()
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

卫报 Guardian 主题:

Show/Hide Code 
head(mtcars) |>
  gt() |>
  gt_theme_guardian()
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

gt_theme_guardian() 卫报 Guardian 主题

19.3 kable family

kable() 和 kableExtra() 用于 Quarto / R Markdown 文档

19.3.1 kable()

# `kable()` 用法演示
kable(
  x, # 数据框或矩阵
  format = c("pandoc", "latex", "HTML"), # 输出格式
  digits = getOption("digits"), # 小数点位数
  row.names = FALSE, # 是否显示行名
  col.names = TRUE, # 是否显示列名
  align = c("auto", "left", "center", "right"), # 对齐方式
  caption = NULL, # 表格标题
)
Show/Hide Code 
# 创建一个简单的数据框
df = data.frame(
  Temp = c(1, 2, 3, 4),
  Rain = c(12, 42, 17, 9),
  Hum = c(21, 24, 71, 90)
)
df |>
  kable() # 创建一个简单的表格
Temp Rain Hum
1 12 21
2 42 24
3 17 71
4 9 90

使用 kable() 创建表格

19.3.2 kableExtra()

19.3.2.1 基本

kableExtra 依赖于 kable 包，并允许使用 |> （管道）符号。主要功能名为 kbl() ，与 kable() 类似。

Show/Hide Code 
df |>
  kbl() |>
  kable_styling()
Temp Rain Hum
1 12 21
2 42 24
3 17 71
4 9 90

使用 kableExtra::kbl() 创建表格

19.3.2.2 颜色

更改行或列的颜色：

Show/Hide Code 
df |>
  kbl(align = "c") |> # 居中对齐所有列
  kable_styling(full_width = FALSE) |> # 表格宽度不自动拉伸
  column_spec(2, color = "red") |> # 第二列字体颜色设为红色
  column_spec(1, background = "green") |> # 第一列背景色设为绿色
  row_spec(3, color = "blue") |> # 第三行字体颜色设为蓝色
  row_spec(4, background = "yellow") # 第四行背景色设为黄色
Temp Rain Hum
1 12 21
2 42 24
3 17 71
4 9 90

使用 kableExtra 更改行列颜色和样式

color 和 background 参数也可以接受颜色向量：

Show/Hide Code 
df |>
  kbl(align = "c") |> # 所有列居中对齐
  kable_styling(full_width = FALSE) |> # 表格宽度不自动拉伸
  # 为第三列设置不同的背景色，每一行对应一个颜色
  column_spec(3, background = c("blue", "red", "black", "blue"))
Temp Rain Hum
1 12 21
2 42 24
3 17 71
4 9 90

使用 kableExtra 为列设置颜色向量（每行不同颜色）

渐变颜色：

Show/Hide Code 
# 生成渐变色函数，从 darkred 到 magenta
colfunc <- colorRampPalette(c("darkred", "magenta"))
n_color <- nrow(df) # 获取数据框的行数
colors <- colfunc(n_color) # 生成与数据行数相同的颜色向量

# 按照 Rain 列降序排列数据框
df <- df |> arrange(desc(Rain))

df |>
  kbl(align = "c") |> # 所有列居中对齐
  kable_styling(full_width = FALSE) |> # 表格宽度不自动拉伸
  column_spec(3, background = colors) |> # 第三列设置为渐变背景色
  column_spec(2, color = colors) # 第二列字体颜色设置为渐变色
Temp Rain Hum
2 42 24
3 17 71
1 12 21
4 9 90

使用 kableExtra 为列设置渐变色和字体颜色（每行不同颜色）

19.3.2.3 图片

Show/Hide Code 
# 创建一个包含姓名、领域和图片列的数据框
df = data.frame(
  name = c("E. Charpentier", "R. Penrose", "L. Glück", "M. Houghton"), # 姓名
  field = c("Chemistry", "Physics", "Litterature", "Medicine"),        # 领域
  image = ""                                                           # 图片列（占位）
)

# 生成图片路径向量，每行对应一张图片
path_images = rep("./image/pikachu.png", nrow(df))

# 使用 kableExtra 创建表格并插入图片
df |>
  kbl(booktabs = TRUE, align = "c") |>                # 创建表格，booktabs 风格，所有列居中
  kable_styling() |>                                  # 应用默认表格美化样式
  kable_paper(full_width = TRUE) |>                   # 使用 paper 风格，表格宽度自适应
  column_spec(
    3,                                                # 第三列（image 列）
    image = spec_image(path_images, 200, 200)         # 插入图片，宽高均为 200 像素
  )
name field image
E. Charpentier Chemistry
R. Penrose Physics
L. Glück Litterature
M. Houghton Medicine

使用 kableExtra 在表格中插入图片

19.3.2.4 链接

添加图片及连接：

Show/Hide Code 
# 生成图片路径向量，每行对应一张图片
path_images = rep("./image/pikachu.png", nrow(df))

# 定义每个人名对应的维基百科链接
urls = c(
  "https://en.wikipedia.org/wiki/Emmanuelle_Charpentier",
  "https://en.wikipedia.org/wiki/Roger_Penrose",
  "https://en.wikipedia.org/wiki/Louise_Glück",
  "https://en.wikipedia.org/wiki/Michael_Houghton"
)

df |>
  kbl(booktabs = TRUE, align = "c") |> # 创建表格，使用booktabs风格，所有列居中
  kable_styling() |> # 应用默认的表格美化样式
  kable_material(c("striped", "hover", "condensed", "responsive")) |> # 应用Material风格，带斑马纹、悬停、紧凑和响应式
  column_spec(1, link = urls, bold = TRUE) |> # 第一列（姓名）添加超链接并加粗
  column_spec(3, image = spec_image(path_images, 200, 200)) # 第三列插入图片，宽高均为200像素
name field image
E. Charpentier Chemistry
R. Penrose Physics
L. Glück Litterature
M. Houghton Medicine

使用 kableExtra 添加图片和超链接

19.4 Interactive

DT、reactable 或 formattable 制作交互式表格

19.4.1 DT

DT（官方文档），即DataTables，基于 Javascript，DT 以其高效处理大型数据集的能力和丰富的功能（如搜索、排序和分页）而突出。

19.4.1.1 基本

主要是 DT::datatable() 函数:

Show/Hide Code 
data(mtcars)

table = datatable(mtcars)
table

使用 DT 包创建交互式表格：基本用法

Show/Hide Code 
# 保存为 HTML 文件
# library(htmlwidgets) # 加载 htmlwidgets 包
# saveWidget(table, file="../HtmlWidget/dt-table-basic.html") # 保存为 HTML 文件

19.4.1.2 CSS 类

Show/Hide Code 
table = datatable(
  mtcars, 
  class = 'cell-border stripe hover compact'
)
table

使用 DT 包创建交互式表格：添加 CSS 类

19.4.1.3 标题

Show/Hide Code 
# 使用 datatable() 创建交互式表格，并添加标题
table <- datatable(
  mtcars, # 数据集，内置的汽车数据
  caption = tags$caption(
    style = 'caption-side: bottom; text-align: center;', # 设置标题样式：底部居中
    'Table 1: ', # 标题前缀
    em('The mtcars dataset is a dataset about cars properties') # 斜体副标题
  )
)
table # 显示表格

使用 DT 包创建交互式表格：添加标题

19.4.1.4 筛选

Show/Hide Code 
table <- datatable(mtcars,
  filter = "top", # 在表格顶部添加筛选器
)
table

使用 DT 包创建交互式表格：添加筛选器

19.4.1.5 Callback

callback 参数将 JavaScript 函数用在表格中：

Show/Hide Code 
table <- datatable(mtcars, callback = JS('table.page("next").draw(false);'))
table

使用 DT 包创建交互式表格：添加 JavaScript 回调

19.4.1.6 编辑

Show/Hide Code 
table <- datatable(
  mtcars,
  editable = list(
    target = "row",
    disable = list(columns = c(1, 3, 5))
  )
)
table # 显示可编辑的表格

使用 DT 包创建可编辑的交互式表格

19.4.1.7 定制

Show/Hide Code 
# 创建一个包含 HTML 内容的数据集
data = matrix(
  c(
    '<b>Bold</b>', # 第一行第一列，粗体 HTML 标签
    '<em>Emphasize</em>', # 第二行第一列，斜体 HTML 标签
    '<a href="https://r-graph-gallery.com/package/dt.html">Click here</a>', # 第一行第二列，带链接的 HTML 标签
    '<a href="#" onclick="alert(\'This message is displayed thanks to DT table!\');">Click there</a>' # 第二行第二列，点击弹窗的 HTML 标签
  ),
  2 # 指定矩阵有两列
)

# 修改列名，使用 HTML 语法自定义样式
colnames(data) = c(
  '<span style="color:red">Red column</span>', # 第一列名为红色字体
  '<em>Italic column</em>' # 第二列名为斜体
)

# 创建 DT 交互式表格
table <- datatable(
  data,
  escape = FALSE # 允许单元格内容作为 HTML 解释（否则会转义为纯文本）
)

table # 显示表格

使用 DT 包创建带有 HTML 内容和自定义列名的交互式表格

19.4.2 reactable

无限单元格自定义

它简化了在单元格中嵌入图片的过程，通过其高级单元格着色功能，可以创建类似热图的表格。

此外，它还提供了独特的功能来集成条形图或气泡，进一步增强了表格的视觉吸引力和信息价值。

也非常适合设计具有可扩展行的表格，使其成为以用户友好方式汇总和展示复杂数据集的理想选择。

19.4.2.1 基本

Show/Hide Code 
df = data.frame(
  date = as.POSIXct(
    c("2019-01-02 3:22:15", "2019-03-15 09:15:55", "2019-09-22 14:20:00"),
    tz = "America/New_York"
  ),
  currency = c(1000, 2000, 3000),
  temperature = c(10, 20, 30),
  percentage = c(0.12, 0.23, 0.34)
)

tab <- (reactable(df))

embed_widget(tab, height = "300px")

使用 reactable() 创建交互式表格：基本用法

19.4.2.2 日期

使用 colFormat() 函数来格式化日期

format 参数来自定义日期格式，有三种日期格式： datetime、date和 time。

Show/Hide Code 
# 创建一个包含不同时间格式的数据框
datetimes <- as.POSIXct(
  c("2019-01-02 3:22:15", "2019-03-15 09:15:55", "2019-09-22 14:20:00"),
  tz = "America/New_York"
)
data <- data.frame(
  datetime = datetimes,         # 日期时间列
  date = datetimes,             # 仅日期列
  time = datetimes,             # 仅时间列（12小时制）
  time_24h = datetimes,         # 仅时间列（24小时制）
  datetime_pt_BR = datetimes    # 用于本地化显示的日期时间列
)

# 使用 reactable 创建交互式表格，并对不同列应用不同的日期/时间格式
tab <- reactable(
  data,
  columns = list(
    datetime = colDef(format = colFormat(datetime = TRUE)), # 显示完整日期时间
    date = colDef(format = colFormat(date = TRUE)),         # 仅显示日期
    time = colDef(format = colFormat(time = TRUE)),         # 仅显示时间（12小时制）
    time_24h = colDef(format = colFormat(time = TRUE, hour12 = FALSE)), # 仅显示时间（24小时制）
    datetime_pt_BR = colDef(
      format = colFormat(datetime = TRUE, locales = "zh-CN") # 按中国北京时间显示日期时间
    )
  )
)

embed_widget(tab, height = "300px")

使用 reactable::colFormat() 格式化日期、时间和本地化显示

19.4.2.3 货币

Show/Hide Code 
# 创建一个包含多种货币的数据框
data = data.frame(
  USD = c(12.12, 2141.213, 0.42, 1.55, 34414),         # 美元
  EUR = c(10.68, 1884.27, 0.37, 1.36, 30284.32),       # 欧元
  INR = c(861.07, 152122.48, 29.84, 110, 2444942.63),  # 印度卢比
  JPY = c(1280, 226144, 44.36, 164, 3634634.61),       # 日元
  MAD = c(115.78, 20453.94, 4.01, 15, 328739.73)       # 摩洛哥迪拉姆
)

# 使用 reactable 创建交互式表格，并对每一列应用不同的货币格式和本地化设置
tab = reactable(
  data,
  columns = list(
    USD = colDef(
      # 美元，千分位分隔符，英文美国本地化
      format = colFormat(currency = "USD", separators = TRUE, locales = "en-US")
    ),
    EUR = colDef(
      # 欧元，千分位分隔符，德语德国本地化
      format = colFormat(currency = "EUR", separators = TRUE, locales = "de-DE")
    ),
    INR = colDef(
      # 印度卢比，千分位分隔符，印地语印度本地化
      format = colFormat(currency = "INR", separators = TRUE, locales = "hi-IN")
    ),
    JPY = colDef(
      # 日元，千分位分隔符，日语日本本地化
      format = colFormat(currency = "JPY", separators = TRUE, locales = "ja-JP")
    ),
    MAD = colDef(
      # 摩洛哥迪拉姆，千分位分隔符，阿拉伯语摩洛哥本地化
      format = colFormat(currency = "MAD", separators = TRUE, locales = "ar-MA")
    )
  )
)

embed_widget(tab, height = "300px")

使用 reactable::colFormat() 格式化多种货币并本地化显示

19.4.2.4 数字

Show/Hide Code 
# 创建一个包含温度和百分比的数据框
df <- data.frame(
  temperature = c(10, 20, 30),   # 温度列，单位为摄氏度
  percentage = c(0.12, 0.23, 0.34) # 百分比列，原始值为小数
)

# 使用 reactable 创建交互式表格，并对不同列进行格式化
tab <- reactable(
  df,
  columns = list(
    # 对 temperature 列添加后缀“°C”
    temperature = colDef(format = colFormat(suffix = " °C")),
    # 对 percentage 列格式化为百分比，并添加前缀“Percent: ”
    percentage = colDef(
      format = colFormat(percent = TRUE, prefix = "Percent: ")
    )
  )
)

embed_widget(tab, height = "200px")

使用 reactable::colFormat() 格式化数字列

19.4.2.5 图片表格

Show/Hide Code 
library(tidyverse) # 数据处理与可视化
library(reactablefmtr) # reactable 扩展包，用于数据条、色阶等
library(reactable) # 交互式表格
library(htmltools) # HTML 工具包
library(webshot2) # 网页截图

# 读取数据
df <- read_csv(
  "
rank,player,years,australian_open,french_open,us_open,wimbledon,titles,region
1,Margaret Court,1960–1973,11,5,5,3,24,https://raw.githubusercontent.com/catamphetamine/country-flag-icons/master/flags/1x1/AU.svg
2,Serena Williams,1999–2017,7,3,6,7,23,https://raw.githubusercontent.com/catamphetamine/country-flag-icons/master/flags/1x1/US.svg
3,Steffi Graf,1987–1999,4,6,5,7,22,https://raw.githubusercontent.com/catamphetamine/country-flag-icons/master/flags/1x1/DE.svg
4,Helen Wills Moody,1923–1938,0,4,7,8,19,https://raw.githubusercontent.com/catamphetamine/country-flag-icons/master/flags/1x1/US.svg
5,Chris Evert,1974–1986,2,7,6,3,18,https://raw.githubusercontent.com/catamphetamine/country-flag-icons/master/flags/1x1/US.svg
5,Martina Navratilova,1978–1990,3,2,4,9,18,https://raw.githubusercontent.com/catamphetamine/country-flag-icons/master/flags/1x1/US.svg
6,Billie Jean King,1966–1975,1,1,4,6,12,https://raw.githubusercontent.com/catamphetamine/country-flag-icons/master/flags/1x1/US.svg
7,Maureen Connolly,1951–1954,1,2,3,3,9,https://raw.githubusercontent.com/catamphetamine/country-flag-icons/master/flags/1x1/US.svg
7,Monica Seles,1990–1996,4,3,2,0,9,https://raw.githubusercontent.com/catamphetamine/country-flag-icons/master/flags/1x1/US.svg
8,Molla Bjurstedt Mallory,1915–1922,0,0,8,0,8,https://raw.githubusercontent.com/catamphetamine/country-flag-icons/master/flags/1x1/FR.svg
8,Suzanne Lenglen,1919–1926,0,2,0,6,8,https://raw.githubusercontent.com/catamphetamine/country-flag-icons/master/flags/1x1/US.svg
"
)


# 自定义色阶调色板，用于色阶填充
pal_scale <- c("#F4FFFD", "#E9DAEC", "#A270E5", "#43009A")

# 主体表格，注意字体需本地安装
table <- reactable(
  df |>
    dplyr::select( # 还起到一个排序的作用
      rank,
      player,
      region,
      australian_open,
      french_open,
      us_open,
      wimbledon,
      titles
    ),
  theme = reactableTheme(
    borderColor = "#DADADA" # 边框颜色
  ),
  defaultPageSize = 11, # 默认每页显示11行
  defaultColDef = colDef(
    vAlign = "center", # 垂直居中
    align = "center", # 水平居中
    headerVAlign = "center", # 表头垂直居中
    style = color_scales(df, span = 4:7, colors = pal_scale), # 4~7列使用色阶填充
    width = 90 # 列宽
  ),
  columnGroups = list(
    colGroup(
      name = "", # 分组名为空
      columns = c("player", "region", "titles"), # 分组列
      align = "left" # 左对齐
    ),
    colGroup(
      name = "Event", # 分组名
      columns = c("australian_open", "us_open", "french_open", "wimbledon"), # 大满贯赛事列
    )
  ),
  columns = list(
    rank = colDef(show = FALSE), # 隐藏rank列
    player = colDef(
      name = "Player (First Title - Last Title)", # 列名
      align = "left", # 左对齐
      width = 250, # 列宽
      # 自定义单元格内容：显示球员头像+姓名+年份
      cell = function(value) {
        image <- img(
          src = paste0(
            "https://raw.githubusercontent.com/tashapiro/tanya-data-viz/main/tennis/images/",
            str_replace_all(tolower(value), " ", "_"),
            ".png"
          ),
          style = "height: 33px;",
          alt = value
        )
        tagList(
          div(
            style = "display: inline-block;vertical-align:middle;width:50px",
            image
          ),
          div(
            style = "display: inline-block;vertical-align:middle;",
            div(style = "vertical-align:middle;", value),
            div(
              style = "vertical-align:middle;font-size:8pt;color:#8C8C8C;",
              paste0("(", df[df$player == value, ]$years),
              ")"
            )
          )
        )
      }
    ),
    region = colDef(
      name = "Region", # 列名
      align = "left", # 左对齐
      # 自定义单元格内容：显示国旗图片，部分球员加星号
      cell = function(value, index) {
        image <- img(
          src = value,
          style = "width:60px;height:20px;",
          alt = value
        )
        player <- df$player[index]
        if (player %in% c("Monica Seles", "Molla Bjurstedt Mallory")) {
          tagList(div(
            style = "display:inline-block;vertical-align:middle;width:80px",
            image,
            "*"
          ))
        } else {
          tagList(div(
            style = "display:inline-block;vertical-align:middle;width:50px",
            image
          ))
        }
      },
      width = 120 # 列宽
    ),
    australian_open = colDef(name = "AU Open"), # 澳网
    french_open = colDef(name = "FR Open"), # 法网
    us_open = colDef(name = "US Open"), # 美网
    wimbledon = colDef(name = "Wmbl"), # 温网
    titles = colDef(
      name = "Total Titles", # 列名
      width = 180, # 列宽
      class = "border-left", # 左边加边框
      align = "left", # 左对齐
      # 使用数据条可视化总冠军数
      cell = data_bars(
        df,
        fill_color = "#7814ff", # 数据条颜色
        text_position = "outside-end", # 数字显示在条形外部
        bar_height = 10, # 条形高度
        text_size = 12, # 数字字体大小
        min_value = 5, # 最小值
        max_value = 32, # 最大值
        background = "transparent" # 背景透明
      )
    )
  )
)

# 添加标题、子标题、脚注和数据来源
# 字体需本地安装（如 Font Awesome 图标字体）
table_final <- table |>
  htmlwidgets::prependContent(
    tagList(
      # 网球logo
      tags$img(
        src = "https://pngimg.com/uploads/tennis/tennis_PNG10416.png",
        style = "width:50px;height:34px;display:inline-block;vertical-align:middle;"
      ),
      # 主标题
      tags$div(
        "Grand Slam Legends",
        style = "font-size:32px;font-weight:bold;font-family:sans-serif;margin-bottom:0;display:inline-block;vertical-align:middle;"
      ),
      # 副标题
      tags$h3(
        "Top Women's Tennis Players by Singles Championship Titles",
        style = "font-family:sans-serif;margin-bottom:0;margin-top:0;font-weight:400;color:#8C8C8C;padding-left:10px;"
      )
    )
  ) |>
  htmlwidgets::appendContent(
    # 脚注
    tags$div(
      "* Player represented more than one country during career. Most recent country shown.",
      style = "font-family:Roboto;color:black;font-size:9pt;border-bottom-style:solid;border-top-style:solid;width:910px;padding-bottom:8px;padding-top:8px;border-color:#DADADA;"
    ),
    # 数据来源
    tags$div(
      tags$div(
        "Data: Wikipedia as of November 2022 | Graphic: ",
        style = "display:inline-block;vertical-align:middle;"
      ),
      tags$div(
        "twitter",
        style = "font-family:'Font Awesome 6 Brands';display:inline-block;vertical-align:middle;"
      ),
      tags$div(
        "tanya_shapiro",
        style = "display:inline-block;vertical-align:middle;"
      ),
      tags$div(
        "github",
        style = "font-family:'Font Awesome 6 Brands';display:inline-block;vertical-align:middle;"
      ),
      tags$div(
        "tashapiro",
        style = "display:inline-block;vertical-align:middle;"
      ),
      style = "font-family:sans-serif;color:#8C8C8C;font-size:10pt;width:910px;padding-top:8px;display:inline-block;vertical-align:middle;"
    )
  )

embed_widget(table_final)

使用 reactable 和 reactablefmtr 制作带图片和数据条的网球冠军表格

19.4.3 formattable

formattable 是另一个创建交互式表格的 R 包。

19.4.3.1 基础

formattable 提供了几种典型的可格式化对象，如 percent、comma、currency、accounting 和 scientific 。

这些对象本质上是在预定义格式规则和参数下的数值向量

# 百分比
percent(c(0.1, 0.02, 0.03, 0.12))
#> [1] 10.00% 2.00%  3.00%  12.00%

# 百分比可运算
percent(c(0.1, 0.02, 0.03, 0.12)) + 0.05
#> [1] 15.00% 7.00%  8.00%  17.00%

# 货币
balance <- accounting(c(1000, 500, 200, -150, 0, 1200))
balance
#> [1] 1,000.00 500.00   200.00   (150.00) 0.00     1,200.00

# 货币可运算
balance + 1000
#> [1] 2,000.00 1,500.00 1,200.00 850.00   1,000.00 2,200.00

# 布尔
formattable(c(TRUE, TRUE, FALSE, FALSE, TRUE), "yes", "no")
#> [1] yes yes no  no  yes

# 格式化后的表格
data.frame(
  id = c(1, 2, 3, 4, 5),
  name = c("A1", "A2", "B1", "B2", "C1"),
  balance = accounting(c(52500, 36150, 25000, 18300, 7600), format = "d"),
  growth = percent(c(0.3, 0.3, 0.1, 0.15, 0.15), format = "d"),
  ready = formattable(c(TRUE, TRUE, FALSE, FALSE, TRUE), "yes", "no")
)
idnamebalancegrowthready
1A1525000.3TRUE
2A2361500.3TRUE
3B1250000.1FALSE
4B2183000.15FALSE
5C176000.15TRUE

使用 formattable 包创建格式化对象

19.4.3.2 表格

Show/Hide Code 
df <- data.frame(
  id = 1:10,
  name = c(
    "Bob",
    "Ashley",
    "James",
    "David",
    "Jenny",
    "Hans",
    "Leo",
    "John",
    "Emily",
    "Lee"
  ),
  age = c(28, 27, 30, 28, 29, 29, 27, 27, 31, 30),
  grade = c("C", "A", "A", "C", "B", "B", "B", "A", "C", "C"),
  test1_score = c(8.9, 9.5, 9.6, 8.9, 9.1, 9.3, 9.3, 9.9, 8.5, 8.6),
  test2_score = c(9.1, 9.1, 9.2, 9.1, 8.9, 8.5, 9.2, 9.3, 9.1, 8.8),
  final_score = c(9, 9.3, 9.4, 9, 9, 8.9, 9.25, 9.6, 8.8, 8.7),
  registered = c(
    TRUE,
    FALSE,
    TRUE,
    FALSE,
    TRUE,
    TRUE,
    TRUE,
    FALSE,
    FALSE,
    FALSE
  ),
  stringsAsFactors = FALSE # 避免自动转化为因子
)

df |> formattable(caption = "用于 `formattable` 的格式化前的数据")
用于 formattable 的格式化前的数据
id name age grade test1_score test2_score final_score registered
1 Bob 28 C 8.9 9.1 9.00 TRUE
2 Ashley 27 A 9.5 9.1 9.30 FALSE
3 James 30 A 9.6 9.2 9.40 TRUE
4 David 28 C 8.9 9.1 9.00 FALSE
5 Jenny 29 B 9.1 8.9 9.00 TRUE
6 Hans 29 B 9.3 8.5 8.90 TRUE
7 Leo 27 B 9.3 9.2 9.25 TRUE
8 John 27 A 9.9 9.3 9.60 FALSE
9 Emily 31 C 8.5 9.1 8.80 FALSE
10 Lee 30 C 8.6 8.8 8.70 FALSE

用于 formattable 的原始数据

终于要来了！ 用 formattable() 创建一个漂亮的表格

Show/Hide Code 
library(formattable) 

formattable(
  df,
  list(
    # age 列：使用 color_tile() 为单元格添加从白色到橙色的渐变色背景
    age = color_tile("white", "orange"),

    # grade 列：A 等级为绿色加粗，其余不变
    grade = formatter(
      "span",
      style = x ~
        ifelse(x == "A", formattable::style(color = "green", font.weight = "bold"), NA)
    ),

    # test1_score 和 test2_score 列：normalize_bar() 添加粉色条形图，宽度最小为 0.2
    area(col = c(test1_score, test2_score)) ~ normalize_bar("pink", 0.2),

    # final_score 列：前 3 名为绿色，其余为灰色，并显示分数和排名
    final_score = formatter(
      "span",
      style = x ~ formattable::style(color = ifelse(rank(-x) <= 3, "green", "gray")),
      x ~ sprintf("%.2f (rank: %02d)", x, rank(-x))
    ),

    # registered 列：TRUE 为绿色“ok”图标和 Yes，FALSE 为红色“remove”图标和 No
    registered = formatter(
      "span",
      style = x ~ formattable::style(color = ifelse(x, "green", "red")),
      x ~ icontext(ifelse(x, "ok", "remove"), ifelse(x, "Yes", "No"))
    )
  )
)
id name age grade test1_score test2_score final_score registered
1 Bob 28 C 8.9 9.1 9.00 (rank: 06) Yes
2 Ashley 27 A 9.5 9.1 9.30 (rank: 03) No
3 James 30 A 9.6 9.2 9.40 (rank: 02) Yes
4 David 28 C 8.9 9.1 9.00 (rank: 06) No
5 Jenny 29 B 9.1 8.9 9.00 (rank: 06) Yes
6 Hans 29 B 9.3 8.5 8.90 (rank: 08) Yes
7 Leo 27 B 9.3 9.2 9.25 (rank: 04) Yes
8 John 27 A 9.9 9.3 9.60 (rank: 01) No
9 Emily 31 C 8.5 9.1 8.80 (rank: 09) No
10 Lee 30 C 8.6 8.8 8.70 (rank: 10) No

使用 formattable 包创建带有条件格式和图标的交互式表格

19.5 Other

19.5.1 flextable

flextable （官方文档） 是创建非常精致静态表格的另一个可靠选项。它支持多种格式选项，包括合并单元格、旋转文本和条件格式化。

它的独特之处在于与多种 R Markdown 格式的兼容性，包括 Word、PowerPoint 和 HTML。

# 这段代码不会被执行

flextable(iris) |> 
  theme_vanilla() |> 
  save_as_docx(path = "mytable.docx") # 导出为word文档
Show/Hide Code 
library(flextable)

# 设置 flextable 的默认参数
set_flextable_defaults(
  font.family = "Arial",   # 设置字体为 Arial
  font.size = 10,          # 设置字体大小为 10
  border.color = "gray",   # 设置边框颜色为灰色
  big.mark = ""            # 千分位分隔符为空
)

# 创建 flextable 表格对象
ft <- flextable(head(mtcars)) |>
  flextable::bold(part = "header")    # 表头加粗

ft

mpg

cyl

disp

hp

drat

wt

qsec

vs

am

gear

carb

21.0

6

160

110

3.90

2.620

16.46

0

1

4

4

21.0

6

160

110

3.90

2.875

17.02

0

1

4

4

22.8

4

108

93

3.85

2.320

18.61

1

1

4

1

21.4

6

258

110

3.08

3.215

19.44

1

0

3

1

18.7

8

360

175

3.15

3.440

17.02

0

0

3

2

18.1

6

225

105

2.76

3.460

20.22

1

0

3

1

使用 flextable 包创建精致的静态表格，并自定义字体、字号、边框颜色等样式

Show/Hide Code 
ft |>
  highlight(
    i = ~ mpg < 22,                # 选择 mpg 小于 22 的行
    j = "disp",                    # 仅对 disp 列进行高亮
    color = "#ffe842"              # 设置高亮颜色为黄色
  ) |>
  bg(
    j = c("hp", "drat", "wt"),     # 对 hp、drat、wt 三列设置背景色
    bg = scales::col_quantile(     # 使用分位数调色板自动分配背景色
      palette = c("wheat", "red"), # 渐变色从 wheat 到 red
      domain = NULL                # 自动根据数据范围计算分位数
    )
  ) |>
  add_footer_lines(
    "The 'mtcars' dataset"         # 在表格底部添加脚注说明
  )

mpg

cyl

disp

hp

drat

wt

qsec

vs

am

gear

carb

21.0

6

160

110

3.90

2.620

16.46

0

1

4

4

21.0

6

160

110

3.90

2.875

17.02

0

1

4

4

22.8

4

108

93

3.85

2.320

18.61

1

1

4

1

21.4

6

258

110

3.08

3.215

19.44

1

0

3

1

18.7

8

360

175

3.15

3.440

17.02

0

0

3

2

18.1

6

225

105

2.76

3.460

20.22

1

0

3

1

The 'mtcars' dataset

使用 flextable 包创建精致的静态表格，并自定义高亮、背景色和添加脚注

Show/Hide Code 
ggplot2::diamonds[, c("cut", "carat", "price", "clarity", "table")] |>
  summarizor(by = c("cut")) |> # summarizor: 按 cut 分组汇总数据
  flextable::as_flextable(spread_first_col = TRUE) # as_flextable: 转为 flextable 表格，spread_first_col=TRUE 将第一列展开为分组标签

Fair
(N=1610)

Good
(N=4906)

Very Good
(N=12082)

Premium
(N=13791)

Ideal
(N=21551)

carat

Mean (SD)

1.0 (0.5)

0.8 (0.5)

0.8 (0.5)

0.9 (0.5)

0.7 (0.4)

Median (IQR)

1.0 (0.5)

0.8 (0.5)

0.7 (0.6)

0.9 (0.8)

0.5 (0.7)

Range

0.2 - 5.0

0.2 - 3.0

0.2 - 4.0

0.2 - 4.0

0.2 - 3.5

price

Mean (SD)

4358.8 (3560.4)

3928.9 (3681.6)

3981.8 (3935.9)

4584.3 (4349.2)

3457.5 (3808.4)

Median (IQR)

3282.0 (3155.2)

3050.5 (3883.0)

2648.0 (4460.8)

3185.0 (5250.0)

1810.0 (3800.5)

Range

337.0 - 18574.0

327.0 - 18788.0

336.0 - 18818.0

326.0 - 18823.0

326.0 - 18806.0

clarity

I1

210 (13.0%)

96 (2.0%)

84 (0.7%)

205 (1.5%)

146 (0.7%)

SI2

466 (28.9%)

1081 (22.0%)

2100 (17.4%)

2949 (21.4%)

2598 (12.1%)

SI1

408 (25.3%)

1560 (31.8%)

3240 (26.8%)

3575 (25.9%)

4282 (19.9%)

VS2

261 (16.2%)

978 (19.9%)

2591 (21.4%)

3357 (24.3%)

5071 (23.5%)

VS1

170 (10.6%)

648 (13.2%)

1775 (14.7%)

1989 (14.4%)

3589 (16.7%)

VVS2

69 (4.3%)

286 (5.8%)

1235 (10.2%)

870 (6.3%)

2606 (12.1%)

VVS1

17 (1.1%)

186 (3.8%)

789 (6.5%)

616 (4.5%)

2047 (9.5%)

IF

9 (0.6%)

71 (1.4%)

268 (2.2%)

230 (1.7%)

1212 (5.6%)

table

Mean (SD)

59.1 (3.9)

58.7 (2.9)

58.0 (2.1)

58.7 (1.5)

56.0 (1.2)

Median (IQR)

58.0 (5.0)

58.0 (5.0)

58.0 (3.0)

59.0 (2.0)

56.0 (2.0)

Range

49.0 - 95.0

51.0 - 66.0

44.0 - 66.0

51.0 - 62.0

43.0 - 63.0

使用 flextable 包对 diamonds 数据集按 cut 分组汇总并美观展示

19.5.2 rhandsontable

Rhandsontable 提供了一个交互式表格界面，允许在 Shiny 应用或 R Markdown 文档中直接编辑表格。它通过下拉菜单、复选框和日历辅助工具等特性，区别于其他工具，强调交互性和用户输入。

它最适合需要在网页界面中交互式编辑和操作数据的场景，例如 Shiny 应用程序。

Show/Hide Code 
# 由于Quarto渲染问题，所以不执行这段代码
df = data.frame(
  int = 1:10, # 整数列
  numeric = rnorm(10), # 正态分布的数值列
  logical = TRUE, # 逻辑值列，全部为 TRUE
  character = LETTERS[1:10], # 字符型列，A~J
  fact = factor(letters[1:10]), # 因子型列，a~j
  date = seq(from = Sys.Date(), by = "days", length.out = 10), # 日期列，从今天起连续10天
  stringsAsFactors = FALSE # 不自动转为因子
)

# 添加 sparkline 迷你图数据列，每行生成一个包含10个正态分布随机数的 JSON
df$chart = sapply(1:10, function(x) jsonlite::toJSON(list(values = rnorm(10))))

# 创建 rhandsontable 交互式表格
p <- rhandsontable(df, rowHeaders = NULL) |> # rowHeaders = NULL 不显示行名
  hot_col(
    "chart", # 指定 chart 列
    renderer = htmlwidgets::JS("renderSparkline") # 使用 JS 渲染 sparkline 迷你图
  )

embed_widget(p, height = "300px")

使用 rhandsontable 包创建可交互编辑的表格，并在 ‘chart’ 列中嵌入 sparkline 迷你图

19.5.3 modelsummary

19.5.3.1 介绍

官方文档: modelsummary

主要有两个系列函数：

Model Summary 模型摘要

  • modelsummary : 并列模型回归表。
  • modelplot : 系数图。

Data Summary 数据摘要

  • datasummary : 创建（多级）交叉表和数据摘要的强大工具。
  • datasummary_crosstab : 交叉表。
  • datasummary_balance : 基线表，包含子组统计和均值差异（又名 “table 1” ）。
  • datasummary_correlation : 相关性表格。
  • datasummary_skim : 数据集的快速概览（“skim”）。
  • datasummary_df : 将数据框转换为带有标题、注释等的漂亮表格。

19.5.3.2 特点

简单：

Show/Hide Code 
library(modelsummary)

mod <- lm(Sepal.Width ~ Sepal.Length, iris) # 建模

modelsummary(mod, output = "markdown") # 输出为 markdown 格式，还可以输出docx / tex 格式
(1)
(Intercept) 3.419
(0.254)
Sepal.Length -0.062
(0.043)
Num.Obs. 150
R2 0.014
R2 Adj. 0.007
AIC 179.5
BIC 188.5
Log.Lik. -86.732
RMSE 0.43
Show/Hide Code 
# modelsummary(mod, output = "table.docx")
# modelsummary(mod, output = "table.tex")

灵活：

  • 信息：该软件包提供了许多直观且强大的工具，用于自定义摘要表中报告的信息。
  • 外观：无线定制
  • 支持的模型：得益于 broom 和 parameters ， modelsummary 默认支持数百种统计模型。
  • 输出格式： HTML、LaTeX、文本 / Markdown、Word、Powerpoint、RTF、JPG 或 PNG 格式

危险

甚至可以把松鼠插到整个表格：

表格中有一只松鼠

可靠

很少会崩溃

19.5.4 huxtable

用于 LaTeX 输出

官方文档：huxtable

19.5.4.1 基本

Show/Hide Code 
library(huxtable)

df <- data.frame(
  Employee = c("John Smith", "Jane Doe", "David Hugh-Jones"),
  Salary = c(50000, 50000, 40000),
  add_colnames = TRUE
)

ht <- hux(df)

# 将第一行（表头）加粗
bold(ht)[1, ] <- TRUE

# 设置第一行底部边框宽度为 0.4
bottom_border(ht)[1, ] <- 0.4

# 设置第二列（Salary）右对齐
align(ht)[, 2] <- "right"

# 设置所有单元格右侧内边距为 10
right_padding(ht) <- 10

# 设置所有单元格左侧内边距为 10
left_padding(ht) <- 10

# 设置表格宽度为 0.35（相对于页面宽度）
width(ht) <- 0.35

# 设置所有单元格数字格式为保留 2 位小数
number_format(ht) <- 2

# 查看表格
ht
EmployeeSalaryadd_colnames
John Smith50000.00TRUE
Jane Doe50000.00TRUE
David Hugh-Jones40000.00TRUE

使用 huxtable 包创建 LaTeX 表格并自定义样式

19.5.4.2 管道

Show/Hide Code 
ht <- hux(
  Employee = c("John Smith", "Jane Doe", "David Hugh-Jones"), # 员工姓名
  Salary = c(50000, 50000, 40000) # 薪资
)

ht |>
  set_bold(1, everywhere) |> # 第一行（表头）加粗，everywhere 表示所有列
  set_bottom_border(1, everywhere) |> # 第一行底部加边框
  set_align(everywhere, 2, "right") |> # 第二列（薪资）右对齐
  set_lr_padding(10) |> # 左右内边距均为10
  set_width(0.35) |> # 表格宽度为页面的0.35
  set_number_format(2) # 数字保留2位小数
EmployeeSalary
John Smith50000.00
Jane Doe50000.00
David Hugh-Jones40000.00

使用 huxtable 包管道风格创建 LaTeX 表格并自定义样式

19.5.4.3 格式化

Show/Hide Code 
mtcars[1:5] |>
  as_huxtable(add_rownames = "Model") |> # 将数据框转换为 huxtable，并添加行名列“Model”
  set_bold(1, everywhere, TRUE) |>       # 第一行（表头）所有列加粗
  set_all_borders(1) |>                  # 所有单元格加边框，宽度为1
  map_text_color(everywhere, "mpg", by_colorspace("navy", "red", "yellow")) |> # mpg 列根据数值映射文本颜色（深蓝-红-黄渐变）
  map_background_color(
    everywhere,
    "hp",
    by_quantiles(0.8, c("white", "yellow")) # hp 列按分位数映射背景色（白-黄）
  ) |>
  map_italic(everywhere, "Model", by_regex("Merc.*" = TRUE)) |> # Model 列名以 Merc 开头的行斜体
  head(12) # 取前12行
Modelmpgcyldisphpdrat
Mazda RX421  61601103.9
Mazda RX4 Wag21  61601103.9
Datsun 71022.84108933.85
Hornet 4 Drive21.462581103.08
Hornet Sportabout18.783601753.15
Valiant18.162251052.76
Duster 36014.383602453.21
Merc 240D24.44147623.69
Merc 23022.84141953.92
Merc 28019.261681233.92
Merc 280C17.861681233.92

使用 huxtable 包格式化 LaTeX 表格：文本颜色、背景色、斜体和边框

19.5.4.4 多回归表

Show/Hide Code 
data(diamonds, package = "ggplot2")

lm1 <- lm(log(price) ~ carat, diamonds) # 线性回归模型1：以 carat 预测 log(price)
lm2 <- lm(log(price) ~ depth, diamonds) # 线性回归模型2：以 depth 预测 log(price)
lm3 <- lm(log(price) ~ carat + depth, diamonds) # 线性回归模型3：以 carat 和 depth 预测 log(price)

# huxreg() 用于并排展示多个回归模型结果
# 参数说明：
#   lm1, lm2, lm3：要比较的多个回归模型对象
#   statistics：自定义底部统计量，N 表示样本量（nobs），R2 表示决定系数（r.squared）
huxreg(
  lm1,
  lm2,
  lm3,
  statistics = c("N" = "nobs", "R2" = "r.squared")
)
(1)(2)(3)
(Intercept)6.215 ***7.749 ***7.313 ***
(0.003)   (0.188)   (0.074)   
carat1.970 ***        1.971 ***
(0.004)           (0.004)   
depth        0.001    -0.018 ***
        (0.003)   (0.001)   
N53940        53940        53940        
R20.847    0.000    0.847    
*** p < 0.001; ** p < 0.01; * p < 0.05.

使用 huxtable 包的 huxreg() 创建多模型回归结果表格，并详细注释各参数

19.5.4.5 快速文档

# 这段代码不会被执行

quick_pdf(mtcars)
quick_docx(mtcars)
quick_html(mtcars)
quick_xlsx(mtcars)

19.6 Pearl

Tidyverse in Numbers 美观的带有图片的交互式表格。