所有作品合集传送门： Tidy Tuesday
2018 年合集传送门： 2018
Dallas Animal Shelter FY2017
欢迎来到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-31_Dallas_Animal_Shelter_FY2017/src-a'
setwd(wkdir)
3. 加载 R 包
library(ggrepel)
library(scales)
library(tidyverse)
# 导入字体设置包
library(showtext)
# font_add_google() showtext 中从谷歌字体下载并导入字体的函数
# name 中的是字体名称, 用于检索, 必须严格对应想要字体的名字
# family 后面的是代码后面引用时的名称, 自己随便起
# 需要能访问 Google, 也可以注释掉下面这行, 影响不大
# font_families_google() 列出所有支持的字体, 支持的汉字不多
# http://www.googlefonts.net/
font_add_google(name = "Cutive", family = "albert")
font_add_google(name = "Zhi Mang Xing", family = "zmx")
# 后面字体均可以使用导入的字体
showtext_auto()
4. 加载数据
excel.file <- "../data/week18_dallas_animals.xlsx"
# readxl::excel_sheets() 查看 Excel 中的 sheet 名称
readxl::excel_sheets(excel.file)
## [1] "raw" "simple"
# 根据 sheet 名字读取指定的表
df_input <- readxl::read_xlsx(excel.file, sheet = 'raw')
# 简要查看数据内容
glimpse(df_input)
## Rows: 34,819
## Columns: 33
## $ animal_id <chr> "A0979593", "A0743013", "A1004433", "A0969724",…
## $ animal_type <chr> "DOG", "DOG", "BIRD", "DOG", "DOG", "DOG", "CAT…
## $ animal_breed <chr> "RHOD RIDGEBACK", "YORKSHIRE TERR", "CHICKEN", …
## $ kennel_number <chr> "FREEZER", "RECEIVING", "BAY 31", "DC 15", "PSD…
## $ kennel_status <chr> "UNAVAILABLE", "IMPOUNDED", "IMPOUNDED", "UNAVA…
## $ tag_type <chr> "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA",…
## $ activity_number <chr> "A17-049022", "A16-039058", "A17-069323", "A16-…
## $ activity_sequence <dbl> 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ source_id <chr> "P0773474", "P0000000", "P0798483", "P0000000",…
## $ census_tract <chr> "1502", "13609", "10803", "7102", "6001", "7500…
## $ council_district <chr> "2", "11", "3", "2", "4", "1", "1", "4", "6", "…
## $ intake_type <chr> "CONFISCATED", "STRAY", "STRAY", "STRAY", "OWNE…
## $ intake_subtype <chr> "QUARANTINE - DEAD ON ARRIVAL", "POSSIBLY OWNED…
## $ reason <chr> "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA",…
## $ staff_id <chr> "AS", "HILLMON", "SC", "MMORALES", "SR/", "ARV"…
## $ intake_date <dttm> 2017-02-20, 2016-11-19, 2017-08-07, 2016-12-15…
## $ intake_time <chr> "NA", "0.75", "NA", "0.58333333333333337", "NA"…
## $ due_out <dttm> 2017-02-20, 2016-11-29, 2017-08-11, 2016-12-19…
## $ intake_condition <chr> "UNHEALTHY UNTREATABLE NON-CONTAGIOUS", "TREATA…
## $ hold_request <chr> "RABIES SPECIMEN", "NA", "NA", "NA", "EVERYDAY …
## $ outcome_type <chr> "DEAD ON ARRIVAL", "RETURNED TO OWNER", "TRANSF…
## $ outcome_date <chr> "42787", "42693", "42955", "42724", "42785", "4…
## $ outcome_time <chr> "NA", "NA", "NA", "0.375", "0.91666666666666663…
## $ receipt_number <chr> "NA", "NA", "NA", "R16-480147", "R17-489402", "…
## $ impound_number <chr> "K17-371830", "K16-364851", "K17-389867", "K16-…
## $ service_request_number <chr> "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA",…
## $ outcome_condition <chr> "UNHEALTHY UNTREATABLE NON-CONTAGIOUS", "TREATA…
## $ chip_status <chr> "SCAN NO CHIP", "SCAN CHIP", "SCAN NO CHIP", "S…
## $ animal_origin <chr> "FIELD", "FIELD", "FIELD", "FIELD", "OVER THE C…
## $ additional_information <chr> "NA", "NA", "NA", "ADOPT PENDING SX 12-20-16", …
## $ month <chr> "FEB", "NOV", "AUG", "DEC", "FEB", "OCT", "SEP"…
## $ year <chr> "FY2017", "FY2017", "FY2017", "FY2017", "FY2017…
## $ mo_year <dbl> 2017, 2016, 2017, 2016, 2017, 2016, 2017, 2017,…
# 检查数据的列名
colnames(df_input)
## [1] "animal_id" "animal_type" "animal_breed"
## [4] "kennel_number" "kennel_status" "tag_type"
## [7] "activity_number" "activity_sequence" "source_id"
## [10] "census_tract" "council_district" "intake_type"
## [13] "intake_subtype" "reason" "staff_id"
## [16] "intake_date" "intake_time" "due_out"
## [19] "intake_condition" "hold_request" "outcome_type"
## [22] "outcome_date" "outcome_time" "receipt_number"
## [25] "impound_number" "service_request_number" "outcome_condition"
## [28] "chip_status" "animal_origin" "additional_information"
## [31] "month" "year" "mo_year"
5. 数据预处理
# 整理绘制饼图的数据
df_plot <- df_input %>%
# count() 根据分组计算观测, 默认生成`n`, 用于存放计数结果
dplyr::count(animal_type) %>%
# mutate() 主要用于在数据框中添加新的变量, 这些变量是通过对现有的变量进行操作而形成的
dplyr::mutate(perc = percent(n/sum(n))) %>%
# arrange() 根据 change 列进行排序, 默认是升序; arrange + desc() 表示改为降序排列
dplyr::arrange(desc(n)) %>%
# filter() 根据条件过滤数据
mutate(animal_type = case_when(animal_type == 'DOG' ~ '狗',
animal_type == 'CAT' ~ '猫',
animal_type == 'WILDLIFE' ~ '野生动物',
animal_type == 'BIRD' ~ '鸟',
animal_type == 'LIVESTOCK' ~ '牲畜',
TRUE ~ animal_type))
# 简要查看数据内容
glimpse(df_plot)
## Rows: 5
## Columns: 3
## $ animal_type <chr> "狗", "猫", "野生动物", "鸟", "牲畜"
## $ n <int> 26043, 7718, 738, 304, 16
## $ perc <chr> "74.80%", "22.17%", "2.12%", "0.87%", "0.05%"
6. 利用 ggplot2 绘图
# PS: 方便讲解, 我这里进行了拆解, 具体使用时可以组合在一起
gg <- df_plot %>% ggplot(aes(x = "", y = n, fill = fct_reorder(animal_type, desc(n))))
# geom_bar() 绘制条形图, stat = "identity"，意味着条形的高度表示数据数据的值
gg <- gg + geom_bar(width = 1, stat = "identity")
# coord_polar() 弯曲横纵坐标（画饼图可以用）
gg <- gg + coord_polar(theta = "y")
# https://stackoverflow.com/a/41340766/9421451, 在 R 中的饼图上添加百分比标签
# geom_label_repel() 绘制不重叠的文本注释
gg <- gg + geom_label_repel(aes(label = paste0(animal_type, " ", perc)), size = 7, show.legend = FALSE, nudge_x = 1, family = 'zmx')
# labs() 对图形添加注释和标签（包含标题 title、子标题 subtitle、坐标轴 x & y 和引用 caption 等注释)
gg <- gg + labs(title = "动物类型",
x = NULL,
y = NULL,
caption = "资料来源: FiveThirtyEight Package · graph by 数绘小站 · 2022-10-22")
# theme_minimal() 去坐标轴边框的最小化主题
gg <- gg + theme_void()
# theme() 实现对非数据元素的调整, 对结果进行进一步渲染, 使之更加美观
gg <- gg + theme(
# panel.background 面板背景 数据下面
panel.background = element_rect(fill = '#AF9FAA', color = '#AF9FAA', size = 0),
# plot.background 图片背景
plot.background = element_rect(fill = '#AF9FAA', color = '#AF9FAA', size = 0),
# plot.margin 调整图像边距, 上-右-下-左
plot.margin = margin(2, 0, 2, 0),
# plot.title 主标题
plot.title = element_text(hjust = 0.1, color = "black", size = 20, face = "bold", family = 'zmx'),
# plot.caption 说明文字
plot.caption = element_text(hjust = 0.6, vjust = .3, size = 12, color = 'red'),
# text 设置文本格式
text = element_text(size = 20, hjust = 0, face = "bold", family = 'zmx'),
# legend.direction 设置图例的方向, horizontal 表示水平方向摆放
legend.direction = 'horizontal',
# legend.title 设置图例标题
legend.title = element_blank(),
# legend.position 设置图例位置, 这里用坐标来指定图例具体的摆放位置
legend.position = c(0.5, 0.03))
7. 保存图片到 PDF 和 PNG
gg
filename = '20180731-A-01'
ggsave(filename = paste0(filename, ".pdf"), width = 7.8, height = 8.0, device = cairo_pdf)
ggsave(filename = paste0(filename, ".png"), width = 7.8, height = 8.0, dpi = 100, device = "png", bg = '#AF9FAA')
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 tidyverse_1.3.2 scales_1.2.1
## [13] ggrepel_0.9.1 ggplot2_3.3.6
##
## loaded via a namespace (and not attached):
## [1] Rcpp_1.0.9 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 curl_4.3.3
## [16] googlesheets4_1.0.1 readxl_1.4.1 rstudioapi_0.14
## [19] jquerylib_0.1.4 rmarkdown_2.16 textshaping_0.3.6
## [22] labeling_0.4.2 googledrive_2.0.0 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.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 cli_3.4.1 stringi_1.7.8
## [46] cachem_1.0.6 farver_2.1.1 fs_1.5.2
## [49] xml2_1.3.3 bslib_0.4.0 ragg_1.2.3
## [52] ellipsis_0.3.2 generics_0.1.3 vctrs_0.4.2
## [55] tools_4.2.1 glue_1.6.2 hms_1.1.2
## [58] fastmap_1.1.0 yaml_2.3.5 colorspace_2.0-3
## [61] gargle_1.2.1 rvest_1.0.3 knitr_1.40
## [64] haven_2.5.1 sass_0.4.2
测试数据
配套数据下载：Dallas Animal Shelter FY2017
387
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
