Прогнозирование линейных моделей из таблицы с использованием нового кадра данных - PullRequest
Новая
       70

Прогнозирование линейных моделей из таблицы с использованием нового кадра данных

0 голосов
/ 05 сентября 2018

Я видел несколько примеров использования tidy, dplyr и purrr для использования линейных регрессий из таблиц для прогнозирования одного значения. Вместо того, чтобы предсказывать только одно значение, я хотел бы предсказать целый новый фрейм данных. Итак, у меня есть следующие данные: 

library(tidyverse)
y   <- rep(seq(0, 240, by = 40), each = 7) 
x   <- rep(1:7, times = 7)
vol <- c(300, 380, 430, 460, 480, 485, 489,
         350, 445, 505, 540, 565, 580, 585,
         380, 490, 560, 605, 635, 650, 655,
         400, 525, 605, 655, 690, 710, 715,
         415, 555, 655, 710, 740, 760, 765,
         420, 570, 680, 740, 775, 800, 805,
         422, 580, 695, 765, 805, 830, 835) 
df  <- as.data.frame(cbind(y, x, vol))

Который я использовал для создания таких моделей: 

df.1 <- df %>%
  group_by(y) %>%
  do(mod = lm(vol ~ poly(x, 5), data = .))

df.1 выглядит так: 

# A tibble: 7 x 2
      y mod     
* <int> <list>  
1     0 <S3: lm>
2    40 <S3: lm>
3    80 <S3: lm>
4   120 <S3: lm>
5   160 <S3: lm>
6   200 <S3: lm>
7   240 <S3: lm>

Теперь я хотел бы использовать новый фрейм данных и использовать модели выше для прогнозирования новых значений vol

newx <- data.frame(x = seq(1, 7, 0.001))

Обновление: предполагается, что ответом будут 7 таблиц с измерениями 6001x2 со значениями x от 1 до 7 на 0,001 и значениями 'vol' с прогнозом из x.

Ответы [ 2 ]

0 голосов
/ 05 сентября 2018

Другой вариант - использовать функцию augment из broom: 

library(tidyverse)
library(broom)

tibble(y = df.1$y, 
       predictions = map(df.1$mod, augment, newdata = newx)) %>% 
  unnest() %>% 
  select(y, x, vol = .fitted) %>% 
  spread(y, vol)


#  A tibble: 6,001 x 8
#         x   `0`  `40`  `80` `120` `160` `200` `240`
#     <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#  1  1     300.  350.  380.  400.  415.  420.  422.
#  2  1.00  300.  350.  380.  400.  415.  420.  422.
#  3  1.00  300.  350.  380.  400.  415.  420.  422.
#  4  1.00  300.  350.  380.  400.  415.  420.  423.
#  5  1.00  300.  350.  381.  401.  416.  421.  423.
#  6  1.00  300.  351.  381.  401.  416.  421.  423.
#  7  1.01  301.  351.  381.  401.  416.  421.  423.
#  8  1.01  301.  351.  381.  401.  416.  421.  423.
#  9  1.01  301.  351.  381.  401.  416.  421.  423.
# 10  1.01  301.  351.  381.  401.  416.  421.  424.
# ... with 5,991 more rows
0 голосов
/ 05 сентября 2018

Чтобы использовать столбцы списка, переберите их с помощью purrr::map (или lapply) или вариантов. Расширяйте столбцы с помощью tidyr::unnest, когда хотите. 

library(tidyverse)
df <- data_frame(y = rep(seq(0, 240, by = 40), each = 7), 
                 x = rep(1:7, times = 7), 
                 vol = c(300, 380, 430, 460, 480, 485, 489,
                         350, 445, 505, 540, 565, 580, 585,
                         380, 490, 560, 605, 635, 650, 655,
                         400, 525, 605, 655, 690, 710, 715,
                         415, 555, 655, 710, 740, 760, 765,
                         420, 570, 680, 740, 775, 800, 805,
                         422, 580, 695, 765, 805, 830, 835))

df.1 <- df %>%
    nest(-y) %>%
    mutate(mods = map(data, ~lm(vol ~ poly(x, 5), data = .x)), 
           preds = map(mods, predict, newdata = data.frame(x = seq(1, 7, 0.001))))

df.1
#> # A tibble: 7 x 4
#>       y data             mods     preds        
#>   <dbl> <list>           <list>   <list>       
#> 1     0 <tibble [7 × 2]> <S3: lm> <dbl [6,001]>
#> 2    40 <tibble [7 × 2]> <S3: lm> <dbl [6,001]>
#> 3    80 <tibble [7 × 2]> <S3: lm> <dbl [6,001]>
#> 4   120 <tibble [7 × 2]> <S3: lm> <dbl [6,001]>
#> 5   160 <tibble [7 × 2]> <S3: lm> <dbl [6,001]>
#> 6   200 <tibble [7 × 2]> <S3: lm> <dbl [6,001]>
#> 7   240 <tibble [7 × 2]> <S3: lm> <dbl [6,001]>
...