20180626-A · Alcohol Consumption · knitr kable gridExtra + grid.arrange 表格 gtable · R 语言数据可视化 案例 源码

所有作品合集传送门: Tidy Tuesday

2018 年合集传送门: 2018

Alcohol Consumption


欢迎来到ggplot2的世界!

ggplot2是一个用来绘制统计图形的 R 软件包。它可以绘制出很多精美的图形,同时能避免诸多的繁琐细节,例如添加图例等。

用 ggplot2 绘制图形时,图形的每个部分可以依次进行构建,之后还可以进行编辑。ggplot2 精心挑选了一系列的预设图形,因此在大部分情形下可以快速地绘制出许多高质量的图形。如果在格式上还有额外的需求,也可以利用 ggplot2 中的主题系统来进行定制, 无需花费太多时间来调整图形的外观,而可以更加专注地用图形来展现你的数据。


在这里插入图片描述
在这里插入图片描述



1. 一些环境设置

# 设置为国内镜像, 方便快速安装模块
options("repos" = c(CRAN = "https://mirrors.tuna.tsinghua.edu.cn/CRAN/"))

2. 设置工作路径

wkdir <- '/home/user/R_workdir/TidyTuesday/2018/2018-06-26_Alcohol_Consumption/src-a'
setwd(wkdir)

3. 加载 R 包

library(grid)
library(RCurl)
library(ggplot2)
library(gtable)
library(tidyverse)
library(gridExtra)
library(kableExtra)

4. 加载数据

df_input <- readr::read_csv("../data/week13_alcohol_global.csv", show_col_types = FALSE)

# 简要查看数据内容
glimpse(df_input)
## Rows: 193
## Columns: 5
## $ country                      <chr> "Afghanistan", "Albania", "Algeria", "And…
## $ beer_servings                <dbl> 0, 89, 25, 245, 217, 102, 193, 21, 261, 2…
## $ spirit_servings              <dbl> 0, 132, 0, 138, 57, 128, 25, 179, 72, 75,…
## $ wine_servings                <dbl> 0, 54, 14, 312, 45, 45, 221, 11, 212, 191…
## $ total_litres_of_pure_alcohol <dbl> 0.0, 4.9, 0.7, 12.4, 5.9, 4.9, 8.3, 3.8, …
# 检查数据的列名
colnames(df_input)
## [1] "country"                      "beer_servings"               
## [3] "spirit_servings"              "wine_servings"               
## [5] "total_litres_of_pure_alcohol"

5. knitr::kable 实现结构化展示数据

# 第一种方法获取前十的数据
# 自定义函数, 获取前十的数据
top10 <- function(df, col){
  # enquo() 让函数自动引用参数
  quo_col <- dplyr::enquo(col)
  df %>% 
  # select() 选择需要使用的列
  select(country, !!quo_col) %>% 
  # arrange() 根据 change 列进行排序, 默认是升序; arrange + desc() 表示改为降序排列
  arrange(desc(!!quo_col)) %>% 
  # top_n() 表示选择前多少个观测
  top_n(10) %>% 
  # rename() 列重命名
  rename(servings = !!quo_col)
}

beer <- top10(df_input, beer_servings)
spirit <- top10(df_input, spirit_servings)
wine <- top10(df_input, wine_servings)
alcohol <- bind_cols(beer, spirit, wine) %>% as.data.frame()

rownames(alcohol) <- paste0(" ", 1:10)

# knitr::kable 实现结构化展示数据
alcohol %>% 
  knitr::kable(format = "html", 
               caption = "2010年人均消费量排名前10的国家或地区",
               col.names = c("", "啤酒", "", "汽水", "", "葡萄酒")) %>% 
  # 指定一些列进行特殊操作
  kableExtra::column_spec(3, background = "#F0E68C", bold = TRUE) %>% 
  kableExtra::column_spec(5, background = "#F0E68C", bold = TRUE) %>% 
  kableExtra::column_spec(7, background = "#F0E68C", bold = TRUE) %>% 
  kableExtra::kable_styling(latex_options = c("striped", "hold_position"), 
                full_width = FALSE, 
                position = "left") %>% 
  # 添加脚注信息
  kableExtra::footnote(c("资料来源: FiveThirtyEight.com/World Health Organisation - graph by 数绘小站 - 2022-10-20"))

在这里插入图片描述

6. gridExtra + grid.arrange 实现结构化展示数据

# 第二种方法获取前十的数据
df_beer <- arrange(df_input, desc(beer_servings)) %>% select(country,beer_servings) %>% slice(1:10)
df_spirit <- arrange(df_input, desc(spirit_servings)) %>% select(country,spirit_servings) %>% slice(1:10)
df_wine <- arrange(df_input, desc(wine_servings)) %>% select(country,wine_servings)%>% slice(1:10)


# gridExtra::ttheme_default() 设置文本表格主题, 创建包含表示文本的矩阵
tt5 <- gridExtra::ttheme_default(
  core =list(bg_params =list(fill = c('#808080')), fg_params = list(fontface = 2.8)),
  colhead = list(fg_params = list(col = '#000000', fontface = 3.5), bg_params = list(fill = NA)),
  rowhead = list(fg_params = list(col = '#000000', fontface = 2.8)))

# gridExtra::tableGrob() 表头处理
tw <- tableGrob(df_wine, cols = c('', '葡萄酒'),rows = c('', '', '', '', '', '', '', '', '', ''), theme = tt5)
# gridExtra::gtable_add_grob() 将某一个对象添加到指定 gtable 的位置中
tww <- gtable_add_grob(tw, grobs = segmentsGrob(x0 = unit(0, "npc"), y0 = unit(0, "npc"),
                                                x1 = unit(1, "npc"), y1 = unit(0, "npc"),
                                                gp = gpar(lwd = 3.78)),
                       t = 1, 
                       b = 1,
                       l = 2,
                       r = 3)

tb <- tableGrob(df_beer, cols = c('', '啤酒'),  theme = tt5)
tbb <- gtable_add_grob(tb, grobs = segmentsGrob(x0 = unit(0, "npc"), y0 = unit(0, "npc"),
                                                x1 = unit(1, "npc"), y1 = unit(0, "npc"),
                                                gp = gpar(lwd = 3.78)),
                      t = 1,
                      b = 1, 
                      l = 2,
                      r = 3)

ts <- tableGrob(df_spirit, cols = c('', '汽水'), rows =  c('', '', '', '', '', '', '', '', '', ''), theme = tt5)
tss <- gtable_add_grob(ts, grobs = segmentsGrob(x0 = unit(0, "npc"), y0 = unit(0, "npc"),
                                                x1 = unit(1, "npc"), y1 = unit(0, "npc"),
                                                gp = gpar(lwd = 3.78)),
                       t = 1,
                       b = 1,
                       l = 2, 
                       r = 3)

# gridExtra::gtable_combine() 对齐表格
table.aligned <- gtable_combine(tbb, tss, tww, along = 1)

# grid::grid.newpage() 创建一个全新的空白页面
grid.newpage()
grid.arrange(table.aligned, nrow = 1, ncol=1,
             top = textGrob('2010年人均消费量排名前10的国家或地区', gp = gpar(fontface = "bold", fontsize = 16.2)),
             bottom = textGrob('资料来源: FiveThirtyEight.com/World Health Organisation - graph by 数绘小站 - 2022-10-20',
               gp = gpar(fontface = 3.2, fontsize = 8.9),
               just = 'right', x = 0.75))

在这里插入图片描述

7. session-info

sessionInfo()
## R version 4.2.1 (2022-06-23)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 20.04.5 LTS
## 
## Matrix products: default
## BLAS:   /usr/lib/x86_64-linux-gnu/openblas-pthread/libblas.so.3
## LAPACK: /usr/lib/x86_64-linux-gnu/openblas-pthread/liblapack.so.3
## 
## locale:
##  [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
##  [3] LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8    
##  [5] LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8   
##  [7] LC_PAPER=en_US.UTF-8       LC_NAME=C                 
##  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
## [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       
## 
## attached base packages:
## [1] grid      stats     graphics  grDevices utils     datasets  methods  
## [8] base     
## 
## other attached packages:
##  [1] kableExtra_1.3.4 gridExtra_2.3    forcats_0.5.2    stringr_1.4.1   
##  [5] dplyr_1.0.10     purrr_0.3.4      readr_2.1.2      tidyr_1.2.1     
##  [9] tibble_3.1.8     tidyverse_1.3.2  gtable_0.3.1     ggplot2_3.3.6   
## [13] RCurl_1.98-1.8  
## 
## loaded via a namespace (and not attached):
##  [1] svglite_2.1.0       lubridate_1.8.0     assertthat_0.2.1   
##  [4] digest_0.6.30       utf8_1.2.2          R6_2.5.1           
##  [7] cellranger_1.1.0    backports_1.4.1     reprex_2.0.2       
## [10] evaluate_0.16       highr_0.9           httr_1.4.4         
## [13] pillar_1.8.1        rlang_1.0.6         googlesheets4_1.0.1
## [16] readxl_1.4.1        rstudioapi_0.14     jquerylib_0.1.4    
## [19] rmarkdown_2.16      webshot_0.5.4       googledrive_2.0.0  
## [22] bit_4.0.4           munsell_0.5.0       broom_1.0.1        
## [25] compiler_4.2.1      modelr_0.1.9        xfun_0.32          
## [28] systemfonts_1.0.4   pkgconfig_2.0.3     htmltools_0.5.3    
## [31] tidyselect_1.1.2    viridisLite_0.4.1   fansi_1.0.3        
## [34] crayon_1.5.2        tzdb_0.3.0          dbplyr_2.2.1       
## [37] withr_2.5.0         bitops_1.0-7        jsonlite_1.8.2     
## [40] lifecycle_1.0.3     DBI_1.1.3           magrittr_2.0.3     
## [43] scales_1.2.1        vroom_1.5.7         cli_3.4.1          
## [46] stringi_1.7.8       cachem_1.0.6        fs_1.5.2           
## [49] xml2_1.3.3          bslib_0.4.0         ellipsis_0.3.2     
## [52] generics_0.1.3      vctrs_0.4.2         tools_4.2.1        
## [55] bit64_4.0.5         glue_1.6.2          hms_1.1.2          
## [58] parallel_4.2.1      fastmap_1.1.0       yaml_2.3.5         
## [61] colorspace_2.0-3    gargle_1.2.1        rvest_1.0.3        
## [64] knitr_1.40          haven_2.5.1         sass_0.4.2

测试数据

配套数据下载:Alcohol Consumption

  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值