используя предикат со списком объектов lm () - PullRequest
18 голосов
/ 14 декабря 2011

У меня есть данные, по которым я регулярно запускаю регрессии. Каждый «кусок» данных соответствует своей регрессии. Например, каждое состояние может иметь свою функцию, которая объясняет зависимое значение. Это похоже на типичный тип проблемы "split-apply-Объединить", поэтому я использую пакет plyr. Я могу легко создать список lm() объектов, который работает хорошо. Однако я не могу полностью понять, как использовать эти объекты позже для прогнозирования значений в отдельном data.frame.

Вот полностью надуманный пример, иллюстрирующий то, что я пытаюсь сделать:

# setting up some fake data
set.seed(1)
funct <- function(myState, myYear){
   rnorm(1, 100, 500) +  myState + (100 * myYear) 
}
state <- 50:60
year <- 10:40
myData <- expand.grid( year, state)
names(myData) <- c("year","state")
myData$value <- apply(myData, 1, function(x) funct(x[2], x[1]))
## ok, done with the fake data generation. 

require(plyr)

modelList <- dlply(myData, "state", function(x) lm(value ~ year, data=x))
## if you want to see the summaries of the lm() do this:  
    # lapply(modelList, summary)

state <- 50:60
year <- 50:60
newData <- expand.grid( year, state)
names(newData) <- c("year","state") 
## now how do I predict the values for newData$value 
   # using the regressions in modelList? 

Так, как я могу использовать lm() объекты, содержащиеся в modelList, для прогнозирования значений, используя год и независимые от состояния значения из newData?

Ответы [ 6 ]

9 голосов
/ 14 декабря 2011

Вот моя попытка:

predNaughty <- ddply(newData, "state", transform,
  value=predict(modelList[[paste(piece$state[1])]], newdata=piece))
head(predNaughty)
#   year state    value
# 1   50    50 5176.326
# 2   51    50 5274.907
# 3   52    50 5373.487
# 4   53    50 5472.068
# 5   54    50 5570.649
# 6   55    50 5669.229
predDiggsApproved <- ddply(newData, "state", function(x)
  transform(x, value=predict(modelList[[paste(x$state[1])]], newdata=x)))
head(predDiggsApproved)
#   year state    value
# 1   50    50 5176.326
# 2   51    50 5274.907
# 3   52    50 5373.487
# 4   53    50 5472.068
# 5   54    50 5570.649
# 6   55    50 5669.229

JD Long edit

Я был достаточно вдохновлен, чтобы выработать опцию adply():

pred3 <- adply(newData, 1,  function(x)
    predict(modelList[[paste(x$state)]], newdata=x))
head(pred3)
#   year state        1
# 1   50    50 5176.326
# 2   51    50 5274.907
# 3   52    50 5373.487
# 4   53    50 5472.068
# 5   54    50 5570.649
# 6   55    50 5669.229
6 голосов
/ 16 декабря 2011

Вам необходимо использовать mdply для предоставления модели и данных для каждого вызова функции:

dataList <- dlply(newData, "state")

preds <- mdply(cbind(mod = modelList, df = dataList), function(mod, df) {
  mutate(df, pred = predict(mod, newdata = df))
})
6 голосов
/ 14 декабря 2011

Решение с просто base R. Формат вывода другой, но все значения тут же.

models <- lapply(split(myData, myData$state), 'lm', formula = value ~ year)
pred4  <- mapply('predict', models, split(newData, newData$state))
4 голосов
/ 14 декабря 2011

Что не так с

lapply(modelList, predict, newData)

?

РЕДАКТИРОВАТЬ:

Спасибо за объяснение, что с этим не так.Как насчет:

newData <- data.frame(year)
ldply(modelList, function(model) {
  data.frame(newData, predict=predict(model, newData))
})

Выполните итерацию по моделям и примените новые данные (которые одинаковы для каждого состояния, поскольку вы только что создали expand.grid для его создания).

РЕДАКТИРОВАТЬ2:

Если newData не имеет одинаковых значений для year для каждого state, как в примере, можно использовать более общий подход.Обратите внимание, что здесь используется исходное определение newData, а не то, которое указано в первом редактировании.

ldply(state, function(s) {
  nd <- newData[newData$state==s,]
  data.frame(nd, predict=predict(modelList[[as.character(s)]], nd))
})

Первые 15 строк этого вывода:

   year state  predict
1    50    50 5176.326
2    51    50 5274.907
3    52    50 5373.487
4    53    50 5472.068
5    54    50 5570.649
6    55    50 5669.229
7    56    50 5767.810
8    57    50 5866.390
9    58    50 5964.971
10   59    50 6063.551
11   60    50 6162.132
12   50    51 5514.825
13   51    51 5626.160
14   52    51 5737.496
15   53    51 5848.832
2 голосов
/ 14 декабря 2011

Я так понимаю, что сложная часть - это сопоставление каждого состояния в newData с соответствующей моделью.

Возможно, что-то подобное?

predList <- dlply(newData, "state", function(x) {
  predict(modelList[[as.character(min(x$state))]], x) 
})

Здесь я использовал "хакерский" способизвлечения соответствующей модели состояния: as.character(min(x$state))

... Возможно, есть лучший способ?

Вывод:

> predList[1:2]
$`50`
       1        2        3        4        5        6        7        8        9       10       11 
5176.326 5274.907 5373.487 5472.068 5570.649 5669.229 5767.810 5866.390 5964.971 6063.551 6162.132 

$`51`
      12       13       14       15       16       17       18       19       20       21       22 
5514.825 5626.160 5737.496 5848.832 5960.167 6071.503 6182.838 6294.174 6405.510 6516.845 6628.181

Или, если вы хотите data.frame как вывод:

predData <- ddply(newData, "state", function(x) {
  y <-predict(modelList[[as.character(min(x$state))]], x)
  data.frame(id=names(y), value=c(y))
})

Выход:

head(predData)
  state id    value
1    50  1 5176.326
2    50  2 5274.907
3    50  3 5373.487
4    50  4 5472.068
5    50  5 5570.649
6    50  6 5669.229
1 голос
/ 23 июля 2014

Может быть, я что-то упускаю, но я считаю, lmList - идеальный инструмент здесь,

library(nlme)
ll = lmList(value ~ year | state, data=myData)
predict(ll, newData)


## Or, to show that it produces the same results as the other proposed methods...
newData[["value"]] <- predict(ll, newData)
head(newData)
#   year state    value
# 1   50    50 5176.326
# 2   51    50 5274.907
# 3   52    50 5373.487
# 4   53    50 5472.068
# 5   54    50 5570.649
# 6   55    50 5669.229
...