20180402-F · US Tuition Costs · pheatmap 绘制热图 · R 语言数据可视化 案例 源码

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

2018 年合集传送门： 2018

US Tuition Costs

Average Tuition and Educational Attainment in the United States。


Tidy Tuesday 在 GitHub 上的传送地址：
Thomas Mock (2022). Tidy Tuesday: A weekly data project aimed at the R ecosystem. https://github.com/rfordatascience/tidytuesday

1. 一些环境设置

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

2. 设置工作路径

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

3. 加载 R 包

library(tidyverse)
library(pheatmap)
library(RColorBrewer)
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> "Alalbert", "Alaska", "Arizona", "Arkansas", "California", "C…
## $ `2004-05` <dbl> 5682.838, 4328.281, 5138.495, 5772.302, 5285.921, 4703.777, …
## $ `2005-06` <dbl> 5840.550, 4632.623, 5415.516, 6082.379, 5527.881, 5406.967, …
## $ `2006-07` <dbl> 5753.496, 4918.501, 5481.419, 6231.977, 5334.826, 5596.348, …
## $ `2007-08` <dbl> 6008.169, 5069.822, 5681.638, 6414.900, 5672.472, 6227.002, …
## $ `2008-09` <dbl> 6475.092, 5075.482, 6058.464, 6416.503, 5897.888, 6284.137, …
## $ `2009-10` <dbl> 7188.954, 5454.607, 7263.204, 6627.092, 7258.771, 6948.473, …
## $ `2010-11` <dbl> 8071.134, 5759.153, 8839.605, 6900.912, 8193.739, 7748.201, …
## $ `2011-12` <dbl> 8451.902, 5762.421, 9966.716, 7028.991, 9436.426, 8315.632, …
## $ `2012-13` <dbl> 9098.069, 6026.143, 10133.503, 7286.580, 9360.574, 8792.856,…
## $ `2013-14` <dbl> 9358.929, 6012.445, 10296.200, 7408.495, 9274.193, 9292.954,…
## $ `2014-15` <dbl> 9496.084, 6148.808, 10413.844, 7606.410, 9186.824, 9298.599,…
## $ `2015-16` <dbl> 9751.101, 6571.340, 10646.278, 7867.297, 9269.844, 9748.188,…

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

##  [1] "State"   "2004-05" "2005-06" "2006-07" "2007-08" "2008-09" "2009-10"
##  [8] "2010-11" "2011-12" "2012-13" "2013-14" "2014-15" "2015-16"

5. 数据预处理

# 调整年份为 YYYY 格式, 方便绘图展示
df_tidy <- df_input %>%
  dplyr::rename(
    "2004" = "2004-05",
    "2005" = "2005-06",
    "2006" = "2006-07",
    "2007" = "2007-08",
    "2008" = "2008-09",
    "2009" = "2009-10",
    "2010" = "2010-11",
    "2011" = "2011-12",
    "2012" = "2012-13",
    "2013" = "2013-14",
    "2014" = "2014-15",
    "2015" = "2015-16")

# 将 State 转换为字符串格式
df_tidy$State <- as.character(df_tidy$State)

# 从美元值中去除 "$" 和 "," 符号
indx <- sapply(df_tidy, is.factor)
df_tidy[indx] <- lapply(df_tidy[indx], function(x) as.numeric(gsub("[,$]", "", x)))

# 自定义一个函数, 用于创建矩阵但保留行名
mat.convert <- function(i) {
    # tibble 转换为 data.frame 格式, 否则会报错
    i <- as.data.frame(i)
    mat <- as.matrix(i[, -1])
    rownames(mat) <- i[, 1]
    mat
} 

df_plot <- mat.convert(df_tidy)


# 简要查看数据内容
glimpse(df_plot)

##  num [1:50, 1:12] 5683 4328 5138 5772 5286 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : chr [1:50] "Alabama" "Alaska" "Arizona" "Arkansas" ...
##   ..$ : chr [1:12] "2004" "2005" "2006" "2007" ...

6. 用 pheatmap 绘制热图

# 自定义调色板
palette <- colorRampPalette(c("blue", "red"))(100)


# 使用 pheatmap() 函数绘制热图
figure = pheatmap(df_plot, color = palette, cluster_cols = FALSE, border_color = NA, cellwidth = 30, cellheight = 10)

7 保存图片到 PDF 和 PNG

filename = '20180402-F-01'
ggsave(figure, filename = paste0(filename, ".pdf"), width = 10, height = 7.6, device = cairo_pdf)
ggsave(figure, filename = paste0(filename, ".png"), width = 10, height = 7.6, 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     RColorBrewer_1.1-3
##  [5] pheatmap_1.0.12    forcats_0.5.2      stringr_1.4.1      dplyr_1.0.10      
##  [9] purrr_0.3.4        readr_2.1.2        tidyr_1.2.1        tibble_3.1.8      
## [13] 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.5         googlesheets4_1.0.1 readxl_1.4.1       
## [16] rstudioapi_0.14     jquerylib_0.1.4     rmarkdown_2.16     
## [19] textshaping_0.3.6   googledrive_2.0.0   munsell_0.5.0      
## [22] broom_1.0.1         compiler_4.2.1      modelr_0.1.9       
## [25] xfun_0.32           systemfonts_1.0.4   pkgconfig_2.0.3    
## [28] htmltools_0.5.3     tidyselect_1.1.2    fansi_1.0.3        
## [31] crayon_1.5.1        tzdb_0.3.0          dbplyr_2.2.1       
## [34] withr_2.5.0         grid_4.2.1          jsonlite_1.8.0     
## [37] gtable_0.3.1        lifecycle_1.0.1     DBI_1.1.3          
## [40] magrittr_2.0.3      scales_1.2.1        cli_3.3.0          
## [43] stringi_1.7.8       cachem_1.0.6        fs_1.5.2           
## [46] xml2_1.3.3          bslib_0.4.0         ragg_1.2.3         
## [49] ellipsis_0.3.2      generics_0.1.3      vctrs_0.4.1        
## [52] tools_4.2.1         glue_1.6.2          hms_1.1.2          
## [55] fastmap_1.1.0       yaml_2.3.5          colorspace_2.0-3   
## [58] gargle_1.2.1        rvest_1.0.3         knitr_1.40         
## [61] haven_2.5.1         sass_0.4.2

测试数据

配套数据下载：us_avg_tuition.xlsx