Doğrusal Regresyon ve R'de gruplama


98

lm()Fonksiyonu kullanarak R'de doğrusal bir regresyon yapmak istiyorum . Verilerim, bir alanı yıl (22 yıl) ve diğeri eyalet (50 eyalet) için olan yıllık bir zaman serisidir. Her durum için bir regresyon uydurmak istiyorum, böylece sonunda bir lm yanıtları vektörüm olur. Her durum için for döngüsü yaptığımı, ardından döngü içinde regresyon yaptığımı ve her regresyonun sonuçlarını bir vektöre eklediğini hayal edebiliyorum. Ancak bu pek R benzeri görünmüyor. SAS'da bir 'by' ifadesi yapardım ve SQL'de bir 'gruplama ölçütü' yapardım. Bunu yapmanın R yolu nedir?


1
İnsanlara, R'de çok sayıda gruplama işlevi olmasına rağmen, hepsinin gruplara göre regresyon için doğru işlev olmadığını söylemek istiyorum. Örneğin, aggregatedoğru olan değil ; hiçbiritapply .
李哲源

Yanıtlar:


51

lme4Paketi kullanmanın bir yolu .

 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
Bu iki model için R2'yi listelemenin bir yolu var mı? örn. yıldan sonra bir R2 sütunu ekleyin. Ayrıca katsayıların her biri için p değeri eklensin mi?
ToToRo

3
@ToToRo burada uygulanabilir bir çözüm bulabilirsiniz (geç olması hiç olmamasından daha iyidir): Your.df [, özet (lm (Y ~ X)) $ r.squared, by = Your.factor] burada: Y, X ve Your.factor değişkenlerinizdir. Lütfen Your.df'nin bir data.table sınıfı olması gerektiğini unutmayın
FraNut

61

İşte plyr paketini kullanan bir yaklaşım :

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)

Verilerinizde NA tarafından temsil edilen tüm eyaletlerde (yani, mile.of.ocean.shoreline) kullanılamayan ek bir bağımsız değişken eklediğinizi varsayalım. Lm çağrısı başarısız olmaz mı? Nasıl başa çıkılabilir?
MikeTP

İşlevin içinde bu durumu test etmeniz ve farklı bir formül kullanmanız gerekir
hadley

Özette (son adım) her bir çağrıya alt grubun adını eklemek mümkün müdür?
2014

Eğer koşarsanız layout(matrix(c(1,2,3,4),2,2)) # optional 4 graphs/page ve sonra l_ply(models, plot)her bir kalıntı grafiğini alırsınız. Grafiklerin her birini grupla etiketlemek mümkün mü (örneğin, bu durumda "durum")?
Brian D

52

2009'dan bu yana, dplyrSAS'ın yaptıklarına çok benzeyen bu tür gruplamaları yapmak için gerçekten çok güzel bir yol sağlayan yayınlandı.

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  

Katsayıları ve Rsquared / p.value'yu almak için broompaket kullanılabilir. Bu paket şunları sağlar:

üç S3 jenerik: regresyon katsayıları gibi bir modelin istatistiksel bulgularını özetleyen tidy; orijinal verilere tahminler, artıklar ve küme atamaları gibi sütunlar ekleyen artırma; ve model düzeyindeki istatistiklerin tek satırlık bir özetini sağlayan bakış.

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)Süpürge paketini çalıştırmak için yapmam gerekiyordu, ama aksi halde harika bir cevap.
pedram

3
Harika çalışıyor ... tüm bunları borudan çıkmadan yapabilirsiniz:d %>% group_by(state) %>% do(model = lm(response ~ year, data = .)) %>% rowwise() %>% tidy(model)
holastello

2
@pedram ve @holastello, bu artık en azından R 3.6.1, broom_0.7.0, dplyr_0.8.3 ile çalışmıyor. 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

Bence karma doğrusal bir model bu tür veriler için daha iyi bir yaklaşım. Aşağıdaki kod sabit etkide genel eğilim olarak verilmiştir. Rastgele etkiler, her bir durum için eğilimin küresel eğilimden ne kadar farklı olduğunu gösterir. Korelasyon yapısı, zamansal otokorelasyonu hesaba katar. Pinheiro & Bates'e (S ve S-Plus'ta Karışık Etkili Modeller) bir göz atın.

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

3
Bu, dikkate almadığım bazı şeyler hakkında düşünmemi sağlayan gerçekten iyi bir genel istatistik teorisi cevabı. Soruyu sormama neden olan uygulama bu çözüme uygulanamayacaktı, ancak bunu gündeme getirmenize sevindim. Teşekkür ederim.
JD Long

1
Karma bir modelle başlamak iyi bir fikir değildir - varsayımlardan herhangi birinin garantili olduğunu nasıl anlarsınız?
hadley

8
Model doğrulaması (ve veri bilgisi) ile varsayım kontrol edilmelidir. BTW, bireysel lm'ler üzerindeki varsayımı da garanti edemezsiniz. Tüm modelleri ayrı ayrı doğrulamanız gerekir.
Thierry

17

Güzel bir çözüm kullanarak data.tablegönderilmiş buraya @Zach tarafından CrossValidated içinde. Yinelemeli olarak regresyon katsayısı r ^ 2 elde etmenin de mümkün olduğunu eklemeliyim:

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

ve diğer tüm çıktılar 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::mapBu soruna yaklaşımı eklemenin faydalı olacağını düşünüyorum .

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 = .)))

broomBu sonuçlarla paketi kullanma hakkında daha fazla fikir için @Paul Hiemstra'nın cevabına bakın .


Bir sütun uydurulmuş değerler veya kalıntılar istemeniz durumunda küçük bir uzatma: lm () çağrısını bir resid () çağrısına sarın ve ardından son satırdaki her şeyi bir unnest () çağrısına yönlendirin. Elbette, değişken adını "model" den daha alakalı bir şeye değiştirmek istersiniz.
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

Şimdi cevabım biraz geç geliyor, ancak benzer bir işlev arıyordum. Görünüşe göre R'deki yerleşik 'by' işlevi de gruplamayı kolayca yapabilir:

? by, gruba uyan ve katsayıları sapply ile çıkaran aşağıdaki örneği içerir:

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)

5

Yukarıdaki lm()işlev basit bir örnektir. Bu arada, veritabanınızın aşağıdaki şekilde sütunlara sahip olduğunu hayal ediyorum:

yıl durumu var1 var2 y ...

Benim bakış açıma göre, aşağıdaki kodu kullanabilirsiniz:

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

Soru, bir döngü içinde değiştirilen formüllerle regresyon işlevlerinin nasıl çağrılacağıyla ilgili görünüyor.

İşte bunu nasıl yapabileceğiniz (elmas veri kümesini kullanarak):

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()
  }
Sitemizi kullandığınızda şunları okuyup anladığınızı kabul etmiş olursunuz: Çerez Politikası ve Gizlilik Politikası.
Licensed under cc by-sa 3.0 with attribution required.