Nested loop through function with multiple arguments and stack the output - r

Question

I wrote a function that runs a linear model and outputs a data frame. I would like to run the function several times over two grouping variables and stack the output. Here is a hypothetical dataset and 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
}
I can run it multiple times and then bind the output but I know this isn't the best
g1.low <- func(grade = 1, set = "low")
g1.med <- func(grade = 1, set = "med")
pred.values = rbind(g1.low, g1.med)
I would like to loop through all grades (1 to 4) and set ("low", "med", "high") values. I've tried this loop but it doesn't work. I wonder if there is a purrr solution.
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

If I've understood well you can manage it with dplyr and 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.
To get slopes, you can:
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