रैखिक प्रतिगमन और समूह द्वारा आर

Question

मैं lm()फ़ंक्शन का उपयोग करके आर में एक रैखिक प्रतिगमन करना चाहता हूं । मेरा डेटा एक वार्षिक समय श्रृंखला है जिसमें एक क्षेत्र वर्ष (22 वर्ष) और दूसरा राज्य (50 राज्यों) के लिए है। मैं प्रत्येक राज्य के लिए एक प्रतिगमन फिट करना चाहता हूं ताकि अंत में मेरे पास एलएम प्रतिक्रियाओं का एक वेक्टर हो। मैं प्रत्येक राज्य के लिए लूप के लिए करने की कल्पना कर सकता हूं फिर लूप के अंदर प्रतिगमन कर रहा हूं और प्रत्येक प्रतिगमन के परिणामों को एक वेक्टर में जोड़ सकता हूं। हालाँकि यह बहुत R-like प्रतीत नहीं होता है। एसएएस में मैं एक 'बाय' स्टेटमेंट और एसक्यूएल में मैं एक 'ग्रुप बाय' करूंगा। ऐसा करने का R तरीका क्या है?

Comments

बस लोगों को बताना चाहता हूं कि हालांकि आर में बहुत सारे समूह-कार्य हैं, लेकिन उनमें से सभी समूह-दर प्रतिगमन के लिए सही नहीं हैं। उदाहरण के लिए, aggregateएक सही नहीं है ; न तो हैtapply ।

— 李哲源

Answer 1

यहां 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

Comments

क्या इन दोनों मॉडलों के लिए R2 को सूचीबद्ध करने का कोई तरीका है? उदाहरण के लिए, वर्ष के बाद एक R2 कॉलम जोड़ें। प्रत्येक कोफ़ के लिए पी-मान भी जोड़ें?

— 15

@ToToRo यहां आप एक भयावह समाधान (कभी भी देर से बेहतर) पा सकते हैं: Your.df [, सारांश (lm (Y ~ X)) $ r.squared, by = Your.factor] जहां: Y, X और Your.factor आपके चर हैं कृपया ध्यान रखें कि Your.df एक data.table class होनी चाहिए

— FraNut

Answer 2

यहाँ 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)

Comments

मान लें कि आपने एक अतिरिक्त स्वतंत्र चर जोड़ा है जो सभी राज्यों में उपलब्ध नहीं था (यानी mi.of.ocean.shoreline) जो आपके डेटा में NA द्वारा दर्शाया गया था। क्या lm कॉल विफल नहीं होगी? इससे कैसे निपटा जा सकता है?

— 1

फ़ंक्शन के अंदर आपको उस मामले के लिए परीक्षण करना होगा और एक अलग सूत्र का उपयोग करना होगा

— हेडली

क्या सारांश (अंतिम चरण) में प्रत्येक कॉल के लिए उपसमूह का नाम जोड़ना संभव है?

— चुकंदर

यदि आप दौड़ते हैं layout(matrix(c(1,2,3,4),2,2)) # optional 4 graphs/page और फिर l_ply(models, plot)आपको प्रत्येक अवशिष्ट भूखंड भी मिलता है। क्या समूह के साथ प्रत्येक भूखंड को लेबल करना संभव है (जैसे, इस मामले में "राज्य")?

— ब्रायन डी

Answer 3

2009 के बाद से, dplyrजारी किया गया है जो वास्तव में इस तरह की समूहीकरण करने के लिए एक बहुत अच्छा तरीका प्रदान करता है, जो एसएएस करता है।

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पैकेज का उपयोग कर सकता है । यह पैकेज प्रदान करता है:

तीन एस 3 जेनरिक: सुव्यवस्थित, जो एक प्रतिगमन के गुणांक जैसे एक मॉडल के सांख्यिकीय निष्कर्षों को संक्षेप में प्रस्तुत करता है; वृद्धि, जो पूर्वानुमान, अवशिष्ट और क्लस्टर असाइनमेंट जैसे मूल डेटा में कॉलम जोड़ता है; और झलक, जो मॉडल-स्तरीय आंकड़ों का एक-पंक्ति सारांश प्रदान करता है।

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)

Comments

मुझे काम rowwise(fitted_models) %>% tidy(model)करने के लिए झाड़ू पैकेज प्राप्त करना था , लेकिन अन्यथा, महान जवाब।

— पैडरम

महान काम करता है ... पाइप छोड़ने के बिना यह सब कर सकते हैं:d %>% group_by(state) %>% do(model = lm(response ~ year, data = .)) %>% rowwise() %>% tidy(model)

— होलस्टेलो

Answer 4

मेरी राय में मिश्रित रैखिक मॉडल इस तरह के डेटा के लिए एक बेहतर दृष्टिकोण है। नीचे दिए गए कोड में कुल प्रवृत्ति का प्रभाव है। यादृच्छिक प्रभाव से संकेत मिलता है कि प्रत्येक व्यक्ति की प्रवृत्ति वैश्विक प्रवृत्ति से कैसे भिन्न होती है। सहसंबंध संरचना को अस्थायी स्वायत्तता को ध्यान में रखा जाता है। पिनहेइरो और बेट्स (एस और एस-प्लस में मिश्रित प्रभाव मॉडल) पर एक नज़र डालें।

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

Comments

यह वास्तव में अच्छा सामान्य आँकड़े सिद्धांत उत्तर है जो मुझे उन कुछ चीजों के बारे में सोचने देता है जो मैंने नहीं सोचा था। जिस एप्लिकेशन के कारण मुझे प्रश्न पूछना था वह इस समाधान पर लागू नहीं होगा, लेकिन मुझे खुशी है कि आप इसे लाए हैं। धन्यवाद।

— जद लॉन्ग

एक मिश्रित मॉडल के साथ शुरू करना अच्छा नहीं है - आप कैसे जानते हैं कि किसी भी धारणा को वारंट किया जाता है?

— हैडली

एक को मॉडल सत्यापन (और डेटा के ज्ञान) द्वारा धारणा की जांच करनी चाहिए। BTW आप व्यक्तिगत lm या तो पर धारणा को वारंट नहीं कर सकते। आपको सभी मॉडलों को अलग-अलग मान्य करना होगा।

— थियरी

Answer 5

उपयोग करने data.tableका एक अच्छा समाधान यहाँ @Zach द्वारा CrossValidated में पोस्ट किया गया था । मैं सिर्फ इतना कहना चाहता हूं कि पुनरावृत्ति गुणांक 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

Answer 6

मुझे लगता है कि 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 = .)))

broomइन परिणामों के साथ पैकेज का उपयोग करने पर आगे के विचारों के लिए @Paul Hiemstra का उत्तर देखें ।

Comments

यदि आप सज्जित मूल्यों या अवशिष्टों का एक स्तंभ चाहते हैं, तो मामले में थोड़ा विस्तार: एक रेज () कॉल में एलएम () कॉल लपेटें और फिर अंतिम पंक्ति में एक अनावश्यक () कॉल में सब कुछ पाइप करें। बेशक, आप "मॉडल" से चर नाम को कुछ अधिक प्रासंगिक में बदलना चाहेंगे।

— रैंडी

Answer 7

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

Answer 8

अब मेरा जवाब थोड़ा देर से आता है, लेकिन मैं एक समान कार्यक्षमता की तलाश में था। ऐसा लगता है कि अंतर्निहित फ़ंक्शन 'by' में R समूहीकरण आसानी से कर सकता है:

; निम्नलिखित उदाहरण शामिल हैं, जो प्रति समूह फिट बैठता है और गुणांक को नीलम के साथ निकालता है:

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)

Answer 9

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)

Answer 10

प्रश्न यह लगता है कि कैसे एक लूप के अंदर संशोधित होने वाले फ़ार्मुलों के साथ प्रतिगमन कार्यों को कॉल किया जाए।

यहां बताया गया है कि आप इसे (हीरे के डाटासेट का उपयोग करके) कैसे कर सकते हैं:

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()
  }