2015-04-22 76 views
2

我想知道是否有辦法爲每個迴歸方程提取R2。提取按照因子分組的每個迴歸的R^2值(R平方)

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

library(plyr) 
models <- dlply(d, "state", function(df) 
    lm(response ~ year, data = df)) 

ldply(models, coef) 
l_ply(models, summary, .print = TRUE) 

我試圖

l_ply(models, summary$r.squared, .print = TRUE) 

但是,這將引發以下錯誤消息

Error in summary$r.squared : object of type 'closure' is not subsettable 

任何幫助將得到高度讚賞。由於

+3

爲你做這項工作:'ldply(模型,函數(X)摘要(X)$ r.squared)'? – Jota

+1

錯誤是由於摘要是一個函數,您不能在函數上使用'$'運算符。另外,'l_ply'的第二個參數必須是一個函數,它不是你的情況。要獲得正確的解決方案,請參閱Frank ... – Stibu

+0

感謝@Frank提供有用的評論。你想改變你的評論來回答。你能幫助我通過一個命令獲得係數和R2嗎?謝謝 – MYaseen208

回答

6

你可以做到這一點,以獲得R平方值和係數:

ldply(models, function(x) {r.sq <- summary(x)$r.squared 
          intercept <- summary(x)$coefficients[1] 
          beta <- summary(x)$coefficients[2] 
          data.frame(r.sq, intercept, beta)}) 
# state  r.sq intercept  beta 
#1 CA 0.230696121 0.4915617 -0.12343947 
#2 NY 0.003506936 0.1971734 -0.01227367 
2

你可以試試這個

sapply(models, function(x) summary(x)$r.squared) 
    CA  NY 
0.05639 0.23751 
2

如果您嘗試

> typeof(summary) 
[1] "closure" 

你看到'summary'是一個函數。您正嘗試訪問結果的字段,但summary$r.squared嘗試訪問函數/閉包上的該字段。

使用匿名函數,

> l_ply(models, function(m) summary(m)$r.squared, .print = TRUE) 
[1] 0.2319583 
[1] 0.01295825 

會工作,並打印出結果。但是,你說你想「提取結果」。這可能意味着你想使用的結果,而不僅僅是打印它。

l_ply文件(你會通過將R提示符下鍵入?l_ply獲得):

對於列表中的每個元素,應用功能和丟棄的結果。

(所以,如果你想掛到結果此功能將無法正常工作。)

使用標準sapply/lapply將導致

> a <- sapply(models, function(t) summary(t)$r.squared) 
> a 
     CA   NY 
0.23195825 0.01295825 
> typeof(a) 
[1] "double" 
> is.vector(a) 
[1] TRUE 
> # or alternatively 
> l <- lapply(models, function(t) summary(t)$r.squared) 
> l 
$CA 
[1] 0.2319583 

$NY 
[1] 0.01295825 
> typeof(l) 
[1] "list" 

無論是一個應該工作 - 挑選哪個結果(矢量或列表)更容易用於你想要做的事情。 (如果不能確定,隨便挑sapply。)

(或者,如果你想使用的功能從plyr包,laplyldplyllply似乎工作過,但我從來沒有用過這個包,這樣我就可以「T說,什麼是最好的)

5

使用broom包轉換的統計分析對象爲data.frames和dplyrbind_rows

library(dplyr) ; library(broom) 
cbind(
    state = attr(models, "split_labels"), 
    bind_rows(lapply(models, function(x) cbind(
    intercept = tidy(x)$estimate[1], 
    beta = tidy(x)$estimate[2], 
    glance(x)))) 
) 

    state intercept  beta r.squared adj.r.squared sigma statistic p.value df logLik  AIC  BIC deviance df.residual 
1 CA 0.38653551 -0.05459205 0.01427426 -0.10894146 1.434599 0.1158477 0.7423473 2 -16.68252 39.36505 40.27280 16.46460   8 
2 NY 0.09028554 -0.08462742 0.04138985 -0.07843642 1.287909 0.3454155 0.5729312 2 -15.60387 37.20773 38.11549 13.26968   8