所有作品合集传送门： Tidy Tuesday
2018 年合集传送门： 2018
Exercise 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-17_Exercise_USA/src-a'
setwd(wkdir)3. 加载 R 包
library(scico)
library(albersusa)
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/week16_exercise.xlsx"
# readxl::excel_sheets() 查看 Excel 中的 sheet 名称
readxl::excel_sheets(excel.file)
## [1] "source" "tidy"
# 读取指定的 sheet
df_input <- readxl::read_xlsx(excel.file, sheet = 'tidy') %>% mutate(exercise = as.numeric(exercise))
# 简要查看数据内容
glimpse(df_input)## Rows: 364
## Columns: 5
## $ count <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17,…
## $ state <chr> "state_average", "Alabama", "Alaska", "Arizona", "Arkansas…
## $ sex <chr> "both", "both", "both", "both", "both", "both", "both", "b…
## $ work_status <chr> "total", "total", "total", "total", "total", "total", "tot…
## $ exercise <dbl> 22, 19, 27, 26, 15, 24, 32, 24, 20, 30, 21, 20, 24, 31, 24…# 检查数据的列名
colnames(df_input)## [1] "count" "state" "sex" "work_status" "exercise"5. 数据预处理
# albersusa::usa_sf() 检索美国州地图, proj 可选值: "longlat", "laea", "lcc", "eqdc", "aeqd"
usmap <- albersusa::usa_sf(proj = "longlat") %>%
# mutate() 主要用于在数据框中添加新的变量, 这些变量是通过对现有的变量进行操作而形成的
mutate(st = iso_3166_2) %>%
# select() 选择需要使用的列
select(name, st, geometry)
# dplyr::inner_join() 内连接, 连接两个数据框
df_plot <- dplyr::inner_join(df_input, usmap, by = c("state" = "name")) %>%
mutate(work_status = case_when(work_status == 'total' ~ '两者都的',
work_status == 'working' ~ '工作的',
work_status == 'non_working' ~ '不工作的',
TRUE ~ '不清楚的')) %>%
mutate(sex = case_when(sex == 'male' ~ '男性',
sex == 'female' ~ '女性',
TRUE ~ '不清楚的'))
# 简要查看数据内容
glimpse(df_plot)## Rows: 357
## Columns: 7
## $ count <dbl> 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18…
## $ state <chr> "Alabama", "Alaska", "Arizona", "Arkansas", "California", …
## $ sex <chr> "不清楚的", "不清楚的", "不清楚的", "不清楚的", "不清楚的"…
## $ work_status <chr> "两者都的", "两者都的", "两者都的", "两者都的", "两者都的"…
## $ exercise <dbl> 19, 27, 26, 15, 24, 32, 24, 20, 30, 21, 20, 24, 31, 24, 15…
## $ st <fct> AL, AK, AZ, AR, CA, CO, CT, DE, DC, FL, GA, HI, ID, IL, IN…
## $ geometry <MULTIPOLYGON [°]> MULTIPOLYGON (((-88.12466 3..., MULTIPOLYGON …6. 利用 ggplot2 绘图
# PS: 方便讲解, 我这里进行了拆解, 具体使用时可以组合在一起
# 挑选用于绘图的数据, 并用 ggplot() 新建绘图画图
gg <- df_plot %>% filter(sex != "不清楚的") %>% ggplot()
# geom_sf() 绘制地图
gg <- gg + geom_sf(aes(fill = exercise, geometry = `geometry`))
# coord_sf() 用于地图的投影转换
gg <- gg + coord_sf(datum = NA)
# scico::scale_fill_scico() 针对连续型数据, 自定义图像的色彩梯度, scico::scico_palette_names() 可以查看所有支持的 palette 名称
gg <- gg + scale_fill_scico(palette = "vik", na.value = "#808080")
# facet_grid() 分面并且标签内容显示在顶部
gg <- gg + facet_grid(work_status ~ sex)
# labs() 对图形添加注释和标签（包含标题 title、子标题 subtitle、坐标轴 x & y 和引用 caption 等注释)
gg <- gg + labs(title = "18-64岁的成年人有氧运动和无氧运动",
subtitle = '不想取啥标题了, 有需要讨论绘图相关的内容可以进群',
x = NULL,
y = NULL,
caption = "资料来源: CDC - 国家卫生统计报告 · graph by 数绘小站 · 2022-10-22")
# 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(),
# 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 = .5, size = 10),
# strip.text.x 自定义分面图每个分面标题的文字
strip.text.x = element_text(size = 15, hjust = 0.5, face = "bold", family = 'zxw', color = 'red'),
# text 设置文本格式
text = element_text(size = 12, hjust = 0, face = "bold"),
# axis.text 坐标轴刻度文本
axis.text = element_text(size = 12, hjust = 0, face = "bold"),
# legend.direction 设置图例的方向, vertical 表示水平方向摆放
legend.direction = 'vertical',
# legend.title 设置图例标题
legend.title = element_blank(),
# legend.position 设置图例位置, 这里用坐标来指定图例具体的摆放位置
legend.position = 'left')7. 保存图片到 PDF 和 PNG
gg
filename = '20180717-A-01'
ggsave(filename = paste0(filename, ".pdf"), width = 8.2, height = 6.9, device = cairo_pdf)
ggsave(filename = paste0(filename, ".png"), width = 8.2, height = 6.9, 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
## [13] albersusa_0.4.1 scico_1.3.1
##
## loaded via a namespace (and not attached):
## [1] fs_1.5.2 sf_1.0-8 lubridate_1.8.0
## [4] httr_1.4.4 tools_4.2.1 backports_1.4.1
## [7] bslib_0.4.0 utf8_1.2.2 rgdal_1.5-32
## [10] R6_2.5.1 KernSmooth_2.23-20 rgeos_0.5-9
## [13] DBI_1.1.3 colorspace_2.0-3 withr_2.5.0
## [16] sp_1.5-0 tidyselect_1.1.2 curl_4.3.3
## [19] compiler_4.2.1 textshaping_0.3.6 cli_3.4.1
## [22] rvest_1.0.3 xml2_1.3.3 labeling_0.4.2
## [25] sass_0.4.2 scales_1.2.1 classInt_0.4-8
## [28] proxy_0.4-27 systemfonts_1.0.4 digest_0.6.30
## [31] foreign_0.8-82 rmarkdown_2.16 pkgconfig_2.0.3
## [34] htmltools_0.5.3 highr_0.9 dbplyr_2.2.1
## [37] fastmap_1.1.0 rlang_1.0.6 readxl_1.4.1
## [40] rstudioapi_0.14 jquerylib_0.1.4 generics_0.1.3
## [43] farver_2.1.1 jsonlite_1.8.2 googlesheets4_1.0.1
## [46] magrittr_2.0.3 s2_1.1.0 Rcpp_1.0.9
## [49] munsell_0.5.0 fansi_1.0.3 lifecycle_1.0.3
## [52] stringi_1.7.8 yaml_2.3.5 grid_4.2.1
## [55] maptools_1.1-4 crayon_1.5.2 lattice_0.20-45
## [58] haven_2.5.1 hms_1.1.2 knitr_1.40
## [61] pillar_1.8.1 wk_0.7.0 reprex_2.0.2
## [64] glue_1.6.2 evaluate_0.16 modelr_0.1.9
## [67] vctrs_0.4.2 tzdb_0.3.0 cellranger_1.1.0
## [70] gtable_0.3.1 assertthat_0.2.1 cachem_1.0.6
## [73] xfun_0.32 broom_1.0.1 e1071_1.7-11
## [76] ragg_1.2.3 class_7.3-20 googledrive_2.0.0
## [79] gargle_1.2.1 units_0.8-0 ellipsis_0.3.2
测试数据
配套数据下载：Exercise USA
本文章为转载内容，我们尊重原作者对文章享有的著作权。如有内容错误或侵权问题，欢迎原作者联系我们进行内容更正或删除文章。
