所有作品合集传送门: 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