26  迭代

26.1 引言

所谓迭代，就是对不同对象重复执行相同操作的方法。R语言的迭代方式与其他编程语言差异显著，因为R大量采用隐式迭代机制，即许多操作能自动实现循环功能。例如，若要将数值向量x的所有元素乘以2，只需简单书写2 * x；而在其他大多数语言中，则需要显式地通过for循环逐个处理元素。

本书此前已介绍过若干种可对多组数据执行统一操作的精悍工具：

• facet_wrap()与facet_grid()：为每个数据子集绘制分面图形
• group_by()配合summarize()：计算各分组统计量
• unnest_wider()与unnest_longer()：针对列表列中的每个元素创建新行/列

本章将学习更通用的函数式编程工具（functional programming tools），其核心特征是能够接收其他函数作为参数。

本章主要使用dplyr、purrr包。

library(tidyverse)
library(purrr)

26.2 across()

如下是一个简单的 tibble，我们现在要统计观测数并计算每一列的中位数。

df <- tibble(
  a = rnorm(10),
  b = rnorm(10),
  c = rnorm(10),
  d = rnorm(10)
)

可以通过复制粘贴来完成：

df |> summarize(
  n = n(),
  a = median(a),
  b = median(b),
  c = median(c),
  d = median(d),
)
# A tibble: 1 × 5
#       n      a      b       c     d
#   <int>  <dbl>  <dbl>   <dbl> <dbl>
# 1    10 -0.246 -0.287 -0.0567 0.144

不过有个经验法则，“相同代码复制粘贴不得超过两次”，如果列数有几十甚至几百个，复制粘贴就会变得非常繁琐。要想更简单直接，可以使用 across()：

df |> summarize(
  n = n(),
  across(a:d, median),
)
# A tibble: 1 × 5
#       n      a      b       c     d
#   <int>  <dbl>  <dbl>   <dbl> <dbl>
# 1    10 -0.246 -0.287 -0.0567 0.144

across() 有三个重要参数，前两个参数是刚需。第一个参数 .cols 指定要遍历的列，第二个参数 .fns 指定对每一列执行的操作。当需要对输出的列名进行额外操作时，则动用 .names 参数。

---

26.2.1 使用 .cols 选择列

across() 的第一个参数 .cols 用于选择要转换的列。它与 select() 的语法一致，可以使用 starts_with() 和 ends_with() 等函数按列名选择列。

此外还有两个在 across() 中非常实用的选择器：everything() 和 where()。

• everything() 会选择所有未被分组的列：

df <- tibble(
  grp = sample(2, 10, replace = TRUE),
  a = rnorm(10),
  b = rnorm(10),
  c = rnorm(10),
  d = rnorm(10)
)

df |> 
  group_by(grp) |> 
  summarize(across(everything(), median))
# A tibble: 2 × 5
#     grp       a       b     c     d
#   <int>   <dbl>   <dbl> <dbl> <dbl>
# 1     1 -0.0935 -0.0163 0.363 0.364
# 2     2  0.312  -0.0576 0.208 0.565

分组列（如 grp）不会成为 across() 的对象，因为 summarize() 函数会自动保留分组列。

where() 按列类型选择列：

• where(is.numeric)选择所有数值列
• where(is.character)选择所有字符列
• where(is.Date)选择所有日期列
• where(is.POSIXct)选择所有日期时间列
• where(is.logical)选择所有逻辑列

这些选择器也可以用布尔代数组合。例如，!where(is.numeric) 选择所有非数值列，starts_with("a") & where(is.logical) 选择以 a 开头且为逻辑类型的列。

---

26.2.2 调用单个函数

across() 的第二个参数.fns 指定对每一列执行的操作。R 的一大特点是可以将一个函数（如 median、mean、str_flatten 等）作为参数传给另一个函数（如 across()）。

关键点在于：函数是传给 across() 调用的，因此函数名后不能加 ()，否则会报错：

df |> 
  group_by(grp) |> 
  summarize(across(everything(), median()))
  Error in `summarize()`:
ℹ In argument: `across(everything(), median())`.
Caused by error in `median.default()`:
! argument "x" is missing, with no default

这相当于直接调用函数但没提供输入，等价于下面这种情况：

median()
#> Error in median.default(): argument "x" is missing, with no default

---

26.2.3 内部调用函数

对于更复杂的情况，可能需要向across内部传入额外参数，或进行多种转换。比如下面这一例，数据中存在缺失值，median() 会保留NA：

rnorm_na <- function(n, n_na, mean = 0, sd = 1) {
  sample(c(rnorm(n - n_na, mean = mean, sd = sd), rep(NA, n_na)))
} # 此函数用于生成含NA的向量

df_miss <- tibble(
  a = rnorm_na(5, 1), # 生成5个数，其中1个NA
  b = rnorm_na(5, 1),
  c = rnorm_na(5, 2),
  d = rnorm(5)
)
df_miss |> 
  summarize(
    across(a:d, median),
    n = n()
  )
# A tibble: 1 × 5
#       a     b     c     d     n
#   <dbl> <dbl> <dbl> <dbl> <int>
# 1    NA    NA    NA  1.15     5

为移除缺失值并计算中位数，可在across()中自定义一个函数传入：

df_miss |> 
  summarize(
    across(a:d, function(x) median(x, na.rm = TRUE)),
    n = n()
  )

或用简洁写法 \() 创建匿名函数：

df_miss |> 
  summarize(
    across(a:d, \(x) median(x, na.rm = TRUE)),
    n = n()
  )

相当于展开为：

df_miss |> 
  summarize(
    a = median(a, na.rm = TRUE),
    b = median(b, na.rm = TRUE),
    c = median(c, na.rm = TRUE),
    d = median(d, na.rm = TRUE),
    n = n()
  )

若想知道有多少缺失值，可传入多个函数，用命名列表list()：

df_miss |> 
  summarize(
    across(a:d, list(
      median = \(x) median(x, na.rm = TRUE),
      n_miss = \(x) sum(is.na(x))
    )),
    n = n()
  )

---

26.2.4 对列命名

使用 .names 参数自定义列名，例如刚刚的例子：

df_miss |> 
  summarize(
    across(
      a:d,
      list(
        median = \(x) median(x, na.rm = TRUE),
        n_miss = \(x) sum(is.na(x))
      ),
      .names = "{.fn}_{.col}"
    ),
    n = n(),
  )

.names 参数在配合 mutate() 使用时尤为重要。默认情况下，across() 的输出会覆盖原列。如要保留原列并创建新列，可以自定义列名：

df_miss |> 
  mutate(
    across(a:d, \(x) coalesce(x, 0), .names = "{.col}_na_zero")
  )
#> # A tibble: 5 × 8
#>        a      b      c     d a_na_zero b_na_zero c_na_zero d_na_zero
#>    <dbl>  <dbl>  <dbl> <dbl>     <dbl>     <dbl>     <dbl>     <dbl>
#> 1  0.434 -1.25  NA     1.60      0.434    -1.25      0         1.60 
#> 2 NA     -1.43  -0.297 0.776     0        -1.43     -0.297     0.776
#> 3 -0.156 -0.980 NA     1.15     -0.156    -0.980     0         1.15 
#> 4 -2.61  -0.683 -0.785 2.13     -2.61     -0.683    -0.785     2.13 
#> 5  1.11  NA     -0.387 0.704     1.11      0        -0.387     0.704

---

26.2.5 筛选

虽然 across() 与 summarize() 、 mutate() 配合得很好，但在 filter() 中使用起来不太方便。因此 dplyr 提供了 if_any() 和 if_all() 两个变体：

df_miss |> filter(if_any(a:d, is.na))
# 等价于：filter(is.na(a) | is.na(b) | is.na(c) | is.na(d))
#> # A tibble: 4 × 4
#>        a      b      c     d
#>    <dbl>  <dbl>  <dbl> <dbl>
#> 1  0.434 -1.25  NA     1.60 
#> 2 NA     -1.43  -0.297 0.776
#> 3 -0.156 -0.980 NA     1.15 
#> 4  1.11  NA     -0.387 0.704

df_miss |> filter(if_all(a:d, is.na))
# 等价于：filter(is.na(a) & is.na(b) & is.na(c) & is.na(d))
#> # A tibble: 0 × 4
#> # ℹ 4 variables: a <dbl>, b <dbl>, c <dbl>, d <dbl>

---

26.2.6 在函数中使用 across()

across() 支持在函数编程中处理多个列。例如，以下函数将所有日期列展开为 year、month、day：

expand_dates <- function(df) {
  df |> 
    mutate(
      across(where(is.Date), list(year = year, month = month, day = mday))
    )
}

df_date <- tibble(
  name = c("Amy", "Bob"),
  date = ymd(c("2009-08-03", "2010-01-16"))
)

df_date |> 
  expand_dates()
#> # A tibble: 2 × 5
#>   name  date       date_year date_month date_day
#>   <chr> <date>         <dbl>      <dbl>    <int>
#> 1 Amy   2009-08-03      2009          8        3
#> 2 Bob   2010-01-16      2010          1       16

也可结合embracing选择动态列：

summarize_means <- function(df, summary_vars = where(is.numeric)) {
  df |> 
    summarize(
      across({{ summary_vars }}, \(x) mean(x, na.rm = TRUE)),
      n = n(),
      .groups = "drop"
    )
}

---

26.2.7 与 pivot_longer() 比较

很多 across() 的用法可以用 pivot_longer() 实现。

例如下面这个tibble：

df |> 
  summarize(across(a:d, list(median = median, mean = mean)))
#> # A tibble: 1 × 8
#>   a_median a_mean b_median b_mean c_median c_mean d_median d_mean
#>      <dbl>  <dbl>    <dbl>  <dbl>    <dbl>  <dbl>    <dbl>  <dbl>
#> 1   0.0380  0.205  -0.0163 0.0910    0.260 0.0716    0.540  0.508

可改写为：

long <- df |> 
  pivot_longer(a:d) |> 
  group_by(name) |> 
  summarize(
    median = median(value),
    mean = mean(value)
  )
long
#> # A tibble: 4 × 3
#>   name   median   mean
#>   <chr>   <dbl>  <dbl>
#> 1 a      0.0380 0.205 
#> 2 b     -0.0163 0.0910
#> 3 c      0.260  0.0716
#> 4 d      0.540  0.508

再用 pivot_wider() 恢复原结构：

long |> 
  pivot_wider(
    names_from = name,
    values_from = c(median, mean),
    names_vary = "slowest",
    names_glue = "{name}_{.value}"
  )
#> # A tibble: 1 × 8
#>   a_median a_mean b_median b_mean c_median c_mean d_median d_mean
#>      <dbl>  <dbl>    <dbl>  <dbl>    <dbl>  <dbl>    <dbl>  <dbl>
#> 1   0.0380  0.205  -0.0163 0.0910    0.260 0.0716    0.540  0.508

在需要同时处理列组（如带有权重）时，across() 无法满足，但 pivot_longer() 可以：

df_paired <- tibble(
  a_val = rnorm(10), a_wts = runif(10),
  b_val = rnorm(10), b_wts = runif(10),
  c_val = rnorm(10), c_wts = runif(10),
  d_val = rnorm(10), d_wts = runif(10)
)

df_long <- df_paired |> 
  pivot_longer(
    everything(), 
    names_to = c("group", ".value"), 
    names_sep = "_"
  )
df_long
#> # A tibble: 40 × 3
#>   group    val   wts
#>   <chr>  <dbl> <dbl>
#> 1 a      0.715 0.518
#> 2 b     -0.709 0.691
#> 3 c      0.718 0.216
#> 4 d     -0.217 0.733
#> 5 a     -1.09  0.979
#> 6 b     -0.209 0.675
#> # ℹ 34 more rows

df_long |> 
  group_by(group) |> 
  summarize(mean = weighted.mean(val, wts))
#> # A tibble: 4 × 2
#>   group    mean
#>   <chr>   <dbl>
#> 1 a      0.126 
#> 2 b     -0.0704
#> 3 c     -0.360 
#> 4 d     -0.248

26.3 读取多个文件

上一节讲述使用 dplyr::across() 对多列重复执行相同的操作。本节则介绍用 purrr::map() 对目录中的所有文件执行批量操作。

现有一个目录，我们要读取里面存有的多个 Excel 文件。手动复制粘贴如下：

data2019 <- readxl::read_excel("data/y2019.xlsx")
data2020 <- readxl::read_excel("data/y2020.xlsx")
data2021 <- readxl::read_excel("data/y2021.xlsx")
data2022 <- readxl::read_excel("data/y2022.xlsx")

然后用 dplyr::bind_rows() 合并：

data <- bind_rows(data2019, data2020, data2021, data2022)

但如果文件有几百个，这种方法难以实现。下面介绍如何自动化这一过程。

---

26.3.1 列出目录中的文件

list.files() 可以列出目录中的文件，常用参数：

• path：目录路径。
• pattern：用正则表达式筛选文件名（如 [.]xlsx$ 匹配 .xlsx 文件）。
• full.names：是否包含完整路径（建议设为 TRUE）。

例如列出 gapminder 数据目录中的所有 .xlsx 文件：

paths <- list.files("data/gapminder", pattern = "[.]xlsx$", full.names = TRUE)
paths
#>  [1] "data/gapminder/1952.xlsx" "data/gapminder/1957.xlsx" ...

---

26.3.2 列表

手动读取多个文件会生成多个变量，难以管理。更好的方式是用 列表 存储：

files <- list(
  readxl::read_excel("data/gapminder/1952.xlsx"),
  readxl::read_excel("data/gapminder/1957.xlsx"),
  ...
)

用 files[[i]] 提取第 i 个元素：

files[[3]]  # 查看第3个文件的数据

---

26.3.3 purrr::map() 和 list_rbind()

map(x, f) 对向量 x 的每个元素应用函数 f，相当于：

list(f(x[[1]]), f(x[[2]]), ..., f(x[[n]]))

用 map() 批量读取文件并使用list_rbind()合并成一个数据框：

files <- map(paths, readxl::read_excel)  # 读取所有文件
combined_data <- list_rbind(files)       # 合并为单个数据框

或直接管道操作：

paths |> 
  map(readxl::read_excel) |> 
  list_rbind()

map()也可传递额外参数。例如只读取每文件的第一行：

paths |> 
  map(\(path) readxl::read_excel(path, n_max = 1)) |> 
  list_rbind()

• 前面提到过，\(path) 是匿名函数简写，等价于 function(path)。
• n_max = 1 参数表示只读取首行。

---

26.3.4 路径中的数据

有时文件名本身包含的有用信息并未在单个文件中记录。为了将该信息添加到最终的数据框中，需要执行两步操作：

1. 用 set_names() 函数为路径向量命名。set_names() 可以接受一个函数作为参数。

   例如下面使用 basename() 从完整路径中提取出文件名：

paths |> set_names(basename)
#>                  1952.xlsx                  1957.xlsx 
#> "data/gapminder/1952.xlsx" "data/gapminder/1957.xlsx" 
#>                  1962.xlsx                  1967.xlsx 
#> "data/gapminder/1962.xlsx" "data/gapminder/1967.xlsx" 
#>                  1972.xlsx                  1977.xlsx 
#> "data/gapminder/1972.xlsx" "data/gapminder/1977.xlsx" 
#>                  1982.xlsx                  1987.xlsx 
#> "data/gapminder/1982.xlsx" "data/gapminder/1987.xlsx" 
#>                  1992.xlsx                  1997.xlsx 
#> "data/gapminder/1992.xlsx" "data/gapminder/1997.xlsx" 
#>                  2002.xlsx                  2007.xlsx 
#> "data/gapminder/2002.xlsx" "data/gapminder/2007.xlsx"

这些名称会自动传递给所有的 map 函数，因此生成的数据框列表也会带有这些名称：

files <- paths |> 
  set_names(basename) |> 
  map(readxl::read_excel)

可以使用 [[]] 通过名称提取某个元素：

files[["1962.xlsx"]]
#> # A tibble: 142 × 5
#>   country     continent lifeExp      pop gdpPercap
#>   <chr>       <chr>       <dbl>    <dbl>     <dbl>
#> 1 Afghanistan Asia         32.0 10267083      853.
#> 2 Albania     Europe       64.8  1728137     2313.
#> 3 Algeria     Africa       48.3 11000948     2551.
#> # ℹ 139 more rows

2. 接着使用 list_rbind() 的 names_to 参数将这些名称保存为名为 year 的新列，再用 readr::parse_number() 从字符串中提取数值部分：

paths |> 
  set_names(basename) |> 
  map(readxl::read_excel) |> 
  list_rbind(names_to = "year") |> 
  mutate(year = parse_number(year))
#> # A tibble: 1,704 × 6
#>    year country     continent lifeExp      pop gdpPercap
#>   <dbl> <chr>       <chr>       <dbl>    <dbl>     <dbl>
#> 1  1952 Afghanistan Asia         28.8  8425333      779.
#> 2  1952 Albania     Europe       55.2  1282697     1601.
#> 3  1952 Algeria     Africa       43.1  9279525     2449.
#> # ℹ 1,701 more rows

在更复杂情形中，目录名中可能含有多个信息片段。此时使用 set_names()（不加参数）保留完整路径，并结合 tidyr::separate_wider_delim() 等函数将其拆分为新列：

paths |> 
  set_names() |> 
  map(readxl::read_excel) |> 
  list_rbind(names_to = "year") |> 
  separate_wider_delim(year, delim = "/", names = c(NA, "dir", "file")) |> 
  separate_wider_delim(file, delim = ".", names = c("file", "ext"))
#> # A tibble: 1,704 × 8
#>   dir       file  ext   country     continent lifeExp      pop gdpPercap
#>   <chr>     <chr> <chr> <chr>       <chr>       <dbl>    <dbl>     <dbl>
#> 1 gapminder 1952  xlsx  Afghanistan Asia         28.8  8425333      779.
#> 2 gapminder 1952  xlsx  Albania     Europe       55.2  1282697     1601.
#> 3 gapminder 1952  xlsx  Algeria     Africa       43.1  9279525     2449.
#> # ℹ 1,701 more rows

---

26.3.5 保存

将上述成果保存为csv：

gapminder <- paths |> 
  set_names(basename) |> 
  map(readxl::read_excel) |> 
  list_rbind(names_to = "year") |> 
  mutate(year = parse_number(year))

write_csv(gapminder, "gapminder.csv")

今后再处理这个问题时，只需读取一个 CSV 文件即可。如果是体积更大、结构更复杂的数据集，使用 Parquet 格式更合适。

另外，建议将项目数据预处理脚本命名为 0-cleanup.R，文件名前的 0 表明其需尽快处理。

---

26.3.5.0.1 26.3.6 多次简单迭代

上述示例碰巧读取的是整洁的数据集，大多数情况下需要额外的清理工作。有两种清理方法：用一个复杂的函数进行一次迭代，或是用多个简单函数进行多轮迭代。

但实践中，分步执行的方式往往能让代码质量更高。

例如，要读取多个文件，过滤缺失值，转换数据格式（pivot），然后合并成一个数据集。一种方式是写一个函数完成所有操作，然后用 map() 一次调用：

process_file <- function(path) {
  df <- read_csv(path)
  
  df |> 
    filter(!is.na(id)) |> 
    mutate(id = tolower(id)) |> 
    pivot_longer(jan:dec, names_to = "month")
}

paths |> 
  map(process_file) |> 
  list_rbind()

另一种做法是将上面新定义的 process_file() 中每一步分别应用到所有文件上：

paths |> 
  map(read_csv) |> 
  map(\(df) df |> filter(!is.na(id))) |> 
  map(\(df) df |> mutate(id = tolower(id))) |> 
  map(\(df) df |> pivot_longer(jan:dec, names_to = "month")) |> 
  list_rbind()

推荐后一种做法，更易形成整体视角，并在最终得到更高质量的结果。

---

26.3.5.0.2 26.3.7 异构数据

有时数据框之间结构差异太大，导致无法直接用 map() 及 list_rbind()，要么报错，要么合并出一个没法用的结果。

遇到异构数据，第一步依然是先把所有文件读入：

files <- paths |> 
  map(readxl::read_excel)

接下来，需要将这些数据框的结构单独提取，以便进一步分析。下面的新定义函数 df_types 可以将每个数据框转换为包含每列信息的 tibble：

df_types <- function(df) {
  tibble(
    col_name = names(df), 
    col_type = map_chr(df, vctrs::vec_ptype_full),
    n_miss = map_int(df, \(x) sum(is.na(x)))
  )
}

下面便可将该函数应用到所有文件，再通过 pivot 操作观察列类型的异同：

files |> 
  map(df_types) |> 
  list_rbind(names_to = "file_name") |> 
  select(-n_miss) |> 
  pivot_wider(names_from = col_name, values_from = col_type)
#> # A tibble: 12 × 6
#>   file_name country   continent lifeExp pop    gdpPercap
#>   <chr>     <chr>     <chr>     <chr>   <chr>  <chr>    
#> 1 1952.xlsx character character double  double double   
#> 2 1957.xlsx character character double  double double   
#> 3 1962.xlsx character character double  double double   
#> 4 1967.xlsx character character double  double double   
#> 5 1972.xlsx character character double  double double   
#> 6 1977.xlsx character character double  double double   
#> # ℹ 6 more rows

---

26.3.5.0.3 26.3.8 错误处理

有时数据结构太复杂，甚至无法一次性读取所有文件。此时 map() 可能会暴露出其弊端：要么所有文件都读取成功，要么因为某个错误一个都不读。

为解决此问题，purrr提供了一个函数操作器：possibly()，可以修改函数的默认行为，使其在出错时返回一个指定的值，而不是抛出错误。

例如：

files <- paths |> 
  map(possibly(\(path) readxl::read_excel(path), NULL))

data <- files |> list_rbind()

• read_excel() 会读取每个文件，若失败则返回 NULL，不会中断整个流程。
• list_rbind() 会自动忽略 NULL。

此时，已成功读取的文件可以继续处理，接下来可排查失败文件。先找出失败文件路径：

failed <- map_vec(files, is.null)
paths[failed]
#> character(0)

然后便可对这些失败文件逐一调用导入函数，进一步诊断失败原因并做出相应处理。

26.4 保存多个输出

map() 可以把多个文件读取进一个对象中。那么反过来，如何将一个或多个 R 对象保存到一个或多个文件中？下面通过三个示例来探讨：

• 将多个数据框保存到一个数据库中；
• 将多个数据框分别保存为多个 .csv 文件；
• 将多个图像保存为多个 .png 文件。

---

26.4.1 写入数据库

有时在同时处理多个文件时，无法一次性将所有数据读入内存，不能使用 map(files, read_csv)。

我们不妨将数据全部加载到数据库中。

运气好的话，数据库包可能会提供一个便捷函数以完成此操作。例如 duckdb 提供的 duckdb_read_csv()：

con <- DBI::dbConnect(duckdb::duckdb())
duckdb::duckdb_read_csv(con, "gapminder", paths)

不过这毕竟太吃运气，我们必须学会通解。

首先创建一个模板表，需要包含所有列。以 gapminder 数据为例，我们可以读取一个文件并添加年份：

template <- readxl::read_excel(paths[[1]])
template$year <- 1952
# A tibble: 142 × 6
#>   country     continent lifeExp      pop gdpPercap  year
#>   <chr>       <chr>       <dbl>    <dbl>     <dbl> <dbl>
#> 1 Afghanistan Asia         28.8  8425333      779.  1952
#> 2 Albania     Europe       55.2  1282697     1601.  1952
#> ...

然后连接数据库并使用 DBI::dbCreateTable() 将模板转换为数据库表，此函数会根据模板中的变量名和类型来定义结构。

con <- DBI::dbConnect(duckdb::duckdb())
DBI::dbCreateTable(con, "gapminder", template)

此时查看数据库表，变量结构已经就绪：

con |> tbl("gapminder")
# ℹ 6 variables: country <chr>, continent <chr>, lifeExp <dbl>, pop <dbl>,
#> #   gdpPercap <dbl>, year <dbl>

接着，我们需要一个函数以接收文件路径，将数据读入， R 并附加到数据库表中：

append_file <- function(path) {
  df <- readxl::read_excel(path)
  df$year <- parse_number(basename(path))
  
  DBI::dbAppendTable(con, "gapminder", df)
}

接下来对每个路径调用 append_file()即可。此处函数的返回值不重要，故不使用map()而使用 walk()：

paths |> walk(append_file)

walk也是 purrr 包中的函数，专门用于执行有副作用的操作（如保存文件、打印输出、绘图等），用法与 map 的类似，但忽略返回值，专注于过程。

查看数据是否都已导入：

con |> 
  tbl("gapminder") |> 
  count(year)
#> # Source:   SQL [?? x 2]
#> # Database: DuckDB v1.3.2 [unknown@Linux 6.11.0-1018-azure:R 4.5.1/:memory:]
#>    year     n
#>   <dbl> <dbl>
#> 1  1952   142
#> 2  1957   142
#> 3  1962   142
#> 4  1972   142
#> 5  1982   142
#> 6  1992   142
#> # ℹ more rows

---

26.4.2 写入 CSV 文件

将多个数据框写入多个 CSV 文件也是同理。

现在我们需要将 ggplot2::diamonds 数据按 clarity 分组，每组写一个 csv 文件。首先，使用 group_nest() 创建每个 clarity 的子数据集：

by_clarity <- diamonds |> 
  group_nest(clarity)

by_clarity
#> # A tibble: 8 × 2
#>   clarity               data
#>   <ord>   <list<tibble[,9]>>
#> 1 I1               [741 × 9]
#> 2 SI2            [9,194 × 9]
#> 3 SI1           [13,065 × 9]
#> 4 VS2           [12,258 × 9]
#> 5 VS1            [8,171 × 9]
#> 6 VVS2           [5,066 × 9]
#> # ℹ 2 more rows

再使用 mutate() 和 str_glue() 添加每个数据集对应的文件路径：

by_clarity <- by_clarity |> 
  mutate(path = str_glue("diamonds-{clarity}.csv"))

by_clarity
#> # A tibble: 8 × 3
#>   clarity               data path             
#>   <ord>   <list<tibble[,9]>> <glue>           
#> 1 I1               [741 × 9] diamonds-I1.csv  
#> 2 SI2            [9,194 × 9] diamonds-SI2.csv 
#> 3 SI1           [13,065 × 9] diamonds-SI1.csv 
#> 4 VS2           [12,258 × 9] diamonds-VS2.csv 
#> 5 VS1            [8,171 × 9] diamonds-VS1.csv 
#> 6 VVS2           [5,066 × 9] diamonds-VVS2.csv
#> # ℹ 2 more rows

可以选择手动逐个保存文件：

write_csv(by_clarity$data[[1]], by_clarity$path[[1]])
write_csv(by_clarity$data[[2]], by_clarity$path[[2]])
...

现在有两个参数在变化，而不仅仅是一个，与之前使用map()的情况略有不同。这意味着我们需要map()的加强版：map2()，它可以同时改变第一个和第二个参数。而由于输出结果仍然无关紧要，因此使用walk()的加强版walk2()。

walk2(by_clarity$data, by_clarity$path, write_csv)

---

26.4.3 保存图像

创建、保存多个图像亦然。

首先定义一个绘图函数：

carat_histogram <- function(df) {
  ggplot(df, aes(x = carat)) + geom_histogram(binwidth = 0.1)  
}

carat_histogram(by_clarity$data[[1]])

现在为每个数据集都生成图像并指定文件名：

by_clarity <- by_clarity |> 
  mutate(
    plot = map(data, carat_histogram),
    path = str_glue("clarity-{clarity}.png")
  )

然后使用 walk2() 和 ggsave() 保存图像：

walk2(
  by_clarity$path,
  by_clarity$plot,
  \(path, plot) ggsave(path, plot, width = 6, height = 6)
)

这等价于：

ggsave(by_clarity$path[[1]], by_clarity$plot[[1]], width = 6, height = 6)
ggsave(by_clarity$path[[2]], by_clarity$plot[[2]], width = 6, height = 6)
...