(lm) lm AIC 2 / 1

Size: px

Start display at page:

Download "(lm) lm AIC 2 / 1"

つねたけうづき
5 years ago
Views:

1 W707 1 / 1

2 (lm) lm AIC 2 / 1

3 : y = β 1 x 1 + β 2 x β d x d + β d+1 + ϵ (ϵ N(0, σ 2 )) y R: x R d : β i (i = 1,..., d):, β d+1 : ( ) (d = 1) y = β 1 x 1 + β 2 + ϵ (d > 1) y = β 1 x 1 + β 2 x β d x d + β d+1 + ϵ 3 / 1

4 price 2e+07 4e+07 6e+07 8e area 4 / 1

5 n ( ) (y i, x i ) R R d (i = 1,..., n) y 1 x 1 Y =. R n 1 1.., X =.. R n (d+1), ϵ = ϵ R n, x n 1 y n β ( ), Y = X β + ϵ. ϵ n ( ) ˆβ = (X X ) 1 X Y. Cramer-Rao ( ) 5 / 1

6 X ˆβ ( ( ) ) 1 1 n(ˆβ β ) N 0, σ 2 n X X. ( ) ˆβ = (X X ) 1 X Y = (X X ) 1 X (X β + ϵ) n(ˆβ β ) = n(x X ) 1 X ϵ. (1) ϵ i N(0, σ 2 ) 0. E[n(X X ) 1 X ϵϵ X (X X ) 1 ] = n(x X ) 1 X E[ϵϵ ]X (X X ) 1 = σ ( 2 1 n X X ) 1. σ 2 ( ) 6 / 1

7 ˆϵ ϵ ˆϵ = Y X ˆβ = X (β ˆβ) + ϵ = (I X (X X ) 1 X )ϵ S = ( 1 n X X ) 1 n( ˆβ j βj )/ S jj t(n (d + 1)) ˆϵ 2 /(n (d + 1)) ( n (d + 1) t ). β j : β j = 0 n ˆβ j / S jj ˆϵ 2 /(n (d + 1)) t α(n (d + 1)) βj = 0 t α t α (βj = 0 ˆβ j ) 7 / 1

8 1 ˆϵ = Y X ˆβ = X (β ˆβ) + ϵ = (I X (X X ) 1 X )ϵ 0 ˆβ β = (X X ) 1 X ϵ (Eq. (1)) E[ˆϵ(ˆβ β ) ] = O ˆϵ ˆβ β ( ) 2 (I X (X X ) 1 X ) n (d + 1) ˆϵ 2 /σ 2 n (d + 1) χ 2 3 n( ˆβ j β j )/ S jj N(0, σ 2 ) n( ˆβj β j )/ S jj 4 ˆϵ 2 /(n (d+1)) χ2 t σ 2 8 / 1

9 : F (H 0 ) Ȳ = H 0 : β 1 = β 2 = = β d = 0 vs H 1 : F = X ˆβ 1Ȳ 2 /d ˆϵ 2 F (d, n d 1). /(n (d + 1)) n i=1 y i n (R 2 ) (R 2 A ) R 2 = 1 Y X ˆβ 2 Y 1Ȳ, 2 R2 A = 1 Y X ˆβ 2 /(n d 1) Y 1Ȳ 2 /(n 1) 9 / 1

10 AIC (overfit), AIC (Akaike Information Criterion) d M d AIC : ˆθ Md M d AIC = 2 log(p({x i } n i=1 ˆθ Md )) + 2m. AIC = AIC 10 / 1

11 AIC ( ) ( ) AIC KL-divergence ( KL-divergence) ( ) ( ) 11 / 1

12 ( ) 12 / 1

13 RC SRC ( ) {0, 1} RC 1, SRC 0 13 / 1

14 : lm(formula, data, subset, weights, na.action, method = qr, model = TRUE, x = FALSE, y = FALSE, qr = TRUE, singular.ok = TRUE, contrasts = NULL, offset,...) formula data subset weights na.action NA 14 / 1

15 formula y x y x1 + x2 y x1 * x2 y x - 1 y 1 + x + I(xˆ2) y x z y., data = y = β 1 x + b + ϵ y = β 1 x1 + β 2 x2 + b + ϵ y = β 1 x1 + β 2 x2 + β 3 x1x2 + b + ϵ ( ) y = β 1 x + ϵ : y = b + β 1 x + β 2 x 2 + ϵ z y x y x 1,..., x d y = b + d j=1 β jx j + ϵ x <- seq(-10,10); y<- 3*x + rnorm(21); lm(y ~ x) # y x x <- seq(-10,10); z <- seq(-10,10)^2; y<- 3*x + 4*z + rnorm(21); datain <- data.frame(x=x,z=z,y=y) lm(y ~ x, data=datain) # y x lm(y ~., data=datain) # y y 15 / 1

16 x <- read.csv("setagaya_manshion.csv") sman = data.frame(price=x[[1]],walk=x[[3]],area=x[[5]], str=ifelse(x[[6]]==" ",1,0),kenpei=x[[7]],youseki=x[[8]], tikunen=x[[9]],kyuko=x[[10]]) # 0-1 plot(sman) # price 2e walk area str kenpei youseki tikunen kyuko 16 / 1

17 (lm) sman.lm <- lm(price ~ area,data=sman) # OK plot(sman$area,sman$price, xlab="area",ylab="price") # abline(sman.lm, lwd=1, col="blue") price 2e+07 4e+07 6e+07 8e area 17 / 1

18 (summary) > summary(sman.lm) Call: lm(formula = price ~ area, data = sman) Residuals: Min 1Q Median 3Q Max Coefficients: Estimate Std. Error t value Pr(> t ) (Intercept) area <2e-16 *** --- Signif. codes: 0 *** ** 0.01 * Residual standard error: on 128 degrees of freedom Multiple R-squared: , Adjusted R-squared: F-statistic: on 1 and 128 DF, p-value: < 2.2e / 1

19 (1) Call: lm(formula = price ~ area, data = sman) Residuals: Min 1Q Median 3Q Max y i ŷ i = y i ˆβ x 19 / 1

20 (2) Coefficients: Estimate Std. Error t value Pr(> t ) (Intercept) area <2e-16 *** --- Signif. codes: 0 *** ** 0.01 * t- p- (Intercept). t- p- 0 y area ( α = 0.05 ) 20 / 1

21 (3) Residual standard error: on 128 degrees of freedom (σ ) =128. F-statistic: on 1 and 128 DF, p-value: < 2.2e-16 β = 0 F (d, n d 1) ( ) (α = 0.05) Multiple R-squared: , Adjusted R-squared: (Adjusted R-squared) Adjusted 21 / 1

22 par(mfrow=c(2,2)) # Figure 2x2 plot(sman.lm) Residuals Standardized residuals 2e+07 0e+00 2e Residuals vs Fitted e+07 3e+07 5e+07 7e Fitted values Scale Location e+07 3e+07 5e+07 7e+07 Standardized residuals Standardized residuals Normal Q Q Theoretical Quantiles Residuals vs Leverage Cook s distance ( ) : ŷ i vs y i ŷ i ( ) Q-Q : Q-Q ( ) Scale-Location : ( ) Cook : ( ). 0.5 Fitted values Leverage 22 / 1

23 predict interval= confidence ( ˆβ X ) area.plot <- seq(min(sman$area)*0.9,max(sman$area)*1.1,by=1) # sman.con <- predict(sman.lm, data.frame(area=area.plot),interval="confidence") # price 2e+07 4e+07 6e+07 8e+07 1e area (m^2) 23 / 1

24 > sman.lm3 <- lm(price ~ area + tikunen, data=sman) > (AIC(sman.lm3)) [1] AIC( ) AIC sman.lmall <- lm(price ~., data=sman) sman.lmaic <- step(sman.lmall) summary(sman.lmaic) step( ) AIC ( ) walk + area + tikunen 24 / 1

25 > shapiro.test(sman.lmaic$residuals) Shapiro-Wilk normality test data: sman.lmaic$residuals W = , p-value = / 1

26 QQ qqnorm(sman.lmaic$residual) Normal Q Q Plot Sample Quantiles 1.5e e e e Theoretical Quantiles QQ 26 / 1

DAA09

DAA09 > summary(dat.lm1) Call: lm(formula = sales ~ price, data = dat) Residuals: Min 1Q Median 3Q Max -55.719-19.270 4.212 16.143 73.454 Coefficients: Estimate Std. Error t value Pr(> t ) (Intercept) 237.1326