我有一个带有一列模型的数据框,并且正在尝试向其添加一列预测值。一个最小的例子是:
exampleTable <- data.frame(x = c(1:5, 1:5),
y = c((1:5) + rnorm(5), 2*(5:1)),
groups = rep(LETTERS[1:2], each = 5))
models <- exampleTable %>% group_by(groups) %>% do(model = lm(y ~ x, data = .))
exampleTable <- left_join(tbl_df(exampleTable), models)
estimates <- exampleTable %>% rowwise() %>% do(Est = predict(.$model, newdata = .["x"]))
Run Code Online (Sandbox Code Playgroud)
如何将一列数值预测添加到exampleTable?我尝试使用mutate直接将列添加到表中而没有成功。
> exampleTable <- exampleTable %>% rowwise() %>% mutate(data.frame(Pred = predict(.$model, newdata = .["x"])))
Error: no applicable method for 'predict' applied to an object of class "list"
Run Code Online (Sandbox Code Playgroud)
现在,我使用bind_cols来添加estimates,exampleTable但是我正在寻找更好的解决方案。
estimates <- exampleTable %>% rowwise() %>% do(data.frame(Pred = predict(.$model, newdata = .["x"])))
exampleTable <- bind_cols(exampleTable, estimates)
Run Code Online (Sandbox Code Playgroud)
如何一步一步完成?
使用建模器,可以使用tidyverse提供一种优雅的解决方案。
输入
library(dplyr)
library(purrr)
library(tidyr)
# generate the inputs like in the question
example_table <- data.frame(x = c(1:5, 1:5),
y = c((1:5) + rnorm(5), 2*(5:1)),
groups = rep(LETTERS[1:2], each = 5))
models <- example_table %>%
group_by(groups) %>%
do(model = lm(y ~ x, data = .)) %>%
ungroup()
example_table <- left_join(tbl_df(example_table ), models, by = "groups")
Run Code Online (Sandbox Code Playgroud)
解决方案
# generate the extra column
example_table %>%
group_by(groups) %>%
do(modelr::add_predictions(., first(.$model)))
Run Code Online (Sandbox Code Playgroud)
说明
add_predictions使用给定的模型将新列添加到数据框。不幸的是,它仅采用一个模型作为参数。见面do。使用do,我们可以add_prediction在每个组上单独运行。
.代表分组的数据框,.$model模型列,并first()采用每个组的第一个模型。
简化版
仅使用一种模型,add_predictions效果很好。
# take one of the models
model <- example_table$model[[6]]
# generate the extra column
example_table %>%
modelr::add_predictions(model)
Run Code Online (Sandbox Code Playgroud)
菜谱
如今,tidyverse正在从modelr软件包转移到,recipes因此这可能是该软件包成熟后的新方法。
使用tidyverse:
library(dplyr)
library(purrr)
library(tidyr)
library(broom)
exampleTable <- data.frame(
x = c(1:5, 1:5),
y = c((1:5) + rnorm(5), 2*(5:1)),
groups = rep(LETTERS[1:2], each = 5)
)
exampleTable %>%
group_by(groups) %>%
nest() %>%
mutate(model = data %>% map(~lm(y ~ x, data = .))) %>%
mutate(Pred = map2(model, data, predict)) %>%
unnest(Pred, data)
# A tibble: 10 × 4
groups Pred x y
<fctr> <dbl> <int> <dbl>
1 A 1.284185 1 0.9305908
2 A 1.909262 2 1.9598293
3 A 2.534339 3 3.2812002
4 A 3.159415 4 2.9283637
5 A 3.784492 5 3.5717085
6 B 10.000000 1 10.0000000
7 B 8.000000 2 8.0000000
8 B 6.000000 3 6.0000000
9 B 4.000000 4 4.0000000
10 B 2.000000 5 2.0000000
Run Code Online (Sandbox Code Playgroud)