L06

---

for 循环

命令式编程（imperative programming）中的重复执行范式

library(tidyverse)

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.5.1     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.1
✔ purrr     1.0.2     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

set.seed(1234)
df <- tibble(
  a = rnorm(10),
 b = rnorm(10),
 c = rnorm(10)
)
# 设置随机数种子

# 计算各列的均值
library(tidyverse)
mean(df$a)

[1] -0.3831574

mean(df$b)

[1] -0.1181707

mean(df$c)

[1] -0.3879468

# for循环的三个组成部分
output <- vector("double", ncol(df)) # 1. output 输出
for(i in seq_along(df)) { # 2. sequence 循环序列
  output[[i]] <- mean(df[[i]]) # 3. body 循环体
}
output

[1] -0.3831574 -0.1181707 -0.3879468

---

for循环的三种模式

1、for(x in xs)：逐个元素循环

2、for(nm in names(xs))：逐个名字循环，在循环体中用 xs[[nm]] 得到命名向量 xs 元素的值。

3、for(i in seq_along(xs))：逐个数值索引循环，这是最通用的模式。

特殊情况1（即时修改）

#直接调用，完成即时修改
rescale01 <- function(x) {
 rng <- range(x, na.rm = TRUE)
 (x - rng[1]) / (rng[2] - rng[1])
}       
for(i in seq_along(df)) {
 df[[i]] <- rescale01(df[[i]]) # 不要使用[]
}
df

# A tibble: 10 × 3
       a      b     c
   <dbl>  <dbl> <dbl>
 1 0.332 0.153  0.782
 2 0.765 0      0.473
 3 1     0.0651 0.498
 4 0     0.311  0.943
 5 0.809 0.573  0.373
 6 0.831 0.260  0    
 7 0.516 0.143  1    
 8 0.524 0.0255 0.210
 9 0.519 0.0472 0.708
10 0.424 1      0.253

特殊情况2（事前无法确定输出的长度）

# 完成循环后再处理，不被输出长度限制
set.seed(1234)
means <- c(0, 1, 2)
out <- vector("list", length(means))
for(i in seq_along(means)) {
 n <- sample(100, 1)
 print(glue::glue("L#{i}: n={n}"))
 out[[i]] <- rnorm(n, means[[i]])
}

L#1: n=28
L#2: n=79
L#3: n=2

out <- unlist(out)
str(out, vec.len = 2.5)

 num [1:109] 0.312 0.314 0.359 ...

特殊情况3（事前无法确定循环的次数）

flip <- function() sample(c("T", "H"), 1)
set.seed(111)
nheads <- 0
flips <- character()
repeat {
 H_T <- flip()
 if(H_T == "H") {
 nheads <- nheads + 1
 } else {
 nheads <- 0 # 重新计数
 }
 flips <- c(flips, H_T)
 if(nheads >= 3) break
}
flips

 [1] "H" "T" "H" "T" "T" "T" "T" "T" "T" "H" "H" "H"

函数式编程

# 定义函数，计算数据框每列的均值
col_mean <- function(df) {
 out <- vector("double", length(df))
 for(i in seq_along(df)) {
 out[i] <- mean(df[[i]])
 }
 out
}
# 调用函数
col_mean(df)

[1] 0.5721460 0.2578086 0.5241121

# ... 使用函数式编程
# 函数作为参数 -> 泛函
col_summary <- function(df, .fun) {
 out <- vector("double", length(df))
 for(i in seq_along(df)) {
 out[i] <- .fun(df[[i]])
 }
 out
}
col_summary(df, mean)

[1] 0.5721460 0.2578086 0.5241121

col_summary(df, sd)

[1] 0.2903053 0.3126152 0.3292211

purrr 包

map族函数

1、易读、易写、易用

map(df, mean) #返回列表

$a
[1] 0.572146

$b
[1] 0.2578086

$c
[1] 0.5241121

map_dbl(df, mean) # 返回实数向量

        a         b         c 
0.5721460 0.2578086 0.5241121 

♥♥♥ 相比 for 循环，更简洁，适用适合用 |>管道操作符链接，关注函数

2、参数 .f 支持快捷写法

# 匿名函数
models <- mtcars |> 
 split(~cyl) |> # 得到3个命名列表
 map(function(df)
 lm(mpg ~ wt, data = df))
# map(\(df) lm(mpg ~ wt, data = df))
# 将匿名函数改写为单侧公式（但不推荐）
# i.e., purr-style lambda
models <- mtcars |> 
 split(~cyl) |> 
 map(~ lm(mpg ~ wt, data = .x))
str(models, max.level = 1)

List of 3
 $ 4:List of 12
  ..- attr(*, "class")= chr "lm"
 $ 6:List of 12
  ..- attr(*, "class")= chr "lm"
 $ 8:List of 12
  ..- attr(*, "class")= chr "lm"

👇简化后

# 匿名函数
models |> 
 map(summary) |> 
 map_dbl(\(x) x$r.squared)

        4         6         8 
0.5086326 0.4645102 0.4229655 

# 直接使用 字符向量 提取元素
# 结果同上，从略
models |> 
 map(summary) |> 
 map_dbl("r.squared")

        4         6         8 
0.5086326 0.4645102 0.4229655 

#知道元素的具体位置也可直接使用

3、多个输入 map2()、pmap() 和 imap()

map2()

# 1个输入用map()
mu <- list(5, 10, -3)
mu |> map(\(m) rnorm(m, n = 5))

[[1]]
[1] 3.502573 3.989812 4.051524 4.506038 4.826326

[[2]]
[1]  9.593401 11.845636 10.394054 10.797529  8.433335

[[3]]
[1] -3.085851 -3.359139 -4.193609 -2.635813 -2.638338

# 2个输入呢？
mu <- list(5, 10, -3)
sigma <- list(1, 5, 10)
# 还是改用map2()吧，:)
set.seed(1234)
map2(mu, sigma, rnorm, n = 5) |> 
 str() # 结果相同

List of 3
 $ : num [1:5] 3.79 5.28 6.08 2.65 5.43
 $ : num [1:5] 12.53 7.13 7.27 7.18 5.55
 $ : num [1:5] -7.77 -12.98 -10.76 -2.36 6.59

pmap()

#此时样本数n也出现了变化
n <- list(1, 2, 3)
args1 <- list(n, mu, sigma)
args1 |>
 pmap(rnorm) |> str()

List of 3
 $ : num 4.89
 $ : num [1:2] 7.44 5.44
 $ : num [1:3] -11.37 21.16 -1.66

# 默认为位置匹配
args1 <- list(n, mu, sigma)
args1 |>
 pmap(rnorm) |> str()

List of 3
 $ : num 4.51
 $ : num [1:2] 7.8 12.3
 $ : num [1:3] -9.94 -17.48 2.75

# 使用命名参数列表，匹配.f函数的参数名
# 也可用数据框作为.l参数的取值
args2 <- list(mean = mu, 
 sd = sigma, 
 n = n)
args2 |> 
 pmap(rnorm) |> str()

List of 3
 $ : num 3.98
 $ : num [1:2] 9.92 5.32
 $ : num [1:3] 8.02 -7.76 -10.09

imap()

❤当输入向量 .x 的元素有名称时，它是 map2(.x, names(.x), …) 的简便写法；当输入向量 .x 的元素没有名称时， 它是 map2(.x, seq_along(.x), …) 的简便写法。

# 元素没有名称，.f 第2个参数为元素位置
imap_chr(sample(LETTERS[1:4]), 
 \(x, i) paste0(i, " -> ", x))

[1] "1 -> D" "2 -> A" "3 -> C" "4 -> B"

# 元素有名称，.f 第2个参数为元素名
lst <- map(1:4, ~ sample(1000, 10))
names(lst) <- paste0("#", 1:4)
imap_chr(
 lst, 
 \(x, i) glue::glue(
 "样本{i} 的最大值为 {max(x)}")
)

                     #1                      #2                      #3 
"样本#1 的最大值为 959" "样本#2 的最大值为 951" "样本#3 的最大值为 838" 
                     #4 
"样本#4 的最大值为 959" 

4、不同输出项：modify(.x, .f, …) 、 walk(.x, .f, …)

modify()、modify2() 和 imodify() 返回与输入向量 .x 的类 class 相同的向量

df <- data.frame(
 x = 1:3,
 y = 6:4
)
modify(df, \(x) x * 2)

  x  y
1 2 12
2 4 10
3 6  8

#modify()并不会“原地修改”输入向量 .x，而只是返回修改后的版本。
#如果要永久保留修改，就必须手动将返回结果赋值给变量。
df <- modify(df, \(x) x * 2)

walk()

walk()、walk2()、iwalk() 和 pwalk()：

调用函数不是为了函数的返回值，而是函数的“副作用”（如数据存盘）；这些函数都会不可见地返回第 1 个输入项。

tmp <- tempdir()
gs <- mtcars |> 
 split(~cyl) |> 
 map(~ ggplot(., aes(wt, mpg)) + 
 geom_point())
fs <- str_c("cyl-", names(gs), ".pdf")
walk2(fs, gs, ggsave, path = tmp)

Saving 7 x 5 in image
Saving 7 x 5 in image
Saving 7 x 5 in image

list.files(tmp, pattern = "^cyl-")

[1] "cyl-4.pdf" "cyl-6.pdf" "cyl-8.pdf"

其他purrr包函数

# keep(.x, .p, ...) | discard()
iris |> 
 keep(is.factor) |> 
 str(vec.len = 1)

'data.frame':   150 obs. of  1 variable:
 $ Species: Factor w/ 3 levels "setosa","versicolor",..: 1 1 ...

# every(.x, .p, ...) | some() | none()
list(1:5, letters) |> 
 some(is_character)

[1] TRUE

set.seed(1234)
(x <- sample(9))

[1] 6 5 4 1 8 2 7 9 3

# detect(.x, .f, ..., 
# .dir = c("forward", "backward"), 
# .right = NULL,.default = NULL)
# detect_index()
x |> detect(~ . > 2)

[1] 6

# head_while(.x, .p, ...)|tail_while()
x |> head_while(~ . > 2)

[1] 6 5 4

reduce(),accumulate()

dfs <- list(
 age = tibble(name = "Jo", age = 30),
 sex = tibble(name = c("Jo", "An"), 
 sex = c("M", "F")),
 trt = tibble(name = "An", 
 treatment = "A")
)
dfs |> reduce(full_join)

Joining with `by = join_by(name)`
Joining with `by = join_by(name)`

# A tibble: 2 × 4
  name    age sex   treatment
  <chr> <dbl> <chr> <chr>    
1 Jo       30 M     <NA>     
2 An       NA F     A        

1:10 |> accumulate(`+`)

 [1]  1  3  6 10 15 21 28 36 45 55

reduce() 和 accumulate() 支持的是二元函数(有两个输入项的函数)

safely()、quietly() 和 possibly() [函数运算符]

safely() 会调整函数的行为（副词），让调整后的函数不再抛出错误，而是返回包含两个元素

result 和 error 的列表；通过 otherwise 参数设定错误时默认值，possibly() 总是成功；而quietly() 则会捕捉命令的结果、输出、警告和消息。

x <- list(1, 10, "a")
y <- x |> map(safely(log)); str(y)

List of 3
 $ :List of 2
  ..$ result: num 0
  ..$ error : NULL
 $ :List of 2
  ..$ result: num 2.3
  ..$ error : NULL
 $ :List of 2
  ..$ result: NULL
  ..$ error :List of 2
  .. ..$ message: chr "non-numeric argument to mathematical function"
  .. ..$ call   : language .Primitive("log")(x, base)
  .. ..- attr(*, "class")= chr [1:3] "simpleError" "error" "condition"

y <- list_transpose(y); str(y)

List of 2
 $ result:List of 3
  ..$ : num 0
  ..$ : num 2.3
  ..$ : NULL
 $ error :List of 3
  ..$ : NULL
  ..$ : NULL
  ..$ :List of 2
  .. ..$ message: chr "non-numeric argument to mathematical function"
  .. ..$ call   : language .Primitive("log")(x, base)
  .. ..- attr(*, "class")= chr [1:3] "simpleError" "error" "condition"

purrr 包 与 列表列

将结果存入列表，避免后续重复计算

1、生成列表列（list column）

gapminder::gapminder

# A tibble: 1,704 × 6
   country     continent  year lifeExp      pop gdpPercap
   <fct>       <fct>     <int>   <dbl>    <int>     <dbl>
 1 Afghanistan Asia       1952    28.8  8425333      779.
 2 Afghanistan Asia       1957    30.3  9240934      821.
 3 Afghanistan Asia       1962    32.0 10267083      853.
 4 Afghanistan Asia       1967    34.0 11537966      836.
 5 Afghanistan Asia       1972    36.1 13079460      740.
 6 Afghanistan Asia       1977    38.4 14880372      786.
 7 Afghanistan Asia       1982    39.9 12881816      978.
 8 Afghanistan Asia       1987    40.8 13867957      852.
 9 Afghanistan Asia       1992    41.7 16317921      649.
10 Afghanistan Asia       1997    41.8 22227415      635.
# ℹ 1,694 more rows

by_cnty <- gapminder::gapminder |> 
 tidyr::nest(
 data = -c(country, continent))
by_cnty

# A tibble: 142 × 3
   country     continent data             
   <fct>       <fct>     <list>           
 1 Afghanistan Asia      <tibble [12 × 4]>
 2 Albania     Europe    <tibble [12 × 4]>
 3 Algeria     Africa    <tibble [12 × 4]>
 4 Angola      Africa    <tibble [12 × 4]>
 5 Argentina   Americas  <tibble [12 × 4]>
 6 Australia   Oceania   <tibble [12 × 4]>
 7 Austria     Europe    <tibble [12 × 4]>
 8 Bahrain     Asia      <tibble [12 × 4]>
 9 Bangladesh  Asia      <tibble [12 × 4]>
10 Belgium     Europe    <tibble [12 × 4]>
# ℹ 132 more rows

library(tidyverse)
gapminder::gapminder |>
 tidyr::nest(
 .by = c(country, continent))

# A tibble: 142 × 3
   country     continent data             
   <fct>       <fct>     <list>           
 1 Afghanistan Asia      <tibble [12 × 4]>
 2 Albania     Europe    <tibble [12 × 4]>
 3 Algeria     Africa    <tibble [12 × 4]>
 4 Angola      Africa    <tibble [12 × 4]>
 5 Argentina   Americas  <tibble [12 × 4]>
 6 Australia   Oceania   <tibble [12 × 4]>
 7 Austria     Europe    <tibble [12 × 4]>
 8 Bahrain     Asia      <tibble [12 × 4]>
 9 Bangladesh  Asia      <tibble [12 × 4]>
10 Belgium     Europe    <tibble [12 × 4]>
# ℹ 132 more rows

gapminder::gapminder |>
 group_by(country, continent) |>
 tidyr::nest() # grouped_df

# A tibble: 142 × 3
# Groups:   country, continent [142]
   country     continent data             
   <fct>       <fct>     <list>           
 1 Afghanistan Asia      <tibble [12 × 4]>
 2 Albania     Europe    <tibble [12 × 4]>
 3 Algeria     Africa    <tibble [12 × 4]>
 4 Angola      Africa    <tibble [12 × 4]>
 5 Argentina   Americas  <tibble [12 × 4]>
 6 Australia   Oceania   <tibble [12 × 4]>
 7 Austria     Europe    <tibble [12 × 4]>
 8 Bahrain     Asia      <tibble [12 × 4]>
 9 Bangladesh  Asia      <tibble [12 × 4]>
10 Belgium     Europe    <tibble [12 × 4]>
# ℹ 132 more rows

gapminder::gapminder |>
 group_nest(country, continent)

# A tibble: 142 × 3
   country     continent               data
   <fct>       <fct>     <list<tibble[,4]>>
 1 Afghanistan Asia                [12 × 4]
 2 Albania     Europe              [12 × 4]
 3 Algeria     Africa              [12 × 4]
 4 Angola      Africa              [12 × 4]
 5 Argentina   Americas            [12 × 4]
 6 Australia   Oceania             [12 × 4]
 7 Austria     Europe              [12 × 4]
 8 Bahrain     Asia                [12 × 4]
 9 Bangladesh  Asia                [12 × 4]
10 Belgium     Europe              [12 × 4]
# ℹ 132 more rows

2、处理列表列

# mutate() + map(): 
# 将线性回归lm()应用于data列的每个元素，
# 回归结果（列表）存为新的列表列 model
by_cnty <- by_cnty |> 
 mutate(
 model = map(
 data, 
 \(df) lm(lifeExp ~ year, 
 data = df)
 )
 )
by_cnty |> select(-continent)

# A tibble: 142 × 3
   country     data              model 
   <fct>       <list>            <list>
 1 Afghanistan <tibble [12 × 4]> <lm>  
 2 Albania     <tibble [12 × 4]> <lm>  
 3 Algeria     <tibble [12 × 4]> <lm>  
 4 Angola      <tibble [12 × 4]> <lm>  
 5 Argentina   <tibble [12 × 4]> <lm>  
 6 Australia   <tibble [12 × 4]> <lm>  
 7 Austria     <tibble [12 × 4]> <lm>  
 8 Bahrain     <tibble [12 × 4]> <lm>  
 9 Bangladesh  <tibble [12 × 4]> <lm>  
10 Belgium     <tibble [12 × 4]> <lm>  
# ℹ 132 more rows

# 查看model列表列所保存对象的内容
# 提取model列表列的第1个元素
# 并查看列表元素的类 ...
by_cnty |> 
 pluck("model", 1) |> 
 class()

[1] "lm"

# ... 及其各构成元素的名称
by_cnty |> 
 pluck("model", 1) |> 
 names()

 [1] "coefficients"  "residuals"     "effects"       "rank"         
 [5] "fitted.values" "assign"        "qr"            "df.residual"  
 [9] "xlevels"       "call"          "terms"         "model"        

3、简化列表列

# 还是用mutate() + map_*()提取信息
by_cnty |> 
 mutate(
 coef_year = map_dbl(
 model, ~ coef(.x)[["year"]]
 )
 ) |> 
 select(-continent, -data)

# A tibble: 142 × 3
   country     model  coef_year
   <fct>       <list>     <dbl>
 1 Afghanistan <lm>       0.275
 2 Albania     <lm>       0.335
 3 Algeria     <lm>       0.569
 4 Angola      <lm>       0.209
 5 Argentina   <lm>       0.232
 6 Australia   <lm>       0.228
 7 Austria     <lm>       0.242
 8 Bahrain     <lm>       0.468
 9 Bangladesh  <lm>       0.498
10 Belgium     <lm>       0.209
# ℹ 132 more rows

使用更方便的broom包👇

# glance() | tidy() | augment()
by_cnty |>
 mutate(
 res = map(model, 
 broom::glance)) |>
 tidyr::unnest(res) |>
 select(-c(continent, data, model))

# A tibble: 142 × 13
   country   r.squared adj.r.squared sigma statistic  p.value    df logLik   AIC
   <fct>         <dbl>         <dbl> <dbl>     <dbl>    <dbl> <dbl>  <dbl> <dbl>
 1 Afghanis…     0.948         0.942 1.22      181.  9.84e- 8     1 -18.3  42.7 
 2 Albania       0.911         0.902 1.98      102.  1.46e- 6     1 -24.1  54.3 
 3 Algeria       0.985         0.984 1.32      662.  1.81e-10     1 -19.3  44.6 
 4 Angola        0.888         0.877 1.41       79.1 4.59e- 6     1 -20.0  46.1 
 5 Argentina     0.996         0.995 0.292    2246.  4.22e-13     1  -1.17  8.35
 6 Australia     0.980         0.978 0.621     481.  8.67e-10     1 -10.2  26.4 
 7 Austria       0.992         0.991 0.407    1261.  7.44e-12     1  -5.16 16.3 
 8 Bahrain       0.967         0.963 1.64      291.  1.02e- 8     1 -21.9  49.7 
 9 Banglade…     0.989         0.988 0.977     930.  3.37e-11     1 -15.7  37.3 
10 Belgium       0.995         0.994 0.293    1822.  1.20e-12     1  -1.20  8.40
# ℹ 132 more rows
# ℹ 4 more variables: BIC <dbl>, deviance <dbl>, df.residual <int>, nobs <int>

4、进一步的（探索性）分析

by_cnty |> 
 mutate(res = map(model, broom::glance)) |> 
 unnest(res) |> 
 ggplot(aes(continent, r.squared, colour = continent)) +
 geom_jitter(width = 0.3) +
 theme(legend.position = "none")

5、实验性的 dplyr::group_*() 和 dplyr::nest_by()

gapminder::gapminder |> 
 group_by(country, continent) |> 
 group_modify(
 \(df, key) # .f 的两个参数
 lm(lifeExp ~ year, data = df) |> 
 list() |> tibble(model = _)
 )

# A tibble: 142 × 3
# Groups:   country, continent [142]
   country     continent model 
   <fct>       <fct>     <list>
 1 Afghanistan Asia      <lm>  
 2 Albania     Europe    <lm>  
 3 Algeria     Africa    <lm>  
 4 Angola      Africa    <lm>  
 5 Argentina   Americas  <lm>  
 6 Australia   Oceania   <lm>  
 7 Austria     Europe    <lm>  
 8 Bahrain     Asia      <lm>  
 9 Bangladesh  Asia      <lm>  
10 Belgium     Europe    <lm>  
# ℹ 132 more rows

gapminder::gapminder |> 
 group_by(country, continent) |> 
 group_modify(
 ~ lm(lifeExp ~ year, data = .x) |> 
 broom::glance())

# A tibble: 142 × 14
# Groups:   country, continent [142]
   country     continent r.squared adj.r.squared sigma statistic  p.value    df
   <fct>       <fct>         <dbl>         <dbl> <dbl>     <dbl>    <dbl> <dbl>
 1 Afghanistan Asia          0.948         0.942 1.22      181.  9.84e- 8     1
 2 Albania     Europe        0.911         0.902 1.98      102.  1.46e- 6     1
 3 Algeria     Africa        0.985         0.984 1.32      662.  1.81e-10     1
 4 Angola      Africa        0.888         0.877 1.41       79.1 4.59e- 6     1
 5 Argentina   Americas      0.996         0.995 0.292    2246.  4.22e-13     1
 6 Australia   Oceania       0.980         0.978 0.621     481.  8.67e-10     1
 7 Austria     Europe        0.992         0.991 0.407    1261.  7.44e-12     1
 8 Bahrain     Asia          0.967         0.963 1.64      291.  1.02e- 8     1
 9 Bangladesh  Asia          0.989         0.988 0.977     930.  3.37e-11     1
10 Belgium     Europe        0.995         0.994 0.293    1822.  1.20e-12     1
# ℹ 132 more rows
# ℹ 6 more variables: logLik <dbl>, AIC <dbl>, BIC <dbl>, deviance <dbl>,
#   df.residual <int>, nobs <int>

gapminder::gapminder |> 
 nest_by(country, continent) |> 
 # nest_by() returns
 # a rowwise data frame
 mutate(
 model = list(lm(lifeExp ~ year, 
 data = data)),
 res = list(broom::glance(model))
 )

# A tibble: 142 × 5
# Rowwise:  country, continent
   country     continent               data model  res              
   <fct>       <fct>     <list<tibble[,4]>> <list> <list>           
 1 Afghanistan Asia                [12 × 4] <lm>   <tibble [1 × 12]>
 2 Albania     Europe              [12 × 4] <lm>   <tibble [1 × 12]>
 3 Algeria     Africa              [12 × 4] <lm>   <tibble [1 × 12]>
 4 Angola      Africa              [12 × 4] <lm>   <tibble [1 × 12]>
 5 Argentina   Americas            [12 × 4] <lm>   <tibble [1 × 12]>
 6 Australia   Oceania             [12 × 4] <lm>   <tibble [1 × 12]>
 7 Austria     Europe              [12 × 4] <lm>   <tibble [1 × 12]>
 8 Bahrain     Asia                [12 × 4] <lm>   <tibble [1 × 12]>
 9 Bangladesh  Asia                [12 × 4] <lm>   <tibble [1 × 12]>
10 Belgium     Europe              [12 × 4] <lm>   <tibble [1 × 12]>
# ℹ 132 more rows

6、purrr -> furrr

furrr: Apply Mapping Functions in Parallel using Futures

library(tictoc) # for timing R scripts

Warning: package 'tictoc' was built under R version 4.4.2

by_cnty <- gapminder::gapminder |> 
 tidyr::nest(
 data = -c(country, continent))
slow_lm <- function(...) {
 Sys.sleep(0.1)
 lm(...)
}
tic()
by_cnty |> 
 mutate(
 model = map(
 data, 
 \(df) slow_lm(lifeExp ~ year, 
 data = df))
 ) -> gc1
toc()

15.47 sec elapsed

# install.packages(furrr)
# library(furrr)
# plan(multisession, workers = 4)
# tic()
# by_cnty |> 
#  mutate(
#  model = future_map( # future_*
#  data, 
#  \(df) slow_lm(lifeExp ~ year, 
#  data = df)
#  )
#  ) -> gc2
# toc()

#结果：#> 5.98 sec elapsed
#由于我的r版本较低没有furrr包😂

为何二者不同❓❓❓

# 检查后发现是数据的附加属性不同导致

结束啦🎇