使用gtExtra美化表格

关注公众号，发送R语言或Python，获取学习资料！

     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)

image-20220514202610638

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)
    )

image-20220514202639066

主题

提供了多套主题

head(mtcars) %>%
  gt() %>% 
  gt_theme_538()

image-20220514202800621

head(mtcars) %>%
  gt() %>% 
  gt_theme_espn()

image-20220514202830011

head(mtcars) %>% 
  gt() %>% 
  gt_theme_nytimes() %>% 
  tab_header(title = "Table styled like the NY Times")

image-20220514202910276

给特定行或列上色

gt_hulk_col_numerical()，数值从小到大，颜色渐变为从紫色到绿色。

head(mtcars) %>%
  gt::gt() %>%
  gt_hulk_col_numeric(mpg)

image-20220514202935558

可以反转颜色：

head(mtcars) %>%
  gt::gt() %>%
  gt_hulk_col_numeric(mpg:disp, reverse = FALSE) 

image-20220514203000134

gt_color_rows()也是给列上色的，不知为啥要叫row。。。默认是红色渐变，支持其他主题的扩展！

mtcars %>%
  head() %>%
  gt() %>%
  gt_color_rows(mpg:disp, palette = "ggsci::blue_material")

image-20220514203028550

还支持自定义颜色：

mtcars %>%
  head() %>%
  gt() %>%
  gt_color_rows(
    mpg:disp, palette = c("white", "green"), # 也可以用16进制颜色
    use_paletteer = FALSE)

image-20220514203114856

离散型变量也支持使用颜色：

mtcars %>%
  head() %>%
  gt() %>%
  gt_color_rows(
    cyl, type = "discrete",
    palette = "ggthemes::colorblind", 
    # 支持 c(4,6,8) 这种格式
    domain = range(mtcars$cyl)
   )

image-20220514203140315

高亮某些行

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这一列
    )

image-20220514203205470

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)

image-20220514203247476

支持各种行内图形！

gt_sparkline

可以是折线图/面积图/直方图等。画图的数据需要是list格式。

mtcars %>%
   dplyr::group_by(cyl) %>%
   dplyr::summarize(mpg_data = list(mpg), .groups = "drop") %>%
   gt() %>%
   gt_sparkline(mpg_data)

image-20220514203321375

通过更改参数，可以变成面积图或者直方图：

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")

image-20220514203407581

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")

image-20220514203453067

条形图

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" # 标签颜色
             )

image-20220514203525538

百分比条形图

先计算好比例再通过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))

image-20220514203554311

百分比堆积条形图

首先要自己把比例算好，这个百分比需要由多列组成。然后使用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)

image-20220514203622740

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))

image-20220514203709844

以上就是今天的内容，希望对你有帮助哦！欢迎点赞、在看、关注、转发！

欢迎在评论区留言或直接添加我的微信！

完

欢迎关注公众号：医学和生信笔记

“

医学和生信笔记 公众号主要分享：1.医学小知识、肛肠科小知识；2.R语言和Python相关的数据分析、可视化、机器学习等；3.生物信息学学习资料和自己的学习笔记！

往期回顾