Linear Regression และจัดกลุ่มตามใน R


97

ฉันต้องการทำการถดถอยเชิงเส้นใน R โดยใช้lm()ฟังก์ชัน ข้อมูลของฉันเป็นอนุกรมเวลารายปีโดยมีหนึ่งฟิลด์สำหรับปี (22 ปี) และอีกฟิลด์หนึ่งสำหรับรัฐ (50 สถานะ) ฉันต้องการให้พอดีกับการถดถอยสำหรับแต่ละสถานะดังนั้นในตอนท้ายฉันมีเวกเตอร์ของการตอบสนอง lm ฉันนึกภาพออกว่าทำลูปสำหรับแต่ละสถานะจากนั้นทำการถดถอยภายในลูปและเพิ่มผลลัพธ์ของการถดถอยแต่ละครั้งให้กับเวกเตอร์ อย่างไรก็ตามนั่นดูเหมือนจะไม่เหมือน R มากนัก ใน SAS ฉันจะทำคำสั่ง 'โดย' และใน SQL ฉันจะทำ 'จัดกลุ่มตาม' R ทำแบบนี้คืออะไร?


1
เพียงแค่ต้องการบอกผู้คนว่าแม้ว่าจะมีฟังก์ชัน group-by มากมายใน R แต่ก็ไม่ใช่ทั้งหมดที่เหมาะสำหรับการถดถอยแบบกลุ่ม ยกตัวอย่างเช่นaggregateไม่ได้เป็นหนึ่งที่เหมาะสม ; ไม่เป็น tapply
李哲源

คำตอบ:


51

นี่เป็นวิธีหนึ่งในการใช้lme4แพ็คเกจ

 library(lme4)
 d <- data.frame(state=rep(c('NY', 'CA'), c(10, 10)),
                 year=rep(1:10, 2),
                 response=c(rnorm(10), rnorm(10)))

 xyplot(response ~ year, groups=state, data=d, type='l')

 fits <- lmList(response ~ year | state, data=d)
 fits
#------------
Call: lmList(formula = response ~ year | state, data = d)
Coefficients:
   (Intercept)        year
CA -1.34420990  0.17139963
NY  0.00196176 -0.01852429

Degrees of freedom: 20 total; 16 residual
Residual standard error: 0.8201316

2
มีวิธีลงรายการ R2 สำหรับทั้งสองรุ่นนี้หรือไม่? เช่นเพิ่มคอลัมน์ R2 ทุกปี เพิ่มค่า p สำหรับแต่ละ coeff ด้วยหรือไม่?
ToToRo

3
@ToToRo ที่นี่คุณจะพบวิธีแก้ปัญหาที่เป็นไปได้ (ดีกว่าไม่ช้า): Your.df [, สรุป (lm (Y ~ X)) $ r.squared, by = Your.factor] โดยที่: Y, X และ Your.factor เป็นตัวแปรของคุณ โปรดทราบว่า Your.df ต้องเป็นคลาส
data.table

60

นี่คือแนวทางในการใช้แพ็คเกจplyr :

d <- data.frame(
  state = rep(c('NY', 'CA'), 10),
  year = rep(1:10, 2),
  response= rnorm(20)
)

library(plyr)
# Break up d by state, then fit the specified model to each piece and
# return a list
models <- dlply(d, "state", function(df) 
  lm(response ~ year, data = df))

# Apply coef to each model and return a data frame
ldply(models, coef)

# Print the summary of each model
l_ply(models, summary, .print = TRUE)

สมมติว่าคุณได้เพิ่มตัวแปรอิสระเพิ่มเติมที่ไม่สามารถใช้ได้ในทุกรัฐ (เช่น miles.of.ocean.shoreline) ที่แสดงโดย NA ในข้อมูลของคุณ การโทร lm จะไม่ล้มเหลวหรือ? จะจัดการได้อย่างไร?
MikeTP

ภายในฟังก์ชันคุณจะต้องทดสอบสำหรับกรณีนั้นและใช้สูตรอื่น
hadley

เป็นไปได้ไหมที่จะเพิ่มชื่อของกลุ่มย่อยในการเรียกแต่ละครั้งในสรุป (ขั้นตอนสุดท้าย)
erc

ถ้าคุณเรียกใช้layout(matrix(c(1,2,3,4),2,2)) # optional 4 graphs/page แล้วl_ply(models, plot)คุณจะได้รับแต่ละแปลงที่เหลือด้วย เป็นไปได้หรือไม่ที่จะติดป้ายกำกับแต่ละแปลงด้วยกลุ่ม (เช่น "สถานะ" ในกรณีนี้)
Brian D

51

ตั้งแต่ปี 2009 dplyrได้รับการเผยแพร่ซึ่งเป็นวิธีที่ดีมากในการจัดกลุ่มประเภทนี้ซึ่งคล้ายคลึงกับสิ่งที่ SAS ทำ

library(dplyr)

d <- data.frame(state=rep(c('NY', 'CA'), c(10, 10)),
                year=rep(1:10, 2),
                response=c(rnorm(10), rnorm(10)))
fitted_models = d %>% group_by(state) %>% do(model = lm(response ~ year, data = .))
# Source: local data frame [2 x 2]
# Groups: <by row>
#
#    state   model
#   (fctr)   (chr)
# 1     CA <S3:lm>
# 2     NY <S3:lm>
fitted_models$model
# [[1]]
# 
# Call:
# lm(formula = response ~ year, data = .)
# 
# Coefficients:
# (Intercept)         year  
#    -0.06354      0.02677  
#
#
# [[2]]
# 
# Call:
# lm(formula = response ~ year, data = .)
# 
# Coefficients:
# (Intercept)         year  
#    -0.35136      0.09385  

ในการดึงค่าสัมประสิทธิ์และ Rsquared / p.value เราสามารถใช้broomแพ็คเกจได้ แพ็คเกจนี้ให้:

ข้อมูลทั่วไปของ S3 สามประการ: เป็นระเบียบเรียบร้อยซึ่งสรุปผลการค้นพบทางสถิติของแบบจำลองเช่นค่าสัมประสิทธิ์ของการถดถอย การเพิ่มซึ่งจะเพิ่มคอลัมน์ให้กับข้อมูลต้นฉบับเช่นการคาดการณ์ส่วนที่เหลือและการกำหนดคลัสเตอร์ และการเหลือบดูซึ่งให้ข้อมูลสรุปแบบแถวเดียวของสถิติระดับโมเดล

library(broom)
fitted_models %>% tidy(model)
# Source: local data frame [4 x 6]
# Groups: state [2]
# 
#    state        term    estimate  std.error  statistic   p.value
#   (fctr)       (chr)       (dbl)      (dbl)      (dbl)     (dbl)
# 1     CA (Intercept) -0.06354035 0.83863054 -0.0757668 0.9414651
# 2     CA        year  0.02677048 0.13515755  0.1980687 0.8479318
# 3     NY (Intercept) -0.35135766 0.60100314 -0.5846187 0.5749166
# 4     NY        year  0.09385309 0.09686043  0.9689519 0.3609470
fitted_models %>% glance(model)
# Source: local data frame [2 x 12]
# Groups: state [2]
# 
#    state   r.squared adj.r.squared     sigma statistic   p.value    df
#   (fctr)       (dbl)         (dbl)     (dbl)     (dbl)     (dbl) (int)
# 1     CA 0.004879969  -0.119510035 1.2276294 0.0392312 0.8479318     2
# 2     NY 0.105032068  -0.006838924 0.8797785 0.9388678 0.3609470     2
# Variables not shown: logLik (dbl), AIC (dbl), BIC (dbl), deviance (dbl),
#   df.residual (int)
fitted_models %>% augment(model)
# Source: local data frame [20 x 10]
# Groups: state [2]
# 
#     state   response  year      .fitted   .se.fit     .resid      .hat
#    (fctr)      (dbl) (int)        (dbl)     (dbl)      (dbl)     (dbl)
# 1      CA  0.4547765     1 -0.036769875 0.7215439  0.4915464 0.3454545
# 2      CA  0.1217003     2 -0.009999399 0.6119518  0.1316997 0.2484848
# 3      CA -0.6153836     3  0.016771076 0.5146646 -0.6321546 0.1757576
# 4      CA -0.9978060     4  0.043541551 0.4379605 -1.0413476 0.1272727
# 5      CA  2.1385614     5  0.070312027 0.3940486  2.0682494 0.1030303
# 6      CA -0.3924598     6  0.097082502 0.3940486 -0.4895423 0.1030303
# 7      CA -0.5918738     7  0.123852977 0.4379605 -0.7157268 0.1272727
# 8      CA  0.4671346     8  0.150623453 0.5146646  0.3165112 0.1757576
# 9      CA -1.4958726     9  0.177393928 0.6119518 -1.6732666 0.2484848
# 10     CA  1.7481956    10  0.204164404 0.7215439  1.5440312 0.3454545
# 11     NY -0.6285230     1 -0.257504572 0.5170932 -0.3710185 0.3454545
# 12     NY  1.0566099     2 -0.163651479 0.4385542  1.2202614 0.2484848
# 13     NY -0.5274693     3 -0.069798386 0.3688335 -0.4576709 0.1757576
# 14     NY  0.6097983     4  0.024054706 0.3138637  0.5857436 0.1272727
# 15     NY -1.5511940     5  0.117907799 0.2823942 -1.6691018 0.1030303
# 16     NY  0.7440243     6  0.211760892 0.2823942  0.5322634 0.1030303
# 17     NY  0.1054719     7  0.305613984 0.3138637 -0.2001421 0.1272727
# 18     NY  0.7513057     8  0.399467077 0.3688335  0.3518387 0.1757576
# 19     NY -0.1271655     9  0.493320170 0.4385542 -0.6204857 0.2484848
# 20     NY  1.2154852    10  0.587173262 0.5170932  0.6283119 0.3454545
# Variables not shown: .sigma (dbl), .cooksd (dbl), .std.resid (dbl)

2
ฉันต้องทำrowwise(fitted_models) %>% tidy(model)เพื่อให้แพคเกจไม้กวาดใช้งานได้ แต่อย่างอื่นคำตอบที่ดี
pedram

3
ใช้งานได้ดี ... ทำได้ทั้งหมดโดยไม่ต้องออกจากท่อ:d %>% group_by(state) %>% do(model = lm(response ~ year, data = .)) %>% rowwise() %>% tidy(model)
holastello

1
@pedram และ @holastello สิ่งนี้ใช้ไม่ได้อีกต่อไปอย่างน้อยกับ R 3.6.1, broom_0.7.0, dplyr_0.8.3 d %>% group_by(state) %>% do(model=lm(response ~year, data = .)) %>% rowwise() %>% tidy(model) Error in var(if (is.vector(x) || is.factor(x)) x else as.double(x), na.rm = na.rm) : Calling var(x) on a factor x is defunct. Use something like 'all(duplicated(x)[-1L])' to test for a constant vector. In addition: Warning messages: 1: Data frame tidiers are deprecated and will be removed in an upcoming release of broom. ...
Chris Nolte

24

ในความคิดของฉันคือแบบจำลองเชิงเส้นแบบผสมเป็นแนวทางที่ดีกว่าสำหรับข้อมูลประเภทนี้ รหัสด้านล่างที่ระบุในผลคงที่แนวโน้มโดยรวม ผลกระทบแบบสุ่มบ่งชี้ว่าแนวโน้มของแต่ละรัฐแตกต่างจากแนวโน้มของโลกอย่างไร โครงสร้างสหสัมพันธ์จะคำนึงถึงความสัมพันธ์ทางโลกโดยอัตโนมัติ ดู Pinheiro & Bates (รุ่นเอฟเฟกต์ผสมใน S และ S-Plus)

library(nlme)
lme(response ~ year, random = ~year|state, correlation = corAR1(~year))

3
นี่เป็นคำตอบทางทฤษฎีสถิติทั่วไปที่ดีมากซึ่งทำให้ฉันคิดถึงบางสิ่งที่ฉันไม่ได้พิจารณา แอปพลิเคชันที่ทำให้ฉันต้องถามคำถามจะไม่สามารถใช้ได้กับโซลูชันนี้ แต่ฉันดีใจที่คุณนำมาใช้ ขอบคุณ.
JD Long

1
ไม่ใช่ความคิดที่ดีที่จะเริ่มต้นด้วยรูปแบบผสมคุณจะรู้ได้อย่างไรว่ามีการรับประกันสมมติฐานใด ๆ
hadley

8
เราควรตรวจสอบสมมติฐานโดยการตรวจสอบแบบจำลอง (และความรู้เกี่ยวกับข้อมูล) BTW คุณไม่สามารถรับประกันสมมติฐานของแต่ละ lm ได้เช่นกัน คุณจะต้องตรวจสอบทุกรุ่นแยกกัน
Thierry

17

วิธีการแก้ปัญหาที่ดีใช้data.tableถูกโพสต์ที่นี่ใน CrossValidated โดย @Zach ฉันแค่เพิ่มว่ามันเป็นไปได้ที่จะได้รับสัมประสิทธิ์การถดถอยซ้ำ ๆ r ^ 2:

## make fake data
    library(data.table)
    set.seed(1)
    dat <- data.table(x=runif(100), y=runif(100), grp=rep(1:2,50))

##calculate the regression coefficient r^2
    dat[,summary(lm(y~x))$r.squared,by=grp]
       grp         V1
    1:   1 0.01465726
    2:   2 0.02256595

เช่นเดียวกับผลลัพธ์อื่น ๆ ทั้งหมดจากsummary(lm):

dat[,list(r2=summary(lm(y~x))$r.squared , f=summary(lm(y~x))$fstatistic[1] ),by=grp]
   grp         r2        f
1:   1 0.01465726 0.714014
2:   2 0.02256595 1.108173

8

ฉันคิดว่ามันคุ้มค่าที่จะเพิ่มpurrr::mapแนวทางในการแก้ปัญหานี้

library(tidyverse)

d <- data.frame(state=rep(c('NY', 'CA'), c(10, 10)),
                                 year=rep(1:10, 2),
                                 response=c(rnorm(10), rnorm(10)))

d %>% 
  group_by(state) %>% 
  nest() %>% 
  mutate(model = map(data, ~lm(response ~ year, data = .)))

ดูคำตอบของ @Paul Hiemstra สำหรับแนวคิดเพิ่มเติมเกี่ยวกับการใช้broomแพ็คเกจพร้อมผลลัพธ์เหล่านี้


ส่วนขยายเล็กน้อยในกรณีที่คุณต้องการคอลัมน์ที่มีค่าติดตั้งหรือส่วนที่เหลือ: ห่อสาย lm () ไว้ในการเรียกที่เหลือ () จากนั้นต่อท่อทุกอย่างในบรรทัดสุดท้ายให้เป็นการเรียกที่ไม่สำคัญที่สุด () แน่นอนคุณต้องการเปลี่ยนชื่อตัวแปรจาก "model" เป็นชื่อที่เกี่ยวข้องมากขึ้น
Randy

8
## make fake data
 ngroups <- 2
 group <- 1:ngroups
 nobs <- 100
 dta <- data.frame(group=rep(group,each=nobs),y=rnorm(nobs*ngroups),x=runif(nobs*ngroups))
 head(dta)
#--------------------
  group          y         x
1     1  0.6482007 0.5429575
2     1 -0.4637118 0.7052843
3     1 -0.5129840 0.7312955
4     1 -0.6612649 0.9028034
5     1 -0.5197448 0.1661308
6     1  0.4240346 0.8944253
#------------ 
## function to extract the results of one model
 foo <- function(z) {
   ## coef and se in a data frame
   mr <- data.frame(coef(summary(lm(y~x,data=z))))
   ## put row names (predictors/indep variables)
   mr$predictor <- rownames(mr)
   mr
 }
 ## see that it works
 foo(subset(dta,group==1))
#=========
              Estimate Std..Error   t.value  Pr...t..   predictor
(Intercept)  0.2176477  0.1919140  1.134090 0.2595235 (Intercept)
x           -0.3669890  0.3321875 -1.104765 0.2719666           x
#----------
## one option: use command by
 res <- by(dta,dta$group,foo)
 res
#=========
dta$group: 1
              Estimate Std..Error   t.value  Pr...t..   predictor
(Intercept)  0.2176477  0.1919140  1.134090 0.2595235 (Intercept)
x           -0.3669890  0.3321875 -1.104765 0.2719666           x
------------------------------------------------------------ 
dta$group: 2
               Estimate Std..Error    t.value  Pr...t..   predictor
(Intercept) -0.04039422  0.1682335 -0.2401081 0.8107480 (Intercept)
x            0.06286456  0.3020321  0.2081387 0.8355526           x

## using package plyr is better
 library(plyr)
 res <- ddply(dta,"group",foo)
 res
#----------
  group    Estimate Std..Error    t.value  Pr...t..   predictor
1     1  0.21764767  0.1919140  1.1340897 0.2595235 (Intercept)
2     1 -0.36698898  0.3321875 -1.1047647 0.2719666           x
3     2 -0.04039422  0.1682335 -0.2401081 0.8107480 (Intercept)
4     2  0.06286456  0.3020321  0.2081387 0.8355526           x

7

ตอนนี้ฉันได้รับคำตอบช้าไปหน่อย แต่ฉันกำลังมองหาฟังก์ชันที่คล้ายกัน ดูเหมือนว่าฟังก์ชันในตัว 'by' ใน R สามารถทำการจัดกลุ่มได้อย่างง่ายดาย:

โดยมีตัวอย่างต่อไปนี้ซึ่งเหมาะกับแต่ละกลุ่มและแยกค่าสัมประสิทธิ์ด้วย sapply:

require(stats)
## now suppose we want to extract the coefficients by group 
tmp <- with(warpbreaks,
            by(warpbreaks, tension,
               function(x) lm(breaks ~ wool, data = x)))
sapply(tmp, coef)

4

lm()ฟังก์ชั่นดังกล่าวข้างต้นเป็นตัวอย่างง่ายๆ อย่างไรก็ตามฉันคิดว่าฐานข้อมูลของคุณมีคอลัมน์ในรูปแบบต่อไปนี้:

ปีรัฐ var1 var2 y ...

ในมุมมองของฉันคุณสามารถใช้รหัสต่อไปนี้:

require(base) 
library(base) 
attach(data) # data = your data base
             #state is your label for the states column
modell<-by(data, data$state, function(data) lm(y~I(1/var1)+I(1/var2)))
summary(modell)

0

คำถามน่าจะเกี่ยวกับวิธีเรียกฟังก์ชันการถดถอยด้วยสูตรที่แก้ไขภายในลูป

นี่คือวิธีที่คุณสามารถทำได้ใน (โดยใช้ชุดข้อมูลเพชร):

attach(ggplot2::diamonds)
strCols = names(ggplot2::diamonds)

formula <- list(); model <- list()
for (i in 1:1) {
  formula[[i]] = paste0(strCols[7], " ~ ", strCols[7+i])
  model[[i]] = glm(formula[[i]]) 

  #then you can plot the results or anything else ...
  png(filename = sprintf("diamonds_price=glm(%s).png", strCols[7+i]))
  par(mfrow = c(2, 2))      
  plot(model[[i]])
  dev.off()
  }
โดยการใช้ไซต์ของเรา หมายความว่าคุณได้อ่านและทำความเข้าใจนโยบายคุกกี้และนโยบายความเป็นส่วนตัวของเราแล้ว
Licensed under cc by-sa 3.0 with attribution required.