sử dụng dự đoán với danh sách các đối tượng lm()

Question

Tôi có dữ liệu mà tôi thường xuyên chạy hồi quy. Mỗi "đoạn" dữ liệu được phù hợp với một hồi quy khác nhau. Ví dụ, mỗi tiểu bang có thể có một hàm khác giải thích giá trị phụ thuộc. Điều này có vẻ giống như một loại "chia nhỏ kết hợp áp dụng" điển hình vì vậy tôi đang sử dụng gói plyr. Tôi có thể dễ dàng tạo danh sách các đối tượng lm() hoạt động tốt. Tuy nhiên tôi không thể hoàn toàn quấn quanh đầu của tôi như thế nào tôi sử dụng những đối tượng sau này để dự đoán giá trị trong một data.frame riêng biệt.

Dưới đây là một ví dụ hoàn toàn giả tạo minh họa những gì tôi đang cố gắng để làm:

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

Vậy làm thế nào để tôi sử dụng lm() đối tượng chứa trong modelList để dự đoán giá trị sử dụng trong năm và tình trạng giá trị độc lập từ newData?

Answer 1

Đây là nỗ lực của tôi:

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 dài chỉnh sửa

Tôi đã lấy cảm hứng từ đủ để làm việc ra một tùy chọn 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 

Answer 2

Điều gì là sai với

lapply(modelList, predict, newData) 

?

EDIT:

Cảm ơn bạn đã giải thích điều gì sai với điều đó. Làm thế nào về:

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

lặp qua các mô hình, và áp dụng các dữ liệu mới (mà là như nhau cho mỗi tiểu bang kể từ khi bạn chỉ làm một expand.grid để tạo ra nó).

EDIT 2:

Nếu newData không có cùng giá trị cho year cho mỗi state như trong ví dụ này, một cách tiếp cận tổng quát hơn có thể được sử dụng. Lưu ý rằng điều này sử dụng định nghĩa gốc của newData, không phải là định nghĩa đầu tiên trong chỉnh sửa đầu tiên.

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

Đầu tiên 15 dòng đầu ra này:

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 

Answer 3

Tôi mang nó phần cứng là phù hợp với mỗi tiểu bang trong newData với mô hình tương ứng.

Điều gì đó giống như vậy?

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

Ở đây tôi sử dụng một "hacky" cách chiết xuất các mô hình nhà nước tương ứng: as.character(min(x$state))

... Có lẽ là một cách tốt hơn?

Output:

> 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 

Hoặc, nếu bạn muốn có một data.frame như đầu ra:

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

Output:

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 

Answer 4

Một giải pháp chỉ với base R. Định dạng của đầu ra là khác nhau, nhưng tất cả các giá trị là ngay tại đó.

models <- lapply(split(myData, myData$state), 'lm', formula = value ~ year) 
pred4 <- mapply('predict', models, split(newData, newData$state)) 

Answer 5

Bạn cần phải sử dụng mdply để cung cấp cả các mô hình và các dữ liệu để mỗi lần gọi hàm:

dataList <- dlply(newData, "state") 

preds <- mdply(cbind(mod = modelList, df = dataList), function(mod, df) { 
    mutate(df, pred = predict(mod, newdata = df)) 
}) 

Answer 6

Có lẽ tôi đang thiếu cái gì, nhưng tôi tin rằng lmList là công cụ lý tưởng ở đây,

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