所有作品合集传送门： Tidy Tuesday
2018 年合集传送门： 2018
Craft Beer USA
欢迎来到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-07-10_Craft_Beer_USA/src-a'
setwd(wkdir)
3. 加载 R 包
library(ggridges)
library(viridis)
library(forcats)
library(tidyverse)
# 导入字体设置包
library(showtext)
# font_add_google() showtext 中从谷歌字体下载并导入字体的函数
# name 中的是字体名称, 用于检索, 必须严格对应想要字体的名字
# family 后面的是代码后面引用时的名称, 自己随便起
# 需要能访问 Google, 也可以注释掉下面这行, 影响不大
# font_families_google() 列出所有支持的字体, 支持的汉字不多
# http://www.googlefonts.net/
font_add_google(name = "Karantina", family = "ka")
font_add_google(name = "Cutive", family = "albert")
font_add_google(name = "ZCOOL XiaoWei", family = "zxw")
# 后面字体均可以使用导入的字体
showtext_auto()
4. 加载数据
excel.file <- "../data/week15_beers.xlsx"
# readxl::excel_sheets() 查看 Excel 中的 sheet 名称
readxl::excel_sheets(excel.file)
## [1] "beers" "breweries"
df_beer <- readxl::read_xlsx(excel.file, sheet = 'beers')
df_brewer <- readxl::read_xlsx(excel.file, sheet = 'breweries')
# 简要查看数据内容
glimpse(df_beer)
## Rows: 2,410
## Columns: 8
## $ count <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, …
## $ abv <dbl> 0.050, 0.066, 0.071, 0.090, 0.075, 0.077, 0.045, 0.065, 0.0…
## $ ibu <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 60,…
## $ id <dbl> 1436, 2265, 2264, 2263, 2262, 2261, 2260, 2259, 2258, 2131,…
## $ name <chr> "Pub Beer", "Devil's Cup", "Rise of the Phoenix", "Sinister…
## $ style <chr> "American Pale Lager", "American Pale Ale (APA)", "American…
## $ brewery_id <dbl> 408, 177, 177, 177, 177, 177, 177, 177, 177, 177, 177, 177,…
## $ ounces <dbl> 12.0, 12.0, 12.0, 12.0, 12.0, 12.0, 12.0, 12.0, 12.0, 12.0,…
# 检查数据的列名
colnames(df_beer)
## [1] "count" "abv" "ibu" "id" "name"
## [6] "style" "brewery_id" "ounces"
5. 数据预处理
# left_join() 左连接, 合并两个数据框
df_tiny <- left_join(df_beer, df_brewer, by = c("brewery_id" = "id")) %>%
# mutate() 主要用于在数据框中添加新的变量, 这些变量是通过对现有的变量进行操作而形成的
mutate(abv = abv * 100)
# 计数并取前五
beer_top_5 <- df_tiny %>% count(style) %>% arrange(desc(n)) %>% top_n(5)
# tidyr::crossing() 将其中的数据进行成对组合成数据框，但是要对数据进行排序和去重
st_beer5 <- crossing(distinct(df_tiny, state), beer_top_5)
df_plot <- df_tiny %>%
# group_by() 以指定的列进行分组
group_by(state, style) %>%
# summarize() 用于对数据进行统计描述
summarize(count = n()) %>%
# right_join() 右连接, 合并两个数据框
right_join(st_beer5) %>%
# arrange() 根据 change 列进行排序, 默认是升序; arrange + desc() 表示改为降序排列
arrange(state, desc(count)) %>%
# slice() 通过行号选取数据
slice(1:5) %>%
mutate(style = case_when(style == "American Double / Imperial IPA" ~ "A D/I IPA",
style == "American Blonde Ale" ~ "ABA",
style == "American Amber / Red Ale" ~ "A A/R A",
style == "American Pale Ale (APA)" ~ "APA",
style == "American IPA" ~ "A IPA")) %>%
{.}
# 简要查看数据内容
glimpse(df_plot)
## Rows: 255
## Columns: 4
## Groups: state [51]
## $ state <chr> "AK", "AK", "AK", "AK", "AK", "AL", "AL", "AL", "AL", "AL", "AR"…
## $ style <chr> "A IPA", "ABA", "A A/R A", "APA", "A D/I IPA", "A IPA", "APA", "…
## $ count <int> 7, 3, 2, 2, NA, 2, 2, 1, NA, NA, 1, 1, NA, NA, NA, 9, 6, 4, 2, 1…
## $ n <int> 424, 108, 133, 245, 105, 424, 245, 105, 133, 108, 133, 245, 108,…
6. 利用 ggplot2 绘图
# PS: 方便讲解, 我这里进行了拆解, 具体使用时可以组合在一起
gg <- df_tiny %>% filter(style %in% beer_top_5$style) %>% ggplot(aes(x = abv, y = fct_rev(style), fill = ..x..))
# ggridges::geom_density_ridges_gradient() 绘制核密度估计峰峦图
gg <- gg + ggridges::geom_density_ridges_gradient(scale = 2, rel_min_height = 0.01)
# scale_fill_viridis() 使用 Viridis 调色, option 可选值: magma, inferno, plasma, viridis, cividis, rocket, mako, turbo
gg <- gg + scale_fill_viridis(name = "ABV", option = "inferno",
limits = c(2, 10),
breaks = c(2, 4, 6, 8, 10),
labels = c(2, 4, 6, 8, 10))
# guides() 设置图例信息
gg <- gg + guides(fill = guide_legend(title = '酒精含量',
frame.color = "white",
ticks.colour = "red",
title.position = "top",
label.position = "bottom",
nrow = 1, byrow = TRUE))
# labs() 对图形添加注释和标签（包含标题 title、子标题 subtitle、坐标轴 x & y 和引用 caption 等注释)
gg <- gg + labs(title = "最受欢迎的 5 种啤酒类型的酒精含量（ABV）",
subtitle = NULL,
x = NULL,
y = NULL,
caption = "资料来源: Craft Beer USA · graph by 数绘小站 · 2022-10-21")
# theme_minimal() 去坐标轴边框的最小化主题
gg <- gg + theme_minimal()
# theme() 实现对非数据元素的调整, 对结果进行进一步渲染, 使之更加美观
gg <- gg + theme(
# panel.background 面板背景 数据下面
panel.background = element_rect(fill = '#F5DEB3', color = '#F5DEB3', size = 0),
# plot.background 图片背景
plot.background = element_rect(fill = '#F5DEB3', color = '#F5DEB3', size = 0),
# plot.margin 调整图像边距, 上-右-下-左
plot.margin = margin(12, 10, 2, 15),
# plot.title 主标题
plot.title = element_text(hjust = 0., color = "black", size = 24, face = "bold", family = 'zxw'),
# plot.caption 说明文字
plot.caption = element_text(hjust = 0.85, vjust = .2, size = 10, colour = 'red'),
# text 设置文本格式
text = element_text(size = 15, hjust = 0, face = "bold", colour = '#696969'),
# axis.text 坐标轴刻度文本
axis.text = element_text(size = 15, hjust = 0, face = "bold", colour = '#696969'),
# legend.direction 设置图例的方向, vertical 表示垂直摆放图例; horizontal 表示水平摆放图例
legend.direction = 'horizontal',
# legend.position 设置图例位置, 这里指定图例具体的摆放位置
legend.position = c(-0.16, 0.92))
7. 保存图片到 PDF 和 PNG
gg
filename = '20180710-B-01'
ggsave(filename = paste0(filename, ".pdf"), width = 10.2, height = 6.2, device = cairo_pdf)
ggsave(filename = paste0(filename, ".png"), width = 10.2, height = 6.2, dpi = 100, device = "png", bg = 'white')
8. 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] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] showtext_0.9-5 showtextdb_3.0 sysfonts_0.8.8 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 ggplot2_3.3.6 tidyverse_1.3.2 forcats_0.5.2
## [13] viridis_0.6.2 viridisLite_0.4.1 ggridges_0.5.4
##
## loaded via a namespace (and not attached):
## [1] lubridate_1.8.0 assertthat_0.2.1 digest_0.6.30
## [4] utf8_1.2.2 R6_2.5.1 cellranger_1.1.0
## [7] backports_1.4.1 reprex_2.0.2 evaluate_0.16
## [10] highr_0.9 httr_1.4.4 pillar_1.8.1
## [13] rlang_1.0.6 curl_4.3.3 googlesheets4_1.0.1
## [16] readxl_1.4.1 rstudioapi_0.14 jquerylib_0.1.4
## [19] rmarkdown_2.16 textshaping_0.3.6 labeling_0.4.2
## [22] googledrive_2.0.0 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 gridExtra_2.3 fansi_1.0.3
## [34] crayon_1.5.2 tzdb_0.3.0 dbplyr_2.2.1
## [37] withr_2.5.0 grid_4.2.1 jsonlite_1.8.2
## [40] gtable_0.3.1 lifecycle_1.0.3 DBI_1.1.3
## [43] magrittr_2.0.3 scales_1.2.1 cli_3.4.1
## [46] stringi_1.7.8 cachem_1.0.6 farver_2.1.1
## [49] fs_1.5.2 xml2_1.3.3 bslib_0.4.0
## [52] ragg_1.2.3 ellipsis_0.3.2 generics_0.1.3
## [55] vctrs_0.4.2 tools_4.2.1 glue_1.6.2
## [58] hms_1.1.2 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
测试数据
配套数据下载：Craft Beer USA
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
