所有作品合集传送门： Tidy Tuesday
2018 年合集传送门： 2018
Comic book characters
欢迎来到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-05-29_Comic_book_characters/src-a'
setwd(wkdir)
3. 加载 R 包
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. 加载数据
df_input <- readr::read_csv("../data/week9_comic_characters.csv", show_col_types = FALSE)
# 简要查看数据内容
glimpse(df_input)
## Rows: 23,272
## Columns: 17
## $ ...1 <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16…
## $ publisher <chr> "Marvel", "Marvel", "Marvel", "Marvel", "Marvel", "Ma…
## $ page_id <dbl> 1678, 7139, 64786, 1868, 2460, 2458, 2166, 1833, 2948…
## $ name <chr> "Spider-Man (Peter Parker)", "Captain America (Steven…
## $ urlslug <chr> "\\/Spider-Man_(Peter_Parker)", "\\/Captain_America_(…
## $ id <chr> "Secret Identity", "Public Identity", "Public Identit…
## $ align <chr> "Good Characters", "Good Characters", NA, "Good Chara…
## $ eye <chr> "Hazel Eyes", "Blue Eyes", "Blue Eyes", "Blue Eyes", …
## $ hair <chr> "Brown Hair", "White Hair", "Black Hair", "Black Hair…
## $ sex <chr> "Male Characters", "Male Characters", "Male Character…
## $ gsm <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…
## $ alive <chr> "Living Characters", "Living Characters", "Living Cha…
## $ appearances <dbl> 4043, 3360, 3061, 2961, 2258, 2255, 2072, 2017, 1955,…
## $ first_appearance <chr> "1962, August", "1941, March", "1974, October", "1963…
## $ month <chr> "August", "March", "October", "March", "November", "N…
## $ year <dbl> 1962, 1941, 1974, 1963, 1950, 1961, 1961, 1962, 1963,…
## $ date <date> 1962-08-01, 1941-03-01, 1974-10-01, 1963-03-01, 1950…
# 检查数据的列名
colnames(df_input)
## [1] "...1" "publisher" "page_id" "name"
## [5] "urlslug" "id" "align" "eye"
## [9] "hair" "sex" "gsm" "alive"
## [13] "appearances" "first_appearance" "month" "year"
## [17] "date"
5. 数据预处理
df_albert <- df_input %>%
# mutate() 主要用于在数据框中添加新的变量, 这些变量是通过对现有的变量进行操作而形成的
dplyr::mutate(sex = str_replace(sex, " Characters", ""),
align = str_replace(align, " Characters", ""),
align = if_else(is.na(align), "Neutral", align)) %>%
# filter() 根据条件过滤数据
dplyr::filter(align != "Reformed Criminals") %>%
dplyr::filter(sex %in% c("Female", "Male")) %>%
# group_by() 以指定的列进行分组
group_by(publisher, sex, align) %>%
# summarise() 用于对数据进行统计描述
dplyr::summarise(count = n()) %>%
group_by(publisher, sex) %>%
dplyr::mutate(total = sum(count),
ratio = count/total * 100,
align = fct_relevel(align, c("Bad", "Neutral", "Good"))) %>%
dplyr::filter(sex %in% c("Female", "Male")) %>%
# 取消分组信息
ungroup() %>%
# 手动设置标签
mutate(rlab0 = round(ratio),
rlab1 = if_else(publisher == "DC" & sex == "Female", paste0(rlab0, "%"), as.character(rlab0)),
r1 = if_else(align == "Good", rlab1, as.character(NA)),
r2 = if_else(align == "Neutral", rlab1, as.character(NA)),
r3 = if_else(align == "Bad", rlab1, as.character(NA)))
# 简要查看数据内容
glimpse(df_albert)
## Rows: 12
## Columns: 11
## $ publisher <chr> "DC", "DC", "DC", "DC", "DC", "DC", "Marvel", "Marvel", "Mar…
## $ sex <chr> "Female", "Female", "Female", "Male", "Male", "Male", "Femal…
## $ align <fct> Bad, Good, Neutral, Bad, Good, Neutral, Bad, Good, Neutral, …
## $ count <int> 597, 953, 416, 2223, 1843, 715, 976, 1537, 1324, 5338, 2966,…
## $ total <int> 1966, 1966, 1966, 4781, 4781, 4781, 3837, 3837, 3837, 11638,…
## $ ratio <dbl> 30.36623, 48.47406, 21.15972, 46.49655, 38.54842, 14.95503, …
## $ rlab0 <dbl> 30, 48, 21, 46, 39, 15, 25, 40, 35, 46, 25, 29
## $ rlab1 <chr> "30%", "48%", "21%", "46", "39", "15", "25", "40", "35", "46…
## $ r1 <chr> NA, "48%", NA, NA, "39", NA, NA, "40", NA, NA, "25", NA
## $ r2 <chr> NA, NA, "21%", NA, NA, "15", NA, NA, "35", NA, NA, "29"
## $ r3 <chr> "30%", NA, NA, "46", NA, NA, "25", NA, NA, "46", NA, NA
6. 利用 ggplot2 绘图
# PS: 方便讲解, 我这里进行了拆解, 具体使用时可以组合在一起
gg <- df_albert %>% ggplot(aes(x = fct_relevel(sex, c("Male", "Female")), y = ratio, fill = align))
# geom_bar() 绘制条形图, stat = "identity"，意味着条形的高度表示数据数据的值
gg <- gg + geom_bar(stat = "identity", width = 0.8, position = position_stack())
# geom_text() 添加文本信息
gg <- gg + geom_text(aes(y = 1, label = r1), color = "white", hjust = 0, family = 'ka', size = 16, na.rm = TRUE)
gg <- gg + geom_text(aes(label = r2), color = "white", position = position_stack(vjust = 0.5), family = 'ka', size = 16, na.rm = TRUE)
gg <- gg + geom_text(aes(y = 99, label = r3), color = "white", hjust = 1, family = 'ka', size = 16, na.rm = TRUE)
# scale_fill_manual() 采取的是手动赋值的方法, 也就是直接把颜色序列赋值给它的参数 value, 也可以根据 breaks, labels 设定图例标签顺序
gg <- gg + scale_fill_manual(values = c("#FC2A1B", "#F5C92A", "#78A934"),
breaks = c('Good', 'Neutral', 'Bad'),
labels = c(stringr::str_pad(c('Good', 'Neutral', 'Bad'), width = 8, side = 'both')))
# scale_x_discrete() 对离散的坐标轴更改范围、坐标轴标签等
gg <- gg + scale_x_discrete(labels = c("男性", "女性"))
# facet_wrap() 可视化分面图
gg <- gg + facet_wrap(. ~ publisher, ncol = 1)
# guides() 设置图例信息
gg <- gg + guides(fill = guide_legend(frame.color = "white", label.position = "bottom", keywidth = unit(0.2, "inches")))
# coord_flip() 横纵坐标位置转换
gg <- gg + coord_flip()
# labs() 对图形添加注释和标签（包含标题 title、子标题 subtitle、坐标轴 x & y 和引用 caption 等注释)
gg <- gg + labs(title = "DC和漫威中男性和女性角色分布情况",
subtitle = '不想写啥子标题了, 有需要的可以自行替换掉. R群：189059061',
x = NULL,
y = NULL,
caption = "资料来源: FiveThirtyEight.com · graph by 萤火之森 · 2022-10-16")
# theme_minimal() 去坐标轴边框的最小化主题
gg <- gg + theme_minimal()
# theme() 实现对非数据元素的调整, 对结果进行进一步渲染, 使之更加美观
gg <- gg + theme(
# panel.grid.major 主网格线, 这一步表示删除主要网格线
panel.grid.major = element_blank(),
# panel.grid.minor 次网格线, 这一步表示删除次要网格线
panel.grid.minor = element_blank(),
# panel.border 面板背景 数据上面
panel.border = element_blank(),
# panel.background 面板背景 数据下面
panel.background = element_rect(fill = '#808080', color = '#808080', size = 0),
# plot.background 图片背景
plot.background = element_rect(fill = '#808080', color = '#808080', size = 0),
# plot.margin 调整图像边距, 上-右-下-左
plot.margin = margin(12, 10, 2, 15),
# plot.title 主标题
plot.title = element_text(hjust = 0.3, color = "black", size = 20, face = "bold", family = 'zxw'),
# plot.subtitle 次要标题
plot.subtitle = element_text(hjust = 0.3, color = "black", size = 15, face = "bold"),
# plot.caption 说明文字
plot.caption = element_text(hjust = 0.85, vjust = 87, size = 10, color = '#FFFFFF'),
# strip.text.x 自定义分面图每个分面标题的文字
strip.text.x = element_text(size = 24, hjust = 0, face = "bold", family = 'albert', color = 'red'),
# text 设置文本格式
text = element_text(size = 18, hjust = 0, face = "bold", color = '#FFFFFF'),
# axis.text 坐标轴刻度文本
axis.text = element_text(size = 18, hjust = 0, face = "bold", color = '#FFFFFF'),
# legend.direction 设置图例的方向, horizontal 表示水平方向摆放
legend.direction = 'horizontal',
# legend.title 设置图例标题
legend.title = element_blank(),
# legend.position 设置图例位置, 这里用坐标来指定图例具体的摆放位置
legend.position = c(0.35, 0.48))
7. 保存图片到 PDF 和 PNG
gg
filename = '20180529-A-01'
ggsave(filename = paste0(filename, ".pdf"), width = 10.2, height = 5.5, device = cairo_pdf)
ggsave(filename = paste0(filename, ".png"), width = 10.2, height = 5.5, 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 forcats_0.5.2
## [5] stringr_1.4.1 dplyr_1.0.10 purrr_0.3.4 readr_2.1.2
## [9] tidyr_1.2.1 tibble_3.1.8 ggplot2_3.3.6 tidyverse_1.3.2
##
## loaded via a namespace (and not attached):
## [1] lubridate_1.8.0 assertthat_0.2.1 digest_0.6.29
## [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.2 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 bit_4.0.4 munsell_0.5.0
## [25] broom_1.0.1 compiler_4.2.1 modelr_0.1.9
## [28] xfun_0.32 systemfonts_1.0.4 pkgconfig_2.0.3
## [31] htmltools_0.5.3 tidyselect_1.1.2 fansi_1.0.3
## [34] crayon_1.5.1 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 vroom_1.5.7
## [46] cli_3.4.1 stringi_1.7.8 cachem_1.0.6
## [49] farver_2.1.1 fs_1.5.2 xml2_1.3.3
## [52] bslib_0.4.0 ragg_1.2.3 ellipsis_0.3.2
## [55] generics_0.1.3 vctrs_0.4.2 tools_4.2.1
## [58] bit64_4.0.5 glue_1.6.2 hms_1.1.2
## [61] parallel_4.2.1 fastmap_1.1.0 yaml_2.3.5
## [64] colorspace_2.0-3 gargle_1.2.1 rvest_1.0.3
## [67] knitr_1.40 haven_2.5.1 sass_0.4.2
测试数据
配套数据下载：Comic book characters
本文含有隐藏内容，请 开通VIP 后查看