주석 내용을 반복하면 다음과 같다.
glmnet
에standardize = TRUE
옵션(디폴트)을 주고 계산하는 ridge 추정값은 다음과 같이 구할 수 있다. ① x̃ij* = (xij−x̄j)/σ̂j로 표준화한다. 여기서 x̄j는 xij의 표본평균, σ̂j는 xij의 표본평균편차(표본분산 계산 시 n으로 나눔). 표본평균을 빼는 것은 절편을 처리하기 위함이며, σ̂j로 나누는 것은 변수 표준화. ② β̂* = (n−1X̃*′X̃*+λ*I)−1n−1X̃*′y를 구한다(X̃*는 x̃ij*의 행렬, λ* = λ/σ̂y). 이것은 ‘베타계수’ βjσ̂j들의 추정값 벡터이다. ③ 표준화를 되돌리기 위해 β̂j = β̂j*/σ̂j를 계산하면 이것이 최종적인 기울기 계수의 ridge 추정값. ④ 절편 추정값은 앞과 동일하게 α̂ = ȳ − β̂1x̄1 − ⋯ − β̂px̄p로 계산.
glmnet
에 의한 ridge 회귀다음 glmnet
에 의한 결과를 보라.
<- glmnet(X, Y, alpha = 0)
ridge <- ridge$lambda[50]) # an arbitrary choice
(lamb # [1] 3485.563
coef(ridge, s = lamb)
# 20 x 1 sparse Matrix of class "dgCMatrix"
# 1
# (Intercept) 1349.96474879
# grdp -1.46733791
# regpop -70.45896296
# popgrowth -2.60572536
# eq5d -2.24328091
# deaths -0.01593032
# drink -2.97176050
# hdrink 1.03296288
# smoke 1.90460780
# aged 2.90703405
# divorce -8.98595269
# medrate 0.43610941
# gcomp -0.90484486
# vehipc 97.75098402
# accpv -1.13114311
# dumppc -4.58445915
# stratio -3.16084850
# deathrate 0.07065207
# pctmale -3.94300918
# accpc 1.88459406
이 주어진 λ (lamb
)을 이용한 ridge 추정값을 행렬연산에 의하여 똑같이 구해 보는 것이 목적이다.
먼저, glmnet
에서 말하는 “표준편차”들은 n − 1이 아닌 n으로 나누어 구한다. 이를 위해 sd0
라는 함수를 만든다.
<- function(x) sqrt(mean((x-mean(x))^2))
sd0
## X, Y defined in data preparation page
<- sd0(Y)
sig.Y <- apply(X, 2, sd0) sig.X
<- lamb/sig.Y)
(lamb.star # [1] 10.35528
glmnet
에서 사용한 λ 값 3485.563
은 행렬 연산을 통한 수동 연산에서 10.35528
에 해당한다.
<- apply(X, 2, function(x) (x-mean(x))/sd0(x)) Xs
<- nrow(Xs)
n <- solve(1/n*crossprod(Xs) + lamb.star*diag(ncol(Xs)), 1/n*crossprod(Xs, Y)) bhat.star
<- bhat.star / sig.X)
(bhat # [,1]
# grdp -1.46731962
# regpop -70.45811386
# popgrowth -2.60571609
# eq5d -2.24326913
# deaths -0.01593022
# drink -2.97175109
# hdrink 1.03295937
# smoke 1.90460738
# aged 2.90703561
# divorce -8.98595524
# medrate 0.43611098
# gcomp -0.90484667
# vehipc 97.75111247
# accpv -1.13114176
# dumppc -4.58445394
# stratio -3.16085391
# deathrate 0.07065214
# pctmale -3.94300686
# accpc 1.88459496
이 결과는 앞에서 glmnet
으로 구한 결과와 동일함을 확인할 수 있다.
mean(Y) - sum(colMeans(X)*bhat)
# [1] 1349.963
주석에 다음과 같이 쓰여 있기도 하다.
참고로, 위 ①∼③의 β̂은 D = diag(σ̂12,…,σ̂p2)라 할 때 (n−1X̃′X̃+λ*D)−1n−1X̃′y으로 계산한 것과 동일하다.
이를 확인해 보자.
<- apply(X, 2, function(x) x - mean(x))
Xd solve(1/n*crossprod(Xd) + lamb.star*diag(sig.X^2), 1/n*crossprod(Xd,Y))
# [,1]
# grdp -1.46731962
# regpop -70.45811386
# popgrowth -2.60571609
# eq5d -2.24326913
# deaths -0.01593022
# drink -2.97175109
# hdrink 1.03295937
# smoke 1.90460738
# aged 2.90703561
# divorce -8.98595524
# medrate 0.43611098
# gcomp -0.90484667
# vehipc 97.75111247
# accpv -1.13114176
# dumppc -4.58445394
# stratio -3.16085391
# deathrate 0.07065214
# pctmale -3.94300686
# accpc 1.88459496
결과는 glmnet
과 동일하다.