如何在地图功能中保存多个步骤

Question

我正在尝试创建多个样本，在每个样本上拟合一个模型，然后打印结果。

dat <- data.frame(
  x=rnorm(20, mean=5, sd=1),
  y=rnorm(20, mean=6, sd=1),
  weight = rnorm(20, mean=1, sd=0.2)
)

f <- function(data, var.x, var.y, n) {
  # select sample
  data_subset <- data %>% sample_n(n, weight = weight, replace = T) %>% select(all_of(var.x), all_of(var.y)) %>% drop_na()
  # fit model
  model <- lm(unlist(data_subset %>% select(y)) ~ unlist(data_subset %>% select(x))) 
  print(model)
}

f(data=dat, var.x="x", var.y="y", n=20)

有没有办法将数据集保存在地图函数中并拟合模型？这是一个尝试：

    f <- function(data, var.x, var.y, n) {
map(seq_len(20),
      # select sample
      data_subset <- data %>% sample_n(n, weight = weight, replace = T) %>% select(all_of(var.x), all_of(var.y)) %>% drop_na()
      # fit model
      model <- lm(unlist(data_subset %>% select(y)) ~ unlist(data_subset %>% select(x))) 
      print(model)
)
    }

Answer 1

当然，

set.seed(42)
dat <- data.frame( x=rnorm(20, mean=5, sd=1), y=rnorm(20, mean=6, sd=1), weight = rnorm(20, mean=1, sd=0.2) )
head(dat,3)
#          x        y    weight
# 1 6.370958 5.693361 1.0411997
# 2 4.435302 4.218692 0.9277885
# 3 5.363128 5.828083 1.1516326
out <- tibble(run = 1:20) %>%
  mutate(data = list(sample_n(dat, size = 20, weight = weight, replace = TRUE)), mdl = purrr::map(data, ~ lm(y ~ x, data = .x)), smry = purrr::map(mdl, ~ summary(.x)))

此时out的三列为list-columns，

out
# # A tibble: 20 × 4
#      run data          mdl    smry      
#    <int> <list>        <list> <list>    
#  1     1 <df [20 × 3]> <lm>   <smmry.lm>
#  2     2 <df [20 × 3]> <lm>   <smmry.lm>
#  3     3 <df [20 × 3]> <lm>   <smmry.lm>
#  4     4 <df [20 × 3]> <lm>   <smmry.lm>
#  5     5 <df [20 × 3]> <lm>   <smmry.lm>
#  6     6 <df [20 × 3]> <lm>   <smmry.lm>
#  7     7 <df [20 × 3]> <lm>   <smmry.lm>
#  8     8 <df [20 × 3]> <lm>   <smmry.lm>
#  9     9 <df [20 × 3]> <lm>   <smmry.lm>
# 10    10 <df [20 × 3]> <lm>   <smmry.lm>
# 11    11 <df [20 × 3]> <lm>   <smmry.lm>
# 12    12 <df [20 × 3]> <lm>   <smmry.lm>
# 13    13 <df [20 × 3]> <lm>   <smmry.lm>
# 14    14 <df [20 × 3]> <lm>   <smmry.lm>
# 15    15 <df [20 × 3]> <lm>   <smmry.lm>
# 16    16 <df [20 × 3]> <lm>   <smmry.lm>
# 17    17 <df [20 × 3]> <lm>   <smmry.lm>
# 18    18 <df [20 × 3]> <lm>   <smmry.lm>
# 19    19 <df [20 × 3]> <lm>   <smmry.lm>
# 20    20 <df [20 × 3]> <lm>   <smmry.lm>

我们可以使用[[访问任何单个元素：

out$data[[1]]
#           x        y    weight
# 1  4.721211 5.391074 1.1285799
# 2  4.893875 5.569531 1.0865636
# 3  6.370958 5.693361 1.0411997
# 4  6.370958 5.693361 1.0411997
# 5  4.866679 6.504955 1.0179521
# 6  4.893875 5.569531 1.0865636
# 7  6.511522 5.742731 0.8377214
# 8  5.404268 7.895193 0.7263438
# 9  4.715747 5.215541 1.1358578
# 10 4.866679 6.504955 1.0179521
# 11 6.511522 5.742731 0.8377214
# 12 6.370958 5.693361 1.0411997
# 13 2.343545 5.149092 1.0179666
# 14 6.511522 5.742731 0.8377214
# 15 5.632863 7.214675 0.8546590
# 16 6.370958 5.693361 1.0411997
# 17 5.632863 7.214675 0.8546590
# 18 4.905341 4.236837 1.2888203
# 19 4.435302 4.218692 0.9277885
# 20 2.343545 5.149092 1.0179666
out$mdl[[1]]
# Call:
# lm(formula = y ~ x, data = .x)
# Coefficients:
# (Intercept)            x  
#      4.6198       0.2239  
out$smry[[1]]
# Call:
# lm(formula = y ~ x, data = .x)
# Residuals:
#     Min      1Q  Median      3Q     Max 
# -1.4814 -0.3531 -0.3106  0.2022  2.0652 
# Coefficients:
#             Estimate Std. Error t value Pr(>|t|)    
# (Intercept)   4.6198     0.8933   5.171 6.42e-05 ***
# x             0.2239     0.1664   1.346    0.195    
# ---
# Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Residual standard error: 0.8944 on 18 degrees of freedom
# Multiple R-squared:  0.09145, Adjusted R-squared:  0.04097 
# F-statistic: 1.812 on 1 and 18 DF,  p-value: 0.195

如果您需要比这更“复杂”（或者如果您想要......），请查看broom 包和朋友。

笔记：

• 我没有把这个功能化，但是这样做应该比较简单，我这里的目的是演示在脚步，其中第一步是存储“仅数据”的列表列；
• 在这个例子中，由于原始帧是 20 行，我们使用相同的权重对 20 行进行采样，所以在这个人为的例子中，数据没有变化......你的实际使用（使用更大的源数据）应该证明之间的可变性不同的运行。