2

我正在尝试向 R 中的矩阵添加一组外推的“观察”。我知道如何使用正常的编程技术（读取；一堆嵌套循环和函数）来做到这一点，但我觉得这必须以更干净的方式实现通过使用内置 R 功能的方式。

下面的代码说明了这一点，以及它在哪里崩溃

非常感谢您的帮助！

亲切的问候

西尔万

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

1 回答 1

1

这是 tidyverse 中的一个解决方案，purrr用于创建不同的模型。这个想法是嵌套（使用tidyr::nest）然后purrr::map训练模型。然后，我将添加新值并使用modelr::add_predictions. 在这里，您将所有数据放在同一个地方：训练数据、模型、测试数据和预测，按您的变量someLabel。我还为您提供了一种可视化数据的方法。您可以查看Hadley Wickham 和 Garrett Grolemund 的R for Data Science，尤其是有关模型的部分以获取更多信息。

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

你去：你有每个标签的数据和模型训练的数据，以及带有预测的新数据。为了绘制它，我使用unnest将数据带回数据框，并将行绑定以将“旧”数据和新值放在一起。

my_points <- bind_rows(unnest(fitted_models, data),
          unnest(fitted_models, new))

ggplot(my_points)+
  geom_point(aes(x = x, y = myObservation), color = "black") +
  geom_point(aes(x = x, y = pred), color = "red")+
  facet_wrap(~someLabel)

楷模

于 2017-04-04T13:44:53.177 回答