其他
使用gtExtra美化表格
Try to learn everything about something!
前面用2篇文章详细介绍了gt包创建表格的用法。gt很强大，但是还是不够强大，总有些大佬想要更加强大，于是就有了今天要介绍的gtExtras，这是一个扩展包，为gt提供多种强大的可视化功能！
目前gtExtras包还处于快速开发中，大家需要及时更新。
安装
使用
fmt_symbol_first
pad_fn
主题
给特定行或列上色
高亮某些行
gt_merge_stack
支持各种行内图形！
gt_sparkline
条形图
百分比条形图
百分比堆积条形图
win/loss plot
安装
目前只能通过github安装。
# if needed install.packages("remotes")
remotes::install_github("jthomasmock/gtExtras")
使用
fmt_symbol_first
gt中提供了非常好用的格式化功能，而这个函数可以只格式化一列的第一行，包括添加各种符号等，然后在其余行的最后添加空格，达到对齐的效果。
library(gtExtras)
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)
pad_fn
可以用于快速对齐有小数点的数字。
data.frame(x = c(1.2345, 12.345, 123.45, 1234.5, 12345)) %>%
gt() %>%
fmt(fns = function(x){pad_fn(x, nsmall = 4)}) %>%
tab_style(
# MUST USE A MONO-SPACED FONT
style = cell_text(font = google_font("Fira Mono")),
locations = cells_body(columns = x)
)
主题
提供了多套主题
head(mtcars) %>%
gt() %>%
gt_theme_538()
head(mtcars) %>%
gt() %>%
gt_theme_espn()
head(mtcars) %>%
gt() %>%
gt_theme_nytimes() %>%
tab_header(title = "Table styled like the NY Times")
给特定行或列上色
gt_hulk_col_numerical()，数值从小到大，颜色渐变为从紫色到绿色。
head(mtcars) %>%
gt::gt() %>%
gt_hulk_col_numeric(mpg)
可以反转颜色：
head(mtcars) %>%
gt::gt() %>%
gt_hulk_col_numeric(mpg:disp, reverse = FALSE)
gt_color_rows()也是给列上色的，不知为啥要叫row。。。默认是红色渐变，支持其他主题的扩展！
mtcars %>%
head() %>%
gt() %>%
gt_color_rows(mpg:disp, palette = "ggsci::blue_material")
还支持自定义颜色：
mtcars %>%
head() %>%
gt() %>%
gt_color_rows(
mpg:disp, palette = c("white", "green"), # 也可以用16进制颜色
use_paletteer = FALSE)
离散型变量也支持使用颜色：
mtcars %>%
head() %>%
gt() %>%
gt_color_rows(
cyl, type = "discrete",
palette = "ggthemes::colorblind",
# 支持 c(4,6,8) 这种格式
domain = range(mtcars$cyl)
)
高亮某些行
head(mtcars[,1:5]) %>%
tibble::rownames_to_column("car") %>%
gt() %>%
gt_highlight_rows(
rows = 5, # 哪一行
fill = "lightgrey", # 背景色
font_weight = "bold"
#bold_target_only = TRUE, # 只加粗指定位置
#target_col = car # 加粗car这一列
)
gt_merge_stack
merge第1列和第2列，把第1列内容放在第2列的内容上面。
team_df <- readRDS("../000files/teams_colors_logos.rds")
team_df %>%
dplyr::select(team_nick, team_abbr, team_conf, team_division) %>%
head(8) %>%
gt(groupname_col = "team_conf") %>%
gt_merge_stack(col1 = team_nick, col2 = team_division)
支持各种行内图形！
gt_sparkline
可以是折线图/面积图/直方图等。画图的数据需要是list格式。
mtcars %>%
dplyr::group_by(cyl) %>%
dplyr::summarize(mpg_data = list(mpg), .groups = "drop") %>%
gt() %>%
gt_sparkline(mpg_data)
通过更改参数，可以变成面积图或者直方图：
mtcars %>%
dplyr::group_by(cyl) %>%
dplyr::summarize(mpg_data = list(mpg), .groups = "drop") %>%
gt() %>%
gt_sparkline(mpg_data,type = "density", line_color = "black",fill_color = "skyblue")
mtcars %>%
dplyr::group_by(cyl) %>%
dplyr::summarise(mpg_data=list(mpg),.groups = "drop") %>%
gt() %>%
gt_sparkline(mpg_data,type = "histogram",line_color = "black",fill_color = "steelblue")
条形图
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" # 标签颜色
)
百分比条形图
先计算好比例再通过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))
百分比堆积条形图
首先要自己把比例算好，这个百分比需要由多列组成。然后使用gt_plt_bar_stack()函数画出百分比堆积条形图。
library(dplyr)
##
## 载入程辑包：'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 x 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)
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))
以上就是今天的内容，希望对你有帮助哦！欢迎点赞、在看、关注、转发！
欢迎在评论区留言或直接添加我的微信！
欢迎关注公众号：医学和生信笔记
“医学和生信笔记 公众号主要分享：1.医学小知识、肛肠科小知识；2.R语言和Python相关的数据分析、可视化、机器学习等；3.生物信息学学习资料和自己的学习笔记！
往期回顾
简单的韦恩图画法
ggplot2版本的韦恩图画法
韦恩图进阶！upset plot 01
韦恩图进阶！upset plot 02
韦恩图进阶！upset plot 03