嵌套循环通过 function 与多个 arguments 并堆叠 output

Question

我写了一个运行线性 model 并输出数据帧的 function。 我想在两个分组变量上多次运行 function 并堆叠 output。 这是一个假设的数据集和 function：

data = data.frame(grade_level = rep(1:4, each = 3),
                  x = rnorm(12, mean = 21, sd = 7.5),
                  y = rnorm(12, mean = 20, sd = 7),
                  cut_set = rep(c("low", "med", "high"), each = 4)) 

func = function(grade, set){
  model = lm(y ~ x, data=data[data$grade_level == grade & data$cut_set == set,])
  fitted.values = model$fitted.values 
  final = data.frame(grade_level = data$grade_level[data$grade_level == grade & data$cut_set == set],
                     predicted_values = fitted.values)
  final
}

我可以多次运行它然后绑定 output 但我知道这不是最好的

g1.low <- func(grade = 1, set = "low")
g1.med <- func(grade = 1, set = "med")
pred.values = rbind(g1.low, g1.med)

我想遍历所有等级（1 到 4）并设置（“低”、“中”、“高”）值。 我试过这个循环，但它不起作用。 我想知道是否有解决方案。

for (i in grades) {
  for(c in 1:length(cut_sets)) {
    
    temp <- func(grade = i, set = cut_sets[c])
    predicted.values <- rbind(predicted.values, temp)
    
  }
}

Answer 1

如果我理解得很好，您可以使用dplyr和broom来管理它：

library(dplyr)
library(broom)
library(tidyr)
 mods <- data %>%
         group_by(grade_level, cut_set) %>%
          do(model = augment(lm(y ~ x, data = .)) )
 mods
# A tibble: 6 x 3
# Rowwise: 
  grade_level cut_set model           
        <int> <chr>   <list>          
1           1 low     <tibble [3 x 8]>
2           2 low     <tibble [1 x 8]>
3           2 med     <tibble [2 x 8]>
4           3 high    <tibble [1 x 8]>
5           3 med     <tibble [2 x 8]>
6           4 high    <tibble [3 x 8]>

 mods %>% unnest(cols = c(model))
# A tibble: 12 x 10
   grade_level cut_set     y     x .fitted    .resid  .hat .sigma .cooksd .std.resid
         <int> <chr>   <dbl> <dbl>   <dbl>     <dbl> <dbl>  <dbl>   <dbl>      <dbl>
 1           1 low      27.5  20.9    27.4  1.12e- 1 0.992    NaN  60.9         1.  
 2           1 low      24.8  30.4    24.0  8.15e- 1 0.567    Inf   0.656       1.00
 3           1 low      23.5  29.3    24.4 -9.26e- 1 0.441    NaN   0.394      -1   
 4           2 low      31.6  18.6    31.6  0.       1          0 NaN         NaN   
 5           2 med      19.3  20.9    19.3  3.55e-15 1          0 NaN         NaN   
 6           2 med      16.9  14.7    16.9  0.       1          0 NaN         NaN   
 7           3 high     20.1  22.9    20.1  0.       1          0 NaN         NaN   
 8           3 med      21.6  13.2    21.6  3.55e-15 1          0 NaN         NaN   
 9           3 med      20.9  26.5    20.9  0.       1          0 NaN         NaN   
10           4 high     26.4  20.0    20.9  5.49e+ 0 0.369    NaN   0.293       1.  
11           4 high     15.2  15.6    19.0 -3.88e+ 0 0.685    NaN   1.09       -1.  
12           4 high     23.7  30.8    25.3 -1.61e+ 0 0.946    NaN   8.71       -1.  

要获得斜坡，您可以：

data %>%
         group_by(grade_level, cut_set) %>%
          do(model = tidy(lm(y ~ x, data = .)) ) %>% unnest(cols = c(model))

# A tibble: 12 x 7
   grade_level cut_set term        estimate std.error statistic p.value
         <int> <chr>   <chr>          <dbl>     <dbl>     <dbl>   <dbl>
 1           1 low     (Intercept)   14.8       7.05      2.09    0.284
 2           1 low     x              0.339     0.371     0.913   0.529
 3           2 low     (Intercept)   23.1     NaN       NaN     NaN    
 4           2 low     x             NA        NA        NA      NA    
 5           2 med     (Intercept)    1.27    NaN       NaN     NaN    
 6           2 med     x              0.561   NaN       NaN     NaN    
 7           3 high    (Intercept)   14.7     NaN       NaN     NaN    
 8           3 high    x             NA        NA        NA      NA    
 9           3 med     (Intercept)    7.29    NaN       NaN     NaN    
10           3 med     x              0.229   NaN       NaN     NaN    
11           4 high    (Intercept)   13.8       4.18      3.30    0.187
12           4 high    x              0.106     0.210     0.505   0.702