首页 > 解决方案 > 在列表中的样本预测之外,指定要在 R 中预测的列表名称

问题描述

我有一个包含大量回归方程的列表,每个回归方程都在一个列表中分开。每个列表都分配有一个键(一个数字)。我想做一个样本外预测,将每组样本数据与该列表中的适当回归方程相匹配。

这是我到目前为止所拥有的,似乎无法让它发挥作用:

for (i in names(df_list)){

reg_predict = select(dplyr::bind_rows(Map(function(newdata, model) {
  data.frame(newdata, pred=predict(model,newdata))
}, df_list$`i`,reg_results2$`i`)))

}

df_list - 包含我要预测的变量列表,用键(数字)分隔。

reg_results2 - 包含由键(数字)分隔的回归方程列表。

我什至尝试在没有循环的情况下仅运行 1 次:

reg_predict = select(dplyr::bind_rows(Map(function(newdata, model) {
  data.frame(newdata, pred=predict(model,newdata))
}, df_list$`1`,reg_results2$`1`)))

我收到以下错误:

Error in UseMethod("predict") : 
  no applicable method for 'predict' applied to an object of class "c('double', 'numeric')"

预先感谢您的帮助

df_list - 它的外观:

1(下拉箭头) - 其他相同 - 2,3,4,5,6 等:包含如下变量:

date   #, #, #, #, #, #, ...
y      #, #, #, #, #, #, ...
x1     #, #, #, #, #, #, ...
x2     #, #, #, #, #, #, ...
x3     #, #, #, #, #, #, ...
x4     #, #, #, #, #, #, ...

reg_results2 列表:

1(下拉箭头) - 其他相同 - 2,3,4,5,6 等:包含如下变量:

coefficients
residuals
effects
rank
fitted.values
assign
qr
df.residual
xlevels
call
terms
model

可重现的示例(TESTDATA):

Dates        Key NY     Tor    Chicago  Montreal
1-Jan-18     1  9073    8173    -5442   6786
2-Jan-18     1  4725    3790    -2814   -185
3-Jan-18     1  3447   -5471    -8821   5650
4-Jan-18     1  6320    9954    8804    -818
5-Jan-18     1  4757    6166    6156    -8059
6-Jan-18     1  5251    4922    6063    4517
7-Jan-18     1  4619   -8911    3256    -7389
8-Jan-18     1  8525   -8817    325     -1051
9-Jan-18     1  1955    3227    -206    -7664
10-Jan-18    1  5077    7551    9424    -6751
11-Jan-18    1  7595    1225    1406    7635
12-Jan-18    1  2682    1620    -5408   9743
13-Jan-18    1  8932   -3512    6341    9536
14-Jan-18    1  2354   -6192    -2665   3346
15-Jan-18    1  8557    5111    8375    2499
16-Jan-18    1  2087    -210    -982    6214
17-Jan-18    1  3212    -1252   951     5969
18-Jan-18    1  1131     711    -1102   4739
19-Jan-18    1  5493   -3580    -1600   4899
20-Jan-18    1  1940    9647    173    -4608
1-Jan-18     2  3231    3874    -1697   -39
2-Jan-18     2  -2608  -2082    3768    3978
3-Jan-18     2  -1     -3077    1884    -3503
4-Jan-18     2  -750    2987    -2822   1490
5-Jan-18     2  1305    1405    3658    -1172
6-Jan-18     2  -561    3220    -2147   -3635
7-Jan-18     2  1201    -2889   -2430   -2087
8-Jan-18     2  -3730   -1774   -2562   -3909
9-Jan-18     2  -3122   1169    345     -3254
10-Jan-18    2  -2879   1898    3959    -3631
11-Jan-18    2  2895    -961    -2610   -3705
12-Jan-18    2  -2372   -1190   -1106   3437
13-Jan-18    2  -3228   -1263   1775    3179
14-Jan-18    2  -1033   1609    -2656   -542
15-Jan-18    2  -3767   1288    1590    -231
16-Jan-18    2  -1502   -3784   426     232
17-Jan-18    2  -2252   1267    -1219   -2817
18-Jan-18    2  -3943   -3779   2186    2529
19-Jan-18    2  342     2301    550     375
20-Jan-18    2  909    -1235    391     -41
1-Jan-18     3  2762    -3361   -3421   2421
2-Jan-18     3  1373    3209    2994    435
3-Jan-18     3  -190    -3903   1428    3135
4-Jan-18     3  -2931   3675    -3869   992
5-Jan-18     3  821    -2150    3789    899
6-Jan-18     3  1461    -227    -2912   3066
7-Jan-18     3  962     3370    2137    -2894
8-Jan-18     3  -1771   -3644   -3204   1890
9-Jan-18     3  -3368   -2984   2837    1024
10-Jan-18    3  92      2562    -2232   856
11-Jan-18    3  3081    2613    -3584   2076
12-Jan-18    3  968     -1805   1970    -537
13-Jan-18    3  -3652   -3626   -902    3261
14-Jan-18    3  -836    -1907   -3678   -2136
15-Jan-18    3  3875    -2149   -3630   -3768
16-Jan-18    3  -1953   3333    971     1912
17-Jan-18    3  3559    2634    -1480   3697
18-Jan-18    3  -271    -2888   -1727   -2409
19-Jan-18    3  871     2344    3086    1301
20-Jan-18    3  -521    563    -106     993

这是您可以运行的代码,它将在示例预测中生成:

#script to run regression with in sample predictors
start_time <- Sys.time()
test = TESTDATA
df_list=split(test, test$Key)
reg_results2 = lapply(df_list,function(temp) {

  good_cols=sapply(temp,function(x){
    is.numeric(x) && ((max(x)-min(x))!=0)
  })

  temp=temp[,good_cols]
  fit=lm(NY~.,data=temp)
  return(fit)
})


reg_predict2 = select(dplyr::bind_rows(Map(function(data, model) {
  data.frame(data, pred=predict(model, data))
}, df_list, reg_results2)),c(contains("Key"), contains("Dates"), contains("NY"), contains("pred")))

reg_predict2$difference = reg_predict2$pred - reg_predict2$NY

df_list_summary = lapply(reg_results2, function(model_output){
  broom::tidy(model_output)
})

我正在尝试编辑此行以生成样本外并选择要从两个列表中选择要匹配的回归。

 reg_predict2 = select(dplyr::bind_rows(Map(function(data, model) {
      data.frame(data, pred=predict(model, data))
    }, df_list, reg_results2)),c(contains("Key"), contains("Dates"), contains("NY"), contains("pred")))

例如:

 reg_predict2 = select(dplyr::bind_rows(Map(function(data, model) {
          data.frame(data, pred=predict(model, data))
        }, df_list$`1`, reg_results2$`1`)),c(contains("Key"), contains("Dates"), contains("NY"), contains("pred")))

标签: rlistloopsfor-loopregression

解决方案


IIUC,这是我为解决您的问题而尝试创建的一个最小示例。

# create data (this could be your out of sample data)
d1 <- data.frame(weight = c(23,78,98,50), height=c(50,170,190,150))
d2 <- data.frame(weight = c(13,58,78,90), height=c(20,140,172,200))

# these are trained model
p1 <- lm(height ~ weight, data = d1)
p2 <- lm(height ~ weight, data = d2)

# create separate list for out of sample data and models
data_list <- list(d1,d2)
model_list <- list(p1,p2)

# here we will save predictions
oof_predictions = list()

# loop through both the list and predict
for(i in seq(data_list)){

  g <- predict(model_list[[i]], data_list[[i]])
  oof_predictions[[i]] <- g

}

print(oof_predictions)

[[1]]
       1         2         3         4 
70.81604 167.76172 203.01469 118.40755 

[[2]]
       1         2         3         4 
24.05383 128.92180 175.52979 203.49458 

更新:在聊天讨论后:-

oof_predictions_df = data.frame() 

for(i in seq(df_list)){ 
    g <- predict(reg_results2[[i]], df_list[[i]]) 
    f = data.frame(Key = df_list[[i]][,'Key'], Date = df_list[[i]][,'Dates'], NY = df_list[[i]][,'NY'], pred = g) 
    oof_predictions_df <- rbind(oof_predictions_df, f) 

}

推荐阅读