所有作品合集传送门： Tidy Tuesday

年合集传送门：

US Tuition Costs

Average Tuition and Educational Attainment in the United States。

Tidy Tuesday 在 GitHub 上的传送地址：

Thomas Mock (). Tidy Tuesday: A weekly data project aimed at the R ecosystem./rfordatascience/tidytuesday

1. 一些环境设置

# 设置为国内镜像, 方便快速安装模块options("repos" = c(CRAN = "https://mirrors.tuna./CRAN/"))

2. 设置工作路径

wkdir <- '/home/user/R_workdir/TidyTuesday//-04-02_US_Tuition_Costs/src-c'setwd(wkdir)

3. 加载 R 包

# install_github("wmurphyrd/fiftystater"), 美国州地图library(ggplot2)library(viridis)library(tidyverse)library(fiftystater)library(showtext)

# 在 Ubuntu 系统上测试的, 不加这个我画出来的汉字会乱码 ~showtext_auto()

4. 加载数据

df_input <- readxl::read_excel("../data/us_avg_tuition.xlsx")# 简要查看数据内容glimpse(df_input)

## Rows: 50## Columns: 13## $ State<chr> "Alabama", "Alaska", "Arizona", "Arkansas", "California", "Calbert…## $ `-05` <dbl> 5682.838, 4328.281, 5138.495, 5772.302, 5285.921, 4703.777, …## $ `-06` <dbl> 5840.550, 4632.623, 5415.516, 6082.379, 5527.881, 5406.967, …## $ `-07` <dbl> 5753.496, 4918.501, 5481.419, 6231.977, 5334.826, 5596.348, …## $ `-08` <dbl> 6008.169, 5069.822, 5681.638, 6414.900, 5672.472, 6227.002, …## $ `-09` <dbl> 6475.092, 5075.482, 6058.464, 6416.503, 5897.888, 6284.137, …## $ `-10` <dbl> 7188.954, 5454.607, 7263.204, 6627.092, 7258.771, 6948.473, …## $ `-11` <dbl> 8071.134, 5759.153, 8839.605, 6900.912, 8193.739, 7748.201, …## $ `-12` <dbl> 8451.902, 5762.421, 9966.716, 7028.991, 9436.426, 8315.632, …## $ `-13` <dbl> 9098.069, 6026.143, 10133.503, 7286.580, 9360.574, 8792.856,…## $ `-14` <dbl> 9358.929, 6012.445, 10296.200, 7408.495, 9274.193, 9292.954,…## $ `-15` <dbl> 9496.084, 6148.808, 10413.844, 7606.410, 9186.824, 9298.599,…## $ `-16` <dbl> 9751.101, 6571.340, 10646.278, 7867.297, 9269.844, 9748.188,…

# 检查数据的列名colnames(df_input)

## [1] "State" "-05" "-06" "-07" "-08" "-09" "-10"## [8] "-11" "-12" "-13" "-14" "-15" "-16"

5. 数据预处理

# 将美元金额转换为数字colnames(df_input) <- make.names(colnames(df_input))df_reduced <- select(df_input, -State)df_numeric <- as.data.frame(sapply(df_reduced, function(x) {as.numeric(gsub("[$,]", "", x))}))df_work <- cbind(state = df_input$State, df_numeric)colnames(df_work) <- make.names(colnames(df_work))# 新增一列 Growth, 用于存放学费增长情况df_plot <- df_work %>%# 建议使用 dplyr::mutate 形式调用函数, 不然容易与 plyr 中的函数冲突 (因为我自己就报错了...)dplyr::mutate(Growth = (X.16 - X.06) / X.06, Region = tolower(state)) %>%select(state, Region, Growth)

6. 用 ggplot2 开始绘图

gg <- df_plot %>% ggplot(aes(map_id = Region))gg <- gg + geom_map(aes(fill = Growth), map = fifty_states, color = "gray10") gg <- gg + expand_limits(x = fifty_states$long, y = fifty_states$lat) gg <- gg + coord_map()gg <- gg + labs(x = "", y = "", title = "% Growth in Tuition (-)")# scale_fill_viridis() 使用 Viridis 调色gg <- gg + scale_fill_viridis(option = "inferno", breaks = c(.025, .5, .75, 1, 1.25), labels = scales::percent)gg <- gg + scale_x_continuous(breaks = NULL)gg <- gg + scale_y_continuous(breaks = NULL)gg <- gg + guides(fill = guide_colorbar(barwidth = 15, barheight = .35))# theme_minimal() 去坐标轴边框的最小化主题gg <- gg + theme_minimal()gg <- gg + labs(title = "美国各个州的大学学费变化",x = NULL,y = NULL)# theme() 实现对非数据元素的调整, 对结果进行进一步渲染, 使之更加美观gg <- gg + theme(# panel.grid.major 主网格线, 这一步表示删除主要网格线panel.grid.major = element_blank(),# panel.grid.minor 次网格线, 这一步表示删除次要网格线panel.grid.minor = element_blank(),# axis.text 坐标轴刻度文本axis.text = element_text(color = "black", size = 12),# axis.title 坐标轴标题axis.title = element_text(color = "black", size = 10),# plot.title 主标题plot.title = element_text(color = "black", size = 20, face = "bold"),# plot.subtitle 次要标题plot.subtitle = element_text(color = "red", size = 12),# plot.background 图片背景plot.background = element_rect(fill = "white"),# legend.position 设置图例位置legend.position = "bottom",# legend.title 设置图例标题legend.title = element_blank())

7 保存图片到 PDF 和 PNG

gg

filename = '0402-C-01'ggsave(filename = paste0(filename, ".pdf"), width = 8, height = 6, device = cairo_pdf)ggsave(filename = paste0(filename, ".png"), width = 8, height = 6, dpi = 100, device = "png")

8. session-info

sessionInfo()

## R version 4.2.1 (-06-23)## Platform: x86_64-pc-linux-gnu (64-bit)## Running under: Ubuntu 20.04.4 LTS## ## Matrix products: albert## 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=CLC_TELEPHONE=C ## [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C ## ## attached base packages:## [1] statsgraphics grDevices utilsdatasets methods base## ## other attached packages:## [1] showtext_0.9-5 showtextdb_3.0 sysfonts_0.8.8 fiftystater_1.0.1## [5] forcats_0.5.2stringr_1.4.1dplyr_1.0.10purrr_0.3.4## [9] readr_2.1.2 tidyr_1.2.1 tibble_3.1.8tidyverse_1.3.2 ## [13] viridis_0.6.2viridisLite_0.4.1 ggplot2_3.3.6 ## ## loaded via a namespace (and not attached):## [1] lubridate_1.8.0assertthat_0.2.1 digest_0.6.29## [4] utf8_1.2.2R6_2.5.1 cellranger_1.1.0 ## [7] backports_1.4.1reprex_2.0.2 evaluate_0.16## [10] highr_0.9 httr_1.4.4pillar_1.8.1 ## [13] rlang_1.0.5 googlesheets4_1.0.1 readxl_1.4.1 ## [16] rstudioapi_0.14jquerylib_0.1.4rmarkdown_2.16## [19] textshaping_0.3.6 googledrive_2.0.0 munsell_0.5.0## [22] broom_1.0.1 compiler_4.2.1modelr_0.1.9 ## [25] xfun_0.32 systemfonts_1.0.4 pkgconfig_2.0.3 ## [28] htmltools_0.5.3tidyselect_1.1.2 gridExtra_2.3## [31] fansi_1.0.3 crayon_1.5.1 tzdb_0.3.0 ## [34] dbplyr_2.2.1 withr_2.5.0 grid_4.2.1 ## [37] jsonlite_1.8.0gtable_0.3.1 lifecycle_1.0.1 ## [40] DBI_1.1.3 magrittr_2.0.3scales_1.2.1 ## [43] cli_3.3.0 stringi_1.7.8 cachem_1.0.6 ## [46] mapproj_1.2.8 farver_2.1.1 fs_1.5.2 ## [49] xml2_1.3.3bslib_0.4.0 ragg_1.2.3 ## [52] ellipsis_0.3.2generics_0.1.3vctrs_0.4.1 ## [55] tools_4.2.1 glue_1.6.2maps_3.4.0 ## [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.40haven_2.5.1 sass_0.4.2

测试数据

配套数据下载：us_avg_tuition.xlsx