前面用2篇文章詳細介紹了gt包創(chuàng)建表格的用法,。gt很強大,，但是還是不夠強大,，總有些大佬想要更加強大，于是就有了今天要介紹的gtExtras,，這是一個擴展包,，為gt提供多種強大的可視化功能！

目前gtExtras包還處于快速開發(fā)中,，大家需要及時更新,。

• 安裝

• 使用

• fmt_symbol_first

• pad_fn

• 主題

• 給特定行或列上色

• 高亮某些行

• gt_merge_stack

• 支持各種行內(nèi)圖形！

• gt_sparkline

• 條形圖

• 百分比條形圖

• 百分比堆積條形圖

• win/loss plot

安裝

目前只能通過github安裝,。

# if needed install.packages("remotes")
remotes::install_github("jthomasmock/gtExtras")

使用

fmt_symbol_first

gt中提供了非常好用的格式化功能,，而這個函數(shù)可以只格式化一列的第一行，包括添加各種符號等,，然后在其余行的最后添加空格,，達到對齊的效果。

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

可以用于快速對齊有小數(shù)點的數(shù)字,。

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(),，數(shù)值從小到大，顏色漸變?yōu)閺淖仙骄G色,。

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列內(nèi)容放在第2列的內(nèi)容上面。

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)

支持各種行內(nèi)圖形,！

gt_sparkline

可以是折線圖/面積圖/直方圖等,。畫圖的數(shù)據(jù)需要是list格式。

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

通過更改參數(shù),，可以變成面積圖或者直方圖：

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()函數(shù)畫圖：

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()函數(shù)畫出百分比堆積條形圖。

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

這個圖形在體育領域用的比較多,，暫時沒想到在醫(yī)學領域有什么用,。。,。

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