目标
dplyr 是数据处理中的重要工具包，目前更新到 1.1.2 版本。了解它底层对数据进行的操作，可以帮助自己写出更简洁高效的代码。因此这两天开始拆包看源码，主要学习：
- 大部分 dplyr 包中函数的底层实现方法；
- 复杂 R 包的构建方法和技巧；
- 大佬们的代码技能和风格。
学习笔记
学习计划是从包的外围（数据集 data-raw/ 和测试脚本 test/）往包的核心（函数 R/、src/）前进。为了提高代码运行速度，dplyr 包中很多函数是通过 C++ 实现的（这些脚本放置在 src/ 中），这部分先计划先尝试结合 ChatGPT 看看能否整明白，若不行则去啃一阵子 C++ 再来闯关。
starwars 数据集
library(dplyr, warn.conflicts = FALSE)
library(purrr)
head(starwars)
#> # A tibble: 6 × 14
#> name height mass hair_color skin_color eye_color birth_year sex gender
#> <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr>
#> 1 Luke Sky… 172 77 blond fair blue 19 male mascu…
#> 2 C-3PO 167 75 <NA> gold yellow 112 none mascu…
#> 3 R2-D2 96 32 <NA> white, bl… red 33 none mascu…
#> 4 Darth Va… 202 136 none white yellow 41.9 male mascu…
#> 5 Leia Org… 150 49 brown light brown 19 fema… femin…
#> 6 Owen Lars 178 120 brown, gr… light blue 52 male mascu…
#> # ℹ 5 more variables: homeworld <chr>, species <chr>, films <list>,
#> # vehicles <list>, starships <list>
dplyr 中内置的 starwars 数据集通过 starwars.R 这一脚本生成，其本中涉及网页请求、数据清洗等方面。开眼看到的有：
网页请求要设置失败提醒
get_all <- function(url) {
out <- NULL
while (!is.null(url)) {
message(null, url)
req <- GET(url)
stop_for_status(req)
con <- content(req)
out <- c(out, con$results)
url <- con$`next`
}
out
}
自定义的 get_all() 用于获取 url 页面上的内容。在构建请求时，应设置 stop_for_status(req) 或 warn_for_status(req) 提示用户请求失败的原因，方便自己和用户进行错误处理。
在 tibble() 中构建列向量
starwars <- tibble(
name = people %>% map_chr("name"),
height = people %>% map_chr("height") %>% parse_integer(na = "unknown"),
mass = people %>% map_chr("mass") %>% parse_number(na = "unknown"),
hair_color = people %>% map_chr("hair_color") %>% parse_character(na = "n/a"),
skin_color = people %>% map_chr("skin_color"),
eye_color = people %>% map_chr("eye_color"),
birth_year = people %>% map_chr("birth_year") %>% parse_number(na = "unknown"),
sex = people %>% map_chr("gender") %>% parse_character(na = "n/a"),
gender = NA_character_,
homeworld = people %>% map_chr("homeworld") %>% planets[.] %>% unname(),
species = people %>% map("species") %>% map_chr(1, .null = NA) %>% species[.] %>% unname(),
films = people %>% map("films") %>% map(. %>% flatten_chr() %>% films[.] %>% unname()),
vehicles = people %>% map("vehicles", .default = list()) %>% map(. %>% flatten_chr() %>% vehicles[.] %>% unname()),
starships = people %>% map("starships", .default = list()) %>% map(. %>% flatten_chr() %>% starships[.] %>% unname())
)
tibble() 构建数据框采用 列名 = 未命名的列向量 的方式，这段代码给了我很大的启发：
-
将管道操作符
%>%用于列向量的构建，并使用unname()去除列向量的命名，就有了符合条件的未命名的列向量。 -
缺失值的处理上，
prase_系列函数通过na参数将指定的缺失数据转为NA。 -
缺失值可细分为
NA_integer_、NA_character_等。 -
%>% planets[.]类似操作可以在管道中根据向量的命名提取向量值，非常巧妙：fruits <- c( "A" = "Apple", "B" = "Banana" ) c("A", "B", "B", "A") %>% fruits[.] %>% unname() #> [1] "Apple" "Banana" "Banana" "Apple" -
map()函数中仍可以使用管道map(. %>% flatten_chr() %>% vehicles[.] %>% unname())，本质上是对列表的批量操作。
列表列的输出
tibble 中可以包含列表列，比如 starwars 后面中的最后三列，每个值都是长度不定的字符串。
# 筛选 starwars 中的列表列
starwars %>%
select(where(is.list))
#> # A tibble: 87 × 3
#> films vehicles starships
#> <list> <list> <list>
#> 1 <chr [5]> <chr [2]> <chr [2]>
#> 2 <chr [6]> <chr [0]> <chr [0]>
#> 3 <chr [7]> <chr [0]> <chr [0]>
#> 4 <chr [4]> <chr [0]> <chr [1]>
#> 5 <chr [5]> <chr [1]> <chr [0]>
#> 6 <chr [3]> <chr [0]> <chr [0]>
#> 7 <chr [3]> <chr [0]> <chr [0]>
#> 8 <chr [1]> <chr [0]> <chr [0]>
#> 9 <chr [1]> <chr [0]> <chr [1]>
#> 10 <chr [6]> <chr [1]> <chr [5]>
#> # ℹ 77 more rows
# 查看 films 列的前两个值
starwars %>%
pull(films) %>%
.[1:2]
#> [[1]]
#> [1] "The Empire Strikes Back" "Revenge of the Sith"
#> [3] "Return of the Jedi" "A New Hope"
#> [5] "The Force Awakens"
#>
#> [[2]]
#> [1] "The Empire Strikes Back" "Attack of the Clones"
#> [3] "The Phantom Menace" "Revenge of the Sith"
#> [5] "Return of the Jedi" "A New Hope"
列表列无法直接输出到 csv 或 Excel 等格式的文件中，因此最直接的方法方法就是将其转变为字符串。源码中使用的 mutate_if() 在 dplyr 1.0.0 大版本更新的时候被替代，现在使用 across() ：
# 将每一个列表都合并为一个字符串
starwars %>%
mutate(across(where(is.list), ~ map_chr(., paste, collapse = ", "))) %>%
select(films) # 查看 films 列
#> # A tibble: 87 × 1
#> films
#> <chr>
#> 1 The Empire Strikes Back, Revenge of the Sith, Return of the Jedi, A New Hope…
#> 2 The Empire Strikes Back, Attack of the Clones, The Phantom Menace, Revenge o…
#> 3 The Empire Strikes Back, Attack of the Clones, The Phantom Menace, Revenge o…
#> 4 The Empire Strikes Back, Revenge of the Sith, Return of the Jedi, A New Hope
#> 5 The Empire Strikes Back, Revenge of the Sith, Return of the Jedi, A New Hope…
#> 6 Attack of the Clones, Revenge of the Sith, A New Hope
#> 7 Attack of the Clones, Revenge of the Sith, A New Hope
#> 8 A New Hope
#> 9 A New Hope
#> 10 The Empire Strikes Back, Attack of the Clones, The Phantom Menace, Revenge o…
#> # ℹ 77 more rows
storms 数据集
head(storms)
#> # A tibble: 6 × 13
#> name year month day hour lat long status category wind pressure
#> <chr> <dbl> <dbl> <int> <dbl> <dbl> <dbl> <fct> <dbl> <int> <int>
#> 1 Amy 1975 6 27 0 27.5 -79 tropical de… NA 25 1013
#> 2 Amy 1975 6 27 6 28.5 -79 tropical de… NA 25 1013
#> 3 Amy 1975 6 27 12 29.5 -79 tropical de… NA 25 1013
#> 4 Amy 1975 6 27 18 30.5 -79 tropical de… NA 25 1013
#> 5 Amy 1975 6 28 0 31.5 -78.8 tropical de… NA 25 1012
#> 6 Amy 1975 6 28 6 32.4 -78.7 tropical de… NA 25 1012
#> # ℹ 2 more variables: tropicalstorm_force_diameter <int>,
#> # hurricane_force_diameter <int>
dplyr 中内置的 storms 数据集是通过 storms.R 这一脚本生成的。
读取函数可用在管道中
headers_df <- headers %>%
map(str_sub, start = 1, end = -2) %>% # to remove trailing comma
map(paste0, "\n") %>% # to trigger literal read
map_df(read_csv, col_names = c("id", "name", "n_obs"), col_types = "cci") %>%
mutate(name = recode(name, "UNNAMED" = id), skip = header_locations) %>%
select(id, name, skip, n_obs)
利用 read_csv() 函数读取列表中的元素，并通过 map_df() 合并行形成数据框1，优雅！
另外，read_csv() 中的 col_types 参数可以控制读取列的类型，使用简化的字符串拼写，每个字符表示一列的类型。
筛选分组
通过组内某一行满足或者整组都满足某一条件对组进行筛选，比如筛选整个年级中有数学考试不及格的班级成绩。以 storms 举例，筛选在纬度 7.4 有出现过的飓风信息：
storms %>%
filter(.by = c(name),
any(lat == 7.4)) %>%
select(1:7)
#> # A tibble: 190 × 7
#> name year month day hour lat long
#> <chr> <dbl> <dbl> <int> <dbl> <dbl> <dbl>
#> 1 Isidore 1984 9 25 12 23.4 -73
#> 2 Isidore 1984 9 25 18 23.9 -73.9
#> 3 Isidore 1984 9 26 0 24.3 -74.9
#> 4 Isidore 1984 9 26 6 24.5 -76
#> 5 Isidore 1984 9 26 12 24.7 -77
#> 6 Isidore 1984 9 26 18 25 -77.7
#> 7 Isidore 1984 9 27 0 25.4 -78.4
#> 8 Isidore 1984 9 27 6 25.8 -79.1
#> 9 Isidore 1984 9 27 12 26.4 -79.8
#> 10 Isidore 1984 9 27 18 27.3 -80.5
#> # ℹ 180 more rows
筛选风暴中心气压均大于 1000 millibars 的飓风信息：
storms %>%
filter(.by = name,
all(pressure > 1000)) %>%
select(1:5, 11)
#> # A tibble: 709 × 6
#> name year month day hour pressure
#> <chr> <dbl> <dbl> <int> <dbl> <int>
#> 1 Hallie 1975 10 24 18 1006
#> 2 Hallie 1975 10 25 0 1006
#> 3 Hallie 1975 10 25 6 1006
#> 4 Hallie 1975 10 25 12 1006
#> 5 Hallie 1975 10 25 18 1006
#> 6 Hallie 1975 10 26 0 1006
#> 7 Hallie 1975 10 26 6 1006
#> 8 Hallie 1975 10 26 12 1005
#> 9 Hallie 1975 10 26 18 1003
#> 10 Hallie 1975 10 27 0 1002
#> # ℹ 699 more rows
R 包
Roxygen 文档可内嵌 Rmd 子文档
在 select.R 中看到 Roxygen 内嵌 Rmd 子文档的用法：
-
内嵌
#' ## Overview of selection features #' #' ```{r, child = "man/rmd/overview.Rmd"} #' ``` -
knit 后嵌入
#' ```{r, echo = FALSE, results = "asis"} #' result <- rlang::with_options( #' knitr::knit_child("man/rmd/select.Rmd"), #' tibble.print_min = 4, #' tibble.max_extra_cols = 8, #' pillar.min_title_chars = 20, #' digits = 2 #' ) #' cat(result, sep = "\n") #' ```
-
map_df()在 dplyr 1.1.0 升级中被list_rbind()等函数替代。 ↩︎