R-добавление экстраполированного значения (lm) к матрице наблюдений

Я пытаюсь добавить набор экстраполированных "наблюдений" к матрице в R. Я знаю, как это сделать, используя обычные методы программирования (читай; кучу вложенных циклов и функций), но я чувствую, что это должно быть возможно гораздо более чистым способом, используя build in R-functionality.

Приведенный ниже код иллюстрирует точку, и где она ломается

Заранее большое спасибо за вашу помощь!

С уважением

Сильвен 

library(dplyr)

# The idea is that i have a table of observations for e.g. x=5, 6, 7, 8, 9 and 10. The observations (in this example 2)
# conform fairly decently to sets of 2nd order polynomials.
# Now, I want to add an extrapolated value to this table (e.g. x=4). I know how to do this programmically 
# but I feel there must be a cleaner solution to do this. 

#generate dummy data table
x <- 5:10
myData <- tibble(x, a = x^2 * 2 + x * 3 + 4 + rnorm(1,0,0.01), b = x^2 * 3 + x * 4 + 5 + rnorm(1,0,0.01)   )

#Gather (put in Data-Key format)
myDataKeyFormat <- gather(myData,key = "someLabel", value = "myObservation", -x)
fitted_models <- myDataKeyFormat %>% group_by(someLabel) %>% do(model = lm(myObservation ~ poly(x,2), data = .))
myExtrapolatedDataPointx <- tibble(x = 4)

#Add the x=4 field
fitted_points <- fitted_models %>% group_by(someLabel) %>% do(predict(.$model,myExtrapolatedDataPointx)) #R really doesnt like this bit

#append the fitted_points to the myDataKeyFormat
myDataKeyFormatWithExtrapolation <- union(myDataKeyFormat,fitted_points)

#use spread to 
myDataWithExtrapolation <- myDataKeyFormatWithExtrapolation %>% spread(someLabel,myObservation)
1 2
lm matrix

1 ответ:

Вот решение в tidyverse и использование purrr для создания различных моделей. Идея состоит в том, чтобы вложить (используя tidyr::nest), а затем purrr::map обучить модель. Затем я добавлю новые значения и вычислю предсказания, используя modelr::add_predictions. Здесь у вас есть все данные в одном месте : обучающие данные, модели, тестовые данные и прогнозирование, по вашей переменной someLabel. Я также даю вам способ визуализировать данные. Вы можете проверить R для Data Science по Hadley Wickham & Garrett Grolemund, и особенно часть о моделях для получения дополнительной информации.

library(dplyr)
library(tibble)
library(tidyr)
library(purrr)
library(modelr)
library(ggplot2)

set.seed(1) # For reproducibility
x <- 5:10
myData <- tibble(x, 
                 a = x^2 * 2 + x * 3 + 4 + rnorm(1,0,0.01), 
                 b = x^2 * 3 + x * 4 + 5 + rnorm(1,0,0.01))

#Gather (put in Data-Key format)
myDataKeyFormat <- gather(myData,key = "someLabel", value = "myObservation", -x)

myModels <- myDataKeyFormat %>% 
  nest(-someLabel) %>% 
  mutate(model = map(data, ~lm(myObservation ~ poly(x,2), data = .x)))

Вот результат на этом этапе: у вас есть модель для каждого значения someLabel.

# A tibble: 2 × 3
  someLabel             data    model
      <chr>           <list>   <list>
1         a <tibble [6 × 2]> <S3: lm>
2         b <tibble [6 × 2]> <S3: lm>

Я добавлю несколько точек данных в новый столбец (map - это создать его в виде тиббла для каждой строки фрейма данных).

# New data
new_data <- myModels %>% 
  mutate(new = map(data, ~tibble(x = c(3, 4, 11, 12))))

Я добавляю предсказания: add_predictions возьмите фрейм данных и модель в качестве аргумента, поэтому я использую map2 для отображения новых данных и моделей.

fitted_models <- new_data %>% 
  mutate(new = map2(new, model, ~add_predictions(.x, .y)))
fitted_models
# A tibble: 2 × 4
  someLabel             data    model              new
      <chr>           <list>   <list>           <list>
1         a <tibble [6 × 2]> <S3: lm> <tibble [4 × 2]>
2         b <tibble [6 × 2]> <S3: lm> <tibble [4 × 2]>

Вот так: у вас есть для каждой метки данные и модель обучается на этих данных, а новые данные с пре

1