使用purrr map2函數的線性模型中的多個預測變量

Question

我的問題與this one類似，但現在我試圖使用一個有多個預測變量的模型，並且我無法弄清楚如何將新數據導入預測函數。

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

set.seed(1234) 

首先我創建星期的以次

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

然後我抓住本年度

cur_year <- year(Sys.Date()) 

在這裏，我創建虛擬數據

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) 
) 

數據幀接下來我創建一個嵌套的數據框一年中每週的數據爲一組。

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

在這裏，我把今年的數據加入到前一年的數據中。

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") 
) 

，這增加了數據幀中的線性模型全年

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))) 

現在我想用型號爲每星期使用今年的數據來預測每星期。我試過如下：

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))) 
) 

這提供了以下錯誤：

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

然後我試着築巢我預測在我的數據幀...

創建一個數據幀就在今年的數據並嵌套預測變量

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))) 

將此加入我的主數據框中

cond_model <- left_join(cond_model, cur_cond) 

現在我再次嘗試預測：

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

我得到了相同的錯誤面前：

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

我認爲，答案可能涉及在執行扁平化（）預測，但我無法弄清楚我的工作流程中發生了什麼。

cond_model$new_data[1] 

與

flatten_df(cond_model$new_data[1]) 

，並在這一點上我已經江郎才盡。

Answer 1

將預測數據集添加進去後，主要問題是如何處理沒有預測數據的周（第31-53周）。

當您加入兩個數據集時，您會看到沒有預測數據集的行將填充NULL。您可以使用ifelse語句爲這些行預測NA。

# 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))) 

把一個ifelse在返回NA當沒有預測數據。

# 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