Verwenden Sie mehrere Prädiktoren im linearen Modell mit purrr map2 Funktion

Question

Meine Frage ist ähnlich wie this one, aber jetzt versuche ich ein Modell mit mehreren Prädiktoren zu verwenden und ich kann nicht herausfinden, wie die neuen Daten in die Vorhersagefunktion erhalten.

library(dplyr) 
library(lubridate) 
library(purrr) 
library(tidyr) 
library(broom) 

set.seed(1234) 

Zunächst erstelle ich eine seq Wochen

wks = seq(as.Date("2010-01-01"), Sys.Date(), by="1 week") 

Dann habe ich das aktuelle Jahr greifen

cur_year <- year(Sys.Date()) 

Hier erstelle ich einen Datenrahmen mit Dummy-Daten

my_data <- data.frame(
    week_ending = wks 
) %>% 
    mutate(
    ref_period = week(week_ending), 
    yr = year(week_ending), 
    PCT.EXCELLENT = round(runif(length(wks), 0, 100),0), 
    PCT.GOOD = round(runif(length(wks), 0, 100),0), 
    PCT.FAIR = round(runif(length(wks), 0, 100),0), 
    PCT.POOR = round(runif(length(wks), 0, 100),0), 
    PCT.VERY.POOR = round(runif(length(wks), 0, 100),0), 
    pct_trend = round(runif(length(wks), 75, 125),0) 
) 

Als nächstes erstelle ich einen verschachtelten Datenrahmen, der die Daten für jede Woche des Jahres als eine Gruppe.

cond_model <- my_data %>% 
    filter(yr != cur_year) %>% 
    group_by(ref_period) %>% 
    nest(.key=cond_data) 

Hier schließe ich die diesjährigen Daten in den Vorjahren Daten von der Woche des Jahres.

cond_model <- left_join(
    cond_model, 
    my_data %>% 
    filter(yr==cur_year) %>% 
    select(week_ending, 
      ref_period, 
      PCT.EXCELLENT, 
      PCT.FAIR, 
      PCT.GOOD, 
      PCT.POOR, 
      PCT.VERY.POOR), 
    by = c("ref_period") 
) 

Davon profitiert das lineare Modell an den Datenrahmen für jede Woche des Jahres

cond_model <- 
    cond_model %>% 
    mutate(model = map(cond_data, 
        ~lm(pct_trend ~ PCT.EXCELLENT + PCT.GOOD + PCT.FAIR + PCT.POOR + PCT.VERY.POOR, data = .x))) 

jetzt möchte ich für jede Woche das Modell verwenden, mit der diesjährigen Daten vorherzusagen. Ich habe versucht, die folgenden:

cond_model <- 
    cond_model %>% 
    mutate(
    pred_pct_trend = map2_dbl(model, PCT.EXCELLENT + PCT.GOOD + PCT.FAIR + PCT.POOR + PCT.VERY.POOR, 
           ~predict(.x, newdata = data.frame(.y))) 
) 

dass der folgende Fehler gibt:

Error in mutate_impl(.data, dots) : object 'PCT.EXCELLENT' not found 

Ich habe dann versucht, meine Prädiktoren in meine Datenrahmen nisten ...

einen Datenrahmen erstellen mit nur diesem Jahr Daten und schachteln die Prädiktoren

cur_cond <- my_data %>% 
    filter(yr==cur_year) %>% 
    select(week_ending, PCT.EXCELLENT, 
     PCT.GOOD, PCT.FAIR, PCT.POOR, PCT.VERY.POOR) %>% 
    group_by(week_ending) %>% 
    nest(.key=new_data) %>% 
    mutate(new_data=map(new_data, ~data.frame(.x))) 

Join this in meinem Hauptdatenrahmen

cond_model <- left_join(cond_model, cur_cond) 

Jetzt versuche ich die Vorhersage wieder:

cond_model <- 
    cond_model %>% 
    mutate(
    pred_pct_trend = map2_dbl(model, new_data, 
           ~predict(.x, newdata = data.frame(.y))) 
) 

ich den gleichen Fehler wie zuvor:

Error in mutate_impl(.data, dots) : object 'PCT.EXCELLENT' not found 

Ich denke, dass die Antwort Durchführung einer Flatten beinhalten könnte() auf der Prädiktoren, aber ich kann nicht herausfinden, wo das in meinem Workflow geht.

cond_model$new_data[1] 

gegen

flatten_df(cond_model$new_data[1]) 

und ich an dieser Stelle die Ideen ausgehen haben.

Answer 1

Sobald Sie Ihr Vorhersage-Dataset hinzugefügt haben, geht es hauptsächlich darum, wie Sie mit den Wochen umgehen können, die keine Vorhersagedaten haben (Wochen 31-53).

Sie sehen, wenn Sie die beiden Datensätze verbinden, werden die Zeilen ohne Vorhersagedatensatz mit NULL gefüllt. Sie können eine ifelse-Anweisung verwenden, um Vorhersagen von NA für diese Zeilen zu geben.

# Modeling data 
cond_model = my_data %>% 
    filter(yr != cur_year) %>% 
    group_by(ref_period) %>% 
    nest(.key = cond_data) 

# Create prediction data 
cur_cond = my_data %>% 
    filter(yr == cur_year) %>% 
    group_by(ref_period) %>% 
    nest(.key = new_data) 

# Join these together 
cond_model = left_join(cond_model, cur_cond) 

# Models 
cond_model = cond_model %>% 
    mutate(model = map(cond_data, 
         ~lm(pct_trend ~ PCT.EXCELLENT + PCT.GOOD + 
           PCT.FAIR + PCT.POOR + PCT.VERY.POOR, data = .x))) 

eine ifelse in Put NA zurückzukehren, wenn es keine Vorhersagedaten ist.

# Predictions 
cond_model %>% 
    mutate(pred_pct_trend = map2_dbl(model, new_data, 
            ~ifelse(is.null(.y), NA, 
              predict(.x, newdata = .y)))) 

# A tibble: 53 x 5 
    ref_period  cond_data   new_data model pred_pct_trend 
     <dbl>   <list>   <list> <list>   <dbl> 
1   1 <tibble [7 x 8]> <tibble [1 x 8]> <S3: lm>  83.08899 
2   2 <tibble [7 x 8]> <tibble [1 x 8]> <S3: lm>  114.39089 
3   3 <tibble [7 x 8]> <tibble [1 x 8]> <S3: lm>  215.02055 
4   4 <tibble [7 x 8]> <tibble [1 x 8]> <S3: lm>  130.24556 
5   5 <tibble [7 x 8]> <tibble [1 x 8]> <S3: lm>  112.86516 
6   6 <tibble [7 x 8]> <tibble [1 x 8]> <S3: lm>  107.29866 
7   7 <tibble [7 x 8]> <tibble [1 x 8]> <S3: lm>  52.11526 
8   8 <tibble [7 x 8]> <tibble [1 x 8]> <S3: lm>  106.22482 
9   9 <tibble [7 x 8]> <tibble [1 x 8]> <S3: lm>  128.40858 
10   10 <tibble [7 x 8]> <tibble [1 x 8]> <S3: lm>  108.10306