Запустите регрессию по группам и вставьте в исходный фрейм данных для значений прогнозирования - предоставляется пример кода - PullRequest
0 голосов
/ 07 июня 2018

У меня есть код, который работает для создания автоматических регрессий.Но я изо всех сил пытаюсь реализовать функцию прогнозирования для вставки прогнозов в исходный набор данных для каждой даты.

Спасибо,

Код, который у меня пока есть:

test = df[(df$key==1 | df$key==2),]

df_list=split(test, test$key)
reg_results = lapply(df_list,function(temp) {

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

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

df_list_summary = lapply(reg_results, function(model_output){
  broom::tidy(model_output)
})
final_step2 = dplyr::bind_rows(df_list_summary, .id="Key's")
readr::write_csv(final_step2,"test2.csv")

Пример df:

   Key  Date                     y   x1   x2   x3
   1    1/10/2018 12:00:00 AM    2   3    2    5
   1    1/11/2018 12:00:00 AM    3   5    7    2
   1    1/12/2018 12:00:00 AM    5   7    4    7 
   1    1/13/2018 12:00:00 AM    7   2    7    6
   2    1/10/2018 12:00:00 AM    2   6    3    8
   2    1/11/2018 12:00:00 AM    3   7    7    3
   2    1/12/2018 12:00:00 AM    3   2    3    4
   2    1/13/2018 12:00:00 AM    7   6    2    7

Желаемый результат:

   Key  Date                     y   x1   x2   x3  predicted values for each date
   1    1/10/2018 12:00:00 AM    2   3    2    5   ...
   1    1/11/2018 12:00:00 AM    3   5    7    2   ...
   1    1/12/2018 12:00:00 AM    5   7    4    7   ...
   1    1/13/2018 12:00:00 AM    7   2    7    6   ...
   2    1/10/2018 12:00:00 AM    2   6    3    8   ...
   2    1/11/2018 12:00:00 AM    3   7    7    3   ...
   2    1/12/2018 12:00:00 AM    3   2    3    4   ...
   2    1/13/2018 12:00:00 AM    7   6    2    7   ...

То, что я пытался до сих пор безрезультатно:

test2 = df[(df$key==1 | df$key==2),]

unsplit(lapply(split(test, test$key),function(w){
reg_results = lapply(df_list,function(temp) {

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

  temp=temp[,good_cols]
  fit=lm(y~.,data=temp)
})
  cbind(w,predict(fit,subset(df, key=="1" | key=="2")))
}),test$key)

df_list_summary = lapply(reg_results, function(model_output){
  broom::tidy(model_output)
})
final_step2 = dplyr::bind_rows(df_list_summary, .id="key's")
readr::write_csv(final_step2,"test2.csv")

ОБНОВЛЕНИЕ: Итак, код MrFlick сработал;Тем не менее, я пытаюсь выяснить, как применить код к out_of_sample_df.Кто-нибудь может помочь?

 test = df[(df$key==1 | df$key==2),]

df_list=split(test, test$key)
reg_results = lapply(df_list,function(temp) {

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

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


#MrFlicks contribution - need help to adjust this line of code to apply to out of sample data to produce prediction results. Currently this line of code inserts pred column inside original data set.

    reg_predict = dplyr::bind_rows(Map(function(data, model) {
           data.frame(data, pred=predict(model))    }, df_list, reg_results))


df_list_summary = lapply(reg_results, function(model_output){
  broom::tidy(model_output)
})
final_step2 = dplyr::bind_rows(df_list_summary, .id="Key's")
readr::write_csv(final_step2,"test2.csv")

Спасибо,

1 Ответ

0 голосов
/ 07 июня 2018

Вы можете использовать Map() для итерации как по данным, так и по моделям, чтобы получить желаемый результат.Начиная с оригинального кода, вы можете сделать что-то вроде этого

reg_predict = dplyr::bind_rows(Map(function(data, model) {
    data.frame(data, pred=predict(model))
}, df_list, reg_results))
...