目标

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() 合并行形成数据框¹，优雅！

另外，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() 等函数替代。 ↩︎

dplyr 源码学习笔记（一）

吴诗涛 2023-05-14 [R]

目标

学习笔记

starwars 数据集

网页请求要设置失败提醒

在 `tibble()` 中构建列向量

列表列的输出

storms 数据集

读取函数可用在管道中

筛选分组

R 包

Roxygen 文档可内嵌 Rmd 子文档

dplyr 源码学习笔记（一）

吴诗涛 2023-05-14 [R]

目标

学习笔记

starwars 数据集

网页请求要设置失败提醒

在 tibble() 中构建列向量

列表列的输出

storms 数据集

读取函数可用在管道中

筛选分组

R 包

Roxygen 文档可内嵌 Rmd 子文档

在 `tibble()` 中构建列向量