20180423-B · Australian Salaries by Gender · ggplot2 ggalt geom_dumbbell 棒棒糖图 哑铃图 · R 语言数据可视化 案例 源码
2024-05-11 07:33:50
所有作品合集传送门： Tidy Tuesday
2018 年合集传送门： 2018
Australian Salaries by Gender
欢迎来到ggplot2的世界！
ggplot2是一个用来绘制统计图形的 R 软件包。它可以绘制出很多精美的图形，同时能避免诸多的繁琐细节，例如添加图例等。
用 ggplot2 绘制图形时，图形的每个部分可以依次进行构建，之后还可以进行编辑。ggplot2 精心挑选了一系列的预设图形，因此在大部分情形下可以快速地绘制出许多高质量的图形。如果在格式上还有额外的需求，也可以利用 ggplot2 中的主题系统来进行定制, 无需花费太多时间来调整图形的外观，而可以更加转注地用图形来展现你的数据。
棒棒糖图因其形状和棒棒糖相似而得名，具体来看实际上是一个散点和一条线段的组合。棒棒糖图是散点图的一种变体，又与柱状图非常相似，但其在清晰展示数据的同时，减少了图形量，使得读者能够更加关注于数据本身而非图形。棒棒糖图能够帮助将数值与类别对齐，非常适合比较多个类别的值之间的差异。
在 R 中我们可以直接使用ggalt包中 geom_dumbbell() 函数绘制，或者用 ggplot2 内置的一些绘图方法绘制，可以参考 20180423-A 这篇文章。
1. 一些环境设置
# 设置为国内镜像, 方便快速安装模块
options("repos" = c(CRAN = "https://mirrors.tuna.tsinghua.edu.cn/CRAN/"))
2. 设置工作路径
wkdir <- '/home/user/R_workdir/TidyTuesday/2018/2018-04-23_Australian_Salaries_by_Gender/src-b'
setwd(wkdir)
3. 加载 R 包
library(skimr)
library(ggalt)
library(tidyverse)# 导入字体设置包
library(showtext) # font_add_google() showtext 中从谷歌字体下载并导入字体的函数
# name 中的是字体名称, 用于检索, 必须严格对应想要字体的名字
# family 后面的是代码后面引用时的名称, 自己随便起
# 需要能访问 Google, 也可以注释掉下面这行, 影响不大
# font_families_google() 列出所有支持的字体, 支持的汉字不多
# http://www.googlefonts.net/
font_add_google(name = "Merienda", family = "Merienda")
font_add_google(name = "Gochi Hand", family = "gchi")
font_add_google(name = "ZCOOL XiaoWei", family = "zxw")# 后面字体均可以使用导入的字体
showtext_auto()
4. 加载数据
df_input <- read.csv("../data/week4_australian_salary.csv")# 简要查看数据内容
glimpse(df_input)
## Rows: 2,197
## Columns: 6
## $ X <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, …
## $ gender_rank <int> 795, 881, 699, 828, 641, 760, 200, 136, 157, 99…
## $ occupation <chr> "Abattoir process worker; Meat process worker; …
## $ gender <chr> "Female", "Male", "Female", "Male", "Female", "…
## $ individuals <int> 5961, 17241, 1386, 636, 1878, 903, 78380, 77112…
## $ average_taxable_income <int> 36359, 40954, 40926, 44077, 43545, 47833, 71552…
# 检查数据的列名
colnames(df_input)
## [1] "X" "gender_rank" "occupation"
## [4] "gender" "individuals" "average_taxable_income"
5. 数据预处理
# 浏览数框, 获得有用的汇总统计信息
df_input %>% skim(gender, individuals, average_taxable_income)
Table: Data summary
| Name | Piped data |
| Number of rows | 2197 |
| Number of columns | 6 |
| _______________________ | |
| Column type frequency: | |
| character | 1 |
| numeric | 2 |
| ________________________ | |
| Group variables | None |
Variable type: character
| skim_variable | n_missing | complete_rate | min | max | empty | n_unique | whitespace |
|---|---|---|---|---|---|---|---|
| gender | 0 | 1 | 4 | 6 | 0 | 2 | 0 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| individuals | 0 | 1 | 4683.71 | 14591.93 | 3 | 209 | 798 | 2960 | 293738 | ▇▁▁▁▁ |
| average_taxable_income | 0 | 1 | 65678.16 | 51171.45 | 13307 | 38909 | 53850 | 74441 | 577674 | ▇▁▁▁▁ |
# 整理绘图数据
df_tidy <- df_input %>%# select() 选择需要使用的列select(-X, -gender_rank,-individuals) %>%# spread() 数据裂变、从窄表到宽表spread(gender, average_taxable_income) %>%# rename() 列重命名rename(female = Female, male = Male) %>%# 建议使用 dplyr::mutate 形式调用函数, 有可能与 plyr 中的函数冲突dplyr::mutate(fdiff = female - male, fdiff_pct = as.integer(fdiff / male * 100)) %>%# 选择前十的数据top_n(10, male) %>%# arrange() 排序arrange(desc(male))# 去除缺失值
df_plot <- na.omit(df_tidy)# 简要查看数据内容
glimpse(df_plot)
## Rows: 10
## Columns: 5
## $ occupation <chr> "Neurosurgeon", "Ophthalmologist", "Cardiologist", "Plastic…
## $ female <int> 323682, 217242, 215920, 281608, 264628, 200136, 159479, 213…
## $ male <int> 577674, 552947, 453253, 448530, 446507, 445939, 439629, 433…
## $ fdiff <int> -253992, -335705, -237333, -166922, -181879, -245803, -2801…
## $ fdiff_pct <int> -43, -60, -52, -37, -40, -55, -63, -50, -34, -37
6. 利用 ggplot2 绘图
# PS: 方便讲解, 我这里进行了拆解, 具体使用时可以组合在一起
gg <- ggplot()
# geom_segment() 添加线段 x,y 表示线段的起点; xend, yend 表示线段的终点
gg <- gg + geom_segment(data = df_plot, aes(x = 0, y = fct_reorder(occupation, male),xend = max(male) * 1.04, yend = occupation),color = '#00FF7F',size = 0.16)
# geom_dumbbell() 绘制棒棒糖图/哑铃图
gg <- gg + geom_dumbbell(data = df_plot, aes(y = occupation, x = female, xend = male), size = 0.75,color = '#00FF7F', colour_x = 'red',colour_xend = 'blue',dot_guide = FALSE)
# geom_rect() 绘制矩形
gg <- gg + geom_rect(data = df_plot, aes(xmin = max(male) * 1.07, ymin = -Inf, xmax = max(male) * 1.2, ymax = Inf),fill = '#D3D3D3')
# geom_text() 添加文本信息, 添加差异百分比情况
gg <- gg + geom_text(data = df_plot, aes(label = paste0(fdiff_pct, "%"), x = max(male) * 1.13, y = occupation),size = 3, fontface = "bold")
gg <- gg + geom_text(data = filter(df_plot, occupation == "Neurosurgeon"), aes(x = max(male) * 1.13, y = occupation, label = "差异情况"),color = "#FF8C00",size = 3.2,vjust = -1.55,fontface = "bold")
# geom_text() 添加文本信息, 女性标签
gg <- gg + geom_text(data = filter(df_plot, occupation == "Neurosurgeon"),aes(x = female, y = occupation, label = "女性"),color = 'red',size = 3.2,vjust = 2.45, fontface = "bold")
# geom_text() 添加文本信息, 男性标签
gg <- gg + geom_text(data = filter(df_plot, occupation == "Neurosurgeon"), aes(x = male, y = occupation, label = "男性"),color = 'blue',size = 3.2,vjust = 2.45,fontface = "bold")
# scale_x_continuous() 对连续变量设置坐标轴显示范围
gg <- gg + scale_x_continuous(labels = scales::dollar_format())
# labs() 对图形添加注释和标签（包含标题 title、子标题 subtitle、坐标轴 x & y 和引用 caption 等注释)
gg <- gg + labs(title = "2013-2014年平均应税收入（澳元）中的性别工资差距",subtitle = "在澳大利亚薪酬最高的工作中，女性收入低于男性",x = NULL,y = NULL,caption = "资料来源: data.gov.au · 资料来源: data.gov.au")
# 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(),# axis.text.x X-坐标轴文本axis.text.x = element_text(color = "black", size = 12, family = "gchi", face = "bold"),# axis.text.y Y-坐标轴文本axis.text.y = element_text(color = "black", size = 10, family = "Merienda", face = "bold"),# plot.title 主标题plot.title = element_text(color = "black", size = 18, family = "zxw", face = "bold", hjust = -1.0),# plot.subtitle 次要标题plot.subtitle = element_text(color = "red", size = 10, vjust = -1.2),# plot.caption 说明文字plot.caption = element_text(hjust = 0.85, vjust = -1.2),# legend.position 设置图例位置, "none" 表示不显示图例legend.position = "none",# plot.background 图片背景 element_blank() 指的是去掉外边框和背景色plot.background = element_blank())
7. 保存图片到 PDF 和 PNG
gg
filename = '20180423-B-01'
ggsave(filename = paste0(filename, ".pdf"), width = 9.2, height = 5.4, device = cairo_pdf)
ggsave(filename = paste0(filename, ".png"), width = 9.2, height = 5.4, dpi = 100, device = "png")
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 ggalt_0.4.0
## [13] ggplot2_3.3.6 skimr_2.1.4
##
## loaded via a namespace (and not attached):
## [1] httr_1.4.4 sass_0.4.2 maps_3.4.0
## [4] jsonlite_1.8.0 modelr_0.1.9 bslib_0.4.0
## [7] assertthat_0.2.1 highr_0.9 googlesheets4_1.0.1
## [10] cellranger_1.1.0 yaml_2.3.5 Rttf2pt1_1.3.10
## [13] pillar_1.8.1 backports_1.4.1 glue_1.6.2
## [16] extrafontdb_1.0 digest_0.6.29 RColorBrewer_1.1-3
## [19] rvest_1.0.3 colorspace_2.0-3 htmltools_0.5.3
## [22] pkgconfig_2.0.3 broom_1.0.1 haven_2.5.1
## [25] scales_1.2.1 tzdb_0.3.0 googledrive_2.0.0
## [28] farver_2.1.1 generics_0.1.3 ellipsis_0.3.2
## [31] cachem_1.0.6 withr_2.5.0 repr_1.1.4
## [34] cli_3.3.0 magrittr_2.0.3 crayon_1.5.1
## [37] readxl_1.4.1 evaluate_0.16 ash_1.0-15
## [40] fs_1.5.2 fansi_1.0.3 MASS_7.3-58.1
## [43] xml2_1.3.3 textshaping_0.3.6 tools_4.2.1
## [46] hms_1.1.2 gargle_1.2.1 lifecycle_1.0.1
## [49] munsell_0.5.0 reprex_2.0.2 compiler_4.2.1
## [52] jquerylib_0.1.4 systemfonts_1.0.4 rlang_1.0.5
## [55] grid_4.2.1 rstudioapi_0.14 labeling_0.4.2
## [58] base64enc_0.1-3 rmarkdown_2.16 proj4_1.0-11
## [61] gtable_0.3.1 curl_4.3.2 DBI_1.1.3
## [64] R6_2.5.1 lubridate_1.8.0 knitr_1.40
## [67] fastmap_1.1.0 extrafont_0.18 utf8_1.2.2
## [70] ragg_1.2.3 KernSmooth_2.23-20 stringi_1.7.8
## [73] vctrs_0.4.1 dbplyr_2.2.1 tidyselect_1.1.2
## [76] xfun_0.32
测试数据
配套数据下载：week4_australian_salary.csv
20180423-B · Australian Salaries by Gender · ggplot2 ggalt geom_dumbbell 棒棒糖图 哑铃图 · R 语言数据可视化 案例 源码相关推荐
- 20180710-B · Craft Beer USA · ggplot2 geom_density_ridges_gradient 核密度估计峰峦图 字体设置 · R 语言数据可视化 案例 源码
所有作品合集传送门: Tidy Tuesday 2018 年合集传送门: 2018 Craft Beer USA 欢迎来到ggplot2的世界! ggplot2是一个用来绘制统计图形的 R 软件包.它 ...
- 20180507-A · Global Coffee Chains · ggplot2 usmap geom_map geom_point 地图 热图 美国地图 · R 语言数据可视化 案例 源码
所有作品合集传送门: Tidy Tuesday 2018 年合集传送门: 2018 Global Coffee Chains 欢迎来到ggplot2的世界! ggplot2是一个用来绘制统计图形的 R ...
- 20180529-C · Comic book characters · ggplot2 geom_bar 柱状图 条形图 facet_wrap 分面 · R 语言数据可视化 案例 源码
所有作品合集传送门: Tidy Tuesday 2018 年合集传送门: 2018 Comic book characters 欢迎来到ggplot2的世界! ggplot2是一个用来绘制统计图形的 ...
- 20180402-D · US Tuition Costs · ggplot2 geofacet 按地理位置分面的数据可视化 · R 语言数据可视化 案例 源码
所有作品合集传送门: Tidy Tuesday 2018 年合集传送门: 2018 US Tuition Costs Average Tuition and Educational Attainmen ...
- 20180710-A · Craft Beer USA · ggplot2 geom_col 条形图 facet_geo theme 字体设置 画图 图例 · R 语言数据可视化 案例 源码
所有作品合集传送门: Tidy Tuesday 2018 年合集传送门: 2018 Craft Beer USA 欢迎来到ggplot2的世界! ggplot2是一个用来绘制统计图形的 R 软件包.它 ...
- 20180409-C · NFL Positional Salaries · ggplot2, 折线图 散点图 分面图 · R 语言数据可视化 案例 源码
所有作品合集传送门: Tidy Tuesday 2018 年合集传送门: 2018 NFL Positional Salaries NFL Positional Salaries Tidy Tuesd ...
- 20180409-A · NFL Positional Salaries · ggplot2, 小提琴图 散点图 · R 语言数据可视化 案例 源码
所有作品合集传送门: Tidy Tuesday 2018 年合集传送门: 2018 NFL Positional Salaries NFL Positional Salaries Tidy Tuesd ...
- 20180409-B · NFL Positional Salaries · ggplot2, 峦峰图, gganimate 动态图 · R 语言数据可视化 案例 源码
所有作品合集传送门: Tidy Tuesday 2018 年合集传送门: 2018 NFL Positional Salaries NFL Positional Salaries Tidy Tuesd ...
- 20180529-A · Comic book characters · ggplot2 geom_bar geom_text 柱状图 条形图 图例 · R 语言数据可视化 案例 源码
所有作品合集传送门: Tidy Tuesday 2018 年合集传送门: 2018 Comic book characters 欢迎来到ggplot2的世界! ggplot2是一个用来绘制统计图形的 ...
最新文章
- Ant Design 4.0 进行时！
- 什么是内存(二)：虚拟内存
- 一个DataTable赋值给另一个
- C算法--入门 2.3
- 科研绘图工具软件_如何在Windows 10 Mail中使用绘图工具
- webpack配置路径问题
- java访问方法修饰词四个_java中的四个修饰词（访问权限）
- 软技能-代码之外的生存指南-读书笔记（持续更新中）
- 《Android测试的学习笔记》——Introduction
- 爬了7000+条内衣信息，只为探究妹纸们的偏好！
- Android高级控件（六）——自定义ListView高仿一个QQ可拖拽列表的实现
- 【Windows编程】Windows Socket API介绍
- 网页通过Flash播放视频
- Gut：中国药科大学周伟等团队在肠道菌群驱动风湿性关节炎机制研究和中药干预方面取得新进展...
- 1520 - 骑士的金币（coin）
- 大数据笔记-外存算法
- display:weston:weston-simple-egl
- 模型预测控制系列讲解（二）：模型预测控制算法发展进程
- SQLite虚表介绍
- 计算机分辨率启动,电脑启动时分辨率都不对为什么