install.packages("gtExtras")
# if needed install.packages("remotes")
remotes::install_github("jthomasmock/gtExtras")49 gtExtras美化表格
:::{.callout-not title = “注意} 关于R语言绘制三线表/表格，我很久之前就介绍过了，但是最近发现部分内容更新了，而且更新后很多函数都不能用了！！所以我也跟着更新一下。
之前的推文（公众号后台回复表格可获取合集）：
- 使用compareGroups包1行代码生成基线资料表
- 使用R语言快速绘制三线表
- tableone？table1？傻傻分不清楚
- gt包绘制表格详细介绍！
- 使用gtExtra美化表格
- 超强的gtSummary ≈ gt + comparegroups ??
- compareGroups包1行代码生成基线资料表（新） :::
gt很强大，但是还是不够强大，总有些大佬想要更加强大，于是就有了今天要介绍的gtExtras，这是一个扩展包，为gt提供多种强大的可视化功能！
目前gtExtras包还处于快速开发中，大家需要及时更新（有可能会出现以前的函数不能用）。
目前gtExtras的功能主要是分为5大类：
- 给表格换主题
- 绘制各种行内图形
- 给表格添加图片或者图标
- 高亮某些单元格
- 其他
下面简单介绍下。
49.1 安装
2选1：
49.2 快速上手
49.2.1 fmt_symbol_first
gt中提供了非常好用的格式化功能，而这个函数可以只格式化一列的第一行，包括添加各种符号等，然后在其余行的最后添加空格，达到对齐的效果。
library(gtExtras)
## Loading required package: gt
library(gt)
gtcars %>%
head() %>%
dplyr::select(mfr, year, bdy_style, mpg_h, hp) %>%
dplyr::mutate(mpg_h = rnorm(n = dplyr::n(), mean = 22, sd = 1)) %>%
gt::gt() %>%
gt::opt_table_lines() %>%
fmt_symbol_first(column = mfr, symbol = "$", last_row_n = 6) %>%
fmt_symbol_first(column = year, suffix = "%") %>%
fmt_symbol_first(column = mpg_h, symbol = "%", decimals = 1) %>%
fmt_symbol_first(hp, symbol = "°", suffix = "F", symbol_first = TRUE)| mfr | year | bdy_style | mpg_h | hp |
|---|---|---|---|---|
| Ford$ | 2017% | coupe | 21.5% | 647°F |
| Ferrari$ | 2015% | coupe | 22.4% | 597°F |
| Ferrari$ | 2015% | convertible | 22.2% | 562°F |
| Ferrari$ | 2014% | coupe | 21.5% | 562°F |
| Ferrari$ | 2016% | coupe | 22.4% | 661°F |
| Ferrari$ | 2015% | convertible | 20.9% | 553°F |
49.2.2 pad_fn
可以用于快速对齐有小数点的数字。
data.frame(x = c(1.2345, 12.345, 123.45, 1234.5, 12345)) %>%
gt() %>%
# 4位小数，不够的用0填充
fmt(fns = function(x){pad_fn(x, nsmall = 4, pad0 = T)}) %>%
tab_style(
# 设置字体
style = cell_text(font = google_font("Fira Mono")),
locations = cells_body(columns = x)
)| x |
|---|
| 1.2345 |
| 12.3450 |
| 123.4500 |
| 1234.5000 |
| 12345.0000 |
49.2.3 主题
提供了多套主题
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 |
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 |
head(mtcars) %>%
gt() %>%
gt_theme_nytimes() %>%
tab_header(title = "Table styled like the NY Times")| Table styled like the NY Times | ||||||||||
| 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 |
49.2.4 给特定行或列上色
gt_hulk_col_numerical()，数值从小到大，颜色渐变为从紫色到绿色。
head(mtcars) %>%
gt::gt() %>%
gt_hulk_col_numeric(mpg) # 只给mpg这一列上色| 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 |
可以反转颜色：
head(mtcars) %>%
gt::gt() %>%
# 多列上色，并反转颜色
gt_hulk_col_numeric(mpg:disp, reverse = FALSE) | 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_color_rows()也是给列上色的，不知为啥要叫row。。。默认是红色渐变，支持其他主题的扩展！
mtcars %>%
head() %>%
gt() %>%
gt_color_rows(mpg:disp, palette = "ggsci::red_material")
## Warning: Domain not specified, defaulting to observed range within each
## specified column.| 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 |
还支持自定义颜色：
mtcars %>%
head() %>%
gt() %>%
gt_color_rows(
mpg:disp,
palette = c("white", "green") # 也可以用16进制颜色
)
## Warning: Domain not specified, defaulting to observed range within each
## specified column.| 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 |
离散型变量也支持使用颜色：
mtcars %>%
head() %>%
gt() %>%
gt_color_rows(
cyl,
pal_type = "discrete",
palette = "ggthemes::colorblind",
# 支持 c(4,6,8) 这种格式
domain = range(mtcars$cyl)
)| 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 |
49.2.5 高亮某些行
head(mtcars[,1:5]) %>%
tibble::rownames_to_column("car") %>%
gt() %>%
gt_highlight_rows(
rows = 5, # 哪一行
fill = "lightgrey", # 背景色
font_weight = "bold"
)| car | mpg | cyl | disp | hp | drat |
|---|---|---|---|---|---|
| Mazda RX4 | 21.0 | 6 | 160 | 110 | 3.90 |
| Mazda RX4 Wag | 21.0 | 6 | 160 | 110 | 3.90 |
| Datsun 710 | 22.8 | 4 | 108 | 93 | 3.85 |
| Hornet 4 Drive | 21.4 | 6 | 258 | 110 | 3.08 |
| Hornet Sportabout | 18.7 | 8 | 360 | 175 | 3.15 |
| Valiant | 18.1 | 6 | 225 | 105 | 2.76 |
49.3 支持各种行内图形
49.3.1 gt_sparkline
可以是折线图/面积图/直方图等。
mtcars %>%
dplyr::group_by(cyl) %>%
dplyr::summarize(mpg_data = list(mpg), .groups = "drop") %>%
gt() %>%
gt_plt_sparkline(mpg_data)| cyl | mpg_data |
|---|---|
| 4 | |
| 6 | |
| 8 |
通过更改参数，可以变成面积图或者直方图：
mtcars %>%
dplyr::group_by(cyl) %>%
dplyr::summarize(mpg_data = list(mpg), .groups = "drop") %>%
gt() %>%
gt_plt_sparkline(mpg_data,type = "shaded")| cyl | mpg_data |
|---|---|
| 4 | |
| 6 | |
| 8 |
mtcars %>%
dplyr::group_by(cyl) %>%
dplyr::summarise(mpg_data=list(mpg),.groups = "drop") %>%
gt() %>%
gt_plt_sparkline(mpg_data,type = "ref_mean")| cyl | mpg_data |
|---|---|
| 4 | |
| 6 | |
| 8 |
49.3.2 密度图
mtcars %>%
dplyr::group_by(cyl) %>%
dplyr::summarise(mpg_data=list(mpg),.groups = "drop") %>%
gt() %>%
gt_plt_dist(mpg_data,type = "density", line_color = "blue",
fill_color = "red")| cyl | mpg_data |
|---|---|
| 4 | |
| 6 | |
| 8 |
mtcars %>%
dplyr::group_by(cyl) %>%
dplyr::summarise(mpg_data=list(mpg),.groups = "drop") %>%
gt() %>%
gt_plt_dist(mpg_data,type = "histogram", line_color = "blue",
fill_color = "red")| cyl | mpg_data |
|---|---|
| 4 | |
| 6 | |
| 8 |
49.3.3 条形图
mtcars %>%
dplyr::select(cyl:wt,mpg) %>%
head() %>%
gt() %>%
gt_plt_bar(column = mpg,
keep_column = T,
width = 35, # 条形宽度
color = "firebrick", # 条形颜色
scale_type = "number", # 添加标签
text_color = "white" # 标签颜色
)| cyl | disp | hp | drat | wt | mpg | mpg |
|---|---|---|---|---|---|---|
| 6 | 160 | 110 | 3.90 | 2.620 | 21.0 | |
| 6 | 160 | 110 | 3.90 | 2.875 | 21.0 | |
| 4 | 108 | 93 | 3.85 | 2.320 | 22.8 | |
| 6 | 258 | 110 | 3.08 | 3.215 | 21.4 | |
| 8 | 360 | 175 | 3.15 | 3.440 | 18.7 | |
| 6 | 225 | 105 | 2.76 | 3.460 | 18.1 |
49.3.4 百分比条形图
先计算好比例再通过gt_plt_bar_pct()函数画图：
mtcars %>%
head() %>%
dplyr::select(cyl, mpg) %>%
dplyr::mutate(mpg_pct_max = round(mpg/max(mpg) * 100, digits = 2),
mpg_scaled = mpg/max(mpg) * 100) %>%
dplyr::mutate(mpg_unscaled = mpg) %>%
gt() %>%
gt_plt_bar_pct(column = mpg_scaled, scaled = TRUE) %>%
gt_plt_bar_pct(column = mpg_unscaled, scaled = FALSE, fill = "blue",
background = "lightblue") %>%
cols_align("center", contains("scale")) %>%
cols_width(4 ~ px(125),
5 ~ px(125))| cyl | mpg | mpg_pct_max | mpg_scaled | mpg_unscaled |
|---|---|---|---|---|
| 6 | 21.0 | 92.11 | ||
| 6 | 21.0 | 92.11 | ||
| 4 | 22.8 | 100.00 | ||
| 6 | 21.4 | 93.86 | ||
| 8 | 18.7 | 82.02 | ||
| 6 | 18.1 | 79.39 |
49.3.5 堆积条形图
首先要自己把比例算好，这个百分比需要由多列组成。然后使用gt_plt_bar_stack()函数画出百分比堆积条形图。
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
ex_df <- dplyr::tibble(
x = c("Example 1","Example 1",
"Example 1","Example 2","Example 2","Example 2",
"Example 3","Example 3","Example 3","Example 4","Example 4",
"Example 4"),
measure = c("Measure 1","Measure 2",
"Measure 3","Measure 1","Measure 2","Measure 3",
"Measure 1","Measure 2","Measure 3","Measure 1","Measure 2",
"Measure 3"),
data = c(30, 20, 50, 30, 30, 40, 30, 40, 30, 30, 50, 20)
)
tab_df <- ex_df %>%
group_by(x) %>%
summarise(list_data = list(data))
tab_df
## # A tibble: 4 × 2
## x list_data
## <chr> <list>
## 1 Example 1 <dbl [3]>
## 2 Example 2 <dbl [3]>
## 3 Example 3 <dbl [3]>
## 4 Example 4 <dbl [3]>
tab_df %>%
gt() %>%
gt_plt_bar_stack(column = list_data)| x | Group 1||Group 2||Group 3 |
|---|---|
| Example 1 | |
| Example 2 | |
| Example 3 | |
| Example 4 |
49.3.6 win/loss plot
这个图形在体育领域用的比较多，暂时没想到在医学领域有什么用。。。
create_input_df <- function(repeats = 3){
input_df <- dplyr::tibble(
team = c("A1", "B2", "C3", "C4"),
Wins = c(3, 2, 1, 1),
Losses = c(2, 3, 2, 4),
Ties = c(0, 0, 2, 0),
outcomes = list(
c(1, .5, 0) %>% rep(each = repeats),
c(0, 1, 0.5) %>% rep(each = repeats),
c(0, 0.5, 1) %>% rep(each = repeats),
c(0.5, 1, 0) %>% rep(each = repeats)
)
)
input_df
}
create_input_df(5) %>%
dplyr::glimpse()
## Rows: 4
## Columns: 5
## $ team <chr> "A1", "B2", "C3", "C4"
## $ Wins <dbl> 3, 2, 1, 1
## $ Losses <dbl> 2, 3, 2, 4
## $ Ties <dbl> 0, 0, 2, 0
## $ outcomes <list> <1.0, 1.0, 1.0, 1.0, 1.0, 0.5, 0.5, 0.5, 0.5, 0.5, 0.0, 0.0, …
create_input_df(1) %>%
gt() %>%
gt_plt_winloss(outcomes, max_wins = 15) %>%
tab_options(data_row.padding = px(2))| team | Wins | Losses | Ties | outcomes |
|---|---|---|---|---|
| A1 | 3 | 2 | 0 | |
| B2 | 2 | 3 | 0 | |
| C3 | 1 | 2 | 2 | |
| C4 | 1 | 4 | 0 |
49.3.7 bullet chart
可以在条形图的基础上添加均值标记、中位数标记等。
library(dplyr)
mtcars %>%
select(mpg:drat) %>%
group_by(cyl) %>%
mutate(target_col = mean(mpg)) %>%
ungroup() %>%
gt() %>%
gt_plt_bullet(column = mpg, target = target_col,
width = 50
)| mpg | cyl | disp | hp | drat |
|---|---|---|---|---|
| 6 | 160.0 | 110 | 3.90 | |
| 6 | 160.0 | 110 | 3.90 | |
| 4 | 108.0 | 93 | 3.85 | |
| 6 | 258.0 | 110 | 3.08 | |
| 8 | 360.0 | 175 | 3.15 | |
| 6 | 225.0 | 105 | 2.76 | |
| 8 | 360.0 | 245 | 3.21 | |
| 4 | 146.7 | 62 | 3.69 | |
| 4 | 140.8 | 95 | 3.92 | |
| 6 | 167.6 | 123 | 3.92 | |
| 6 | 167.6 | 123 | 3.92 | |
| 8 | 275.8 | 180 | 3.07 | |
| 8 | 275.8 | 180 | 3.07 | |
| 8 | 275.8 | 180 | 3.07 | |
| 8 | 472.0 | 205 | 2.93 | |
| 8 | 460.0 | 215 | 3.00 | |
| 8 | 440.0 | 230 | 3.23 | |
| 4 | 78.7 | 66 | 4.08 | |
| 4 | 75.7 | 52 | 4.93 | |
| 4 | 71.1 | 65 | 4.22 | |
| 4 | 120.1 | 97 | 3.70 | |
| 8 | 318.0 | 150 | 2.76 | |
| 8 | 304.0 | 150 | 3.15 | |
| 8 | 350.0 | 245 | 3.73 | |
| 8 | 400.0 | 175 | 3.08 | |
| 4 | 79.0 | 66 | 4.08 | |
| 4 | 120.3 | 91 | 4.43 | |
| 4 | 95.1 | 113 | 3.77 | |
| 8 | 351.0 | 264 | 4.22 | |
| 6 | 145.0 | 175 | 3.62 | |
| 8 | 301.0 | 335 | 3.54 | |
| 4 | 121.0 | 109 | 4.11 |