[英]Multiple regression analysis in R using QR decomposition
我正在嘗試編寫一個使用QR分解來解決多元回歸的函數。 輸入:y向量和X矩陣; 輸出:b,e,R ^ 2。 到目前為止,我已經得到了這個並且非常困難; 我想我已經讓事情變得太復雜了:
QR.regression <- function(y, X) {
X <- as.matrix(X)
y <- as.vector(y)
p <- as.integer(ncol(X))
if (is.na(p)) stop("ncol(X) is invalid")
n <- as.integer(nrow(X))
if (is.na(n)) stop("nrow(X) is invalid")
nr <- length(y)
nc <- NCOL(X)
# Householder
for (j in seq_len(nc)) {
id <- seq.int(j, nr)
sigma <- sum(X[id, j]^2)
s <- sqrt(sigma)
diag_ej <- X[j, j]
gamma <- 1.0 / (sigma + abs(s * diag_ej))
kappa <- if (diag_ej < 0) s else -s
X[j,j] <- X[j, j] - kappa
if (j < nc)
for (k in seq.int(j+1, nc)) {
yPrime <- sum(X[id,j] * X[id,k]) * gamma
X[id,k] <- X[id,k] - X[id,j] * yPrime
}
yPrime <- sum(X[id,j] * y[id]) * gamma
y[id] <- y[id] - X[id,j] * yPrime
X[j,j] <- kappa
} # end of Householder transformation
rss <- sum(y[seq.int(nc+1, nr)]^2) # residuals sum of squares
e <- rss/nr
e <- mean(residuals(QR.regression)^2)
beta <- solve(t(X) %*% X, t(X) %*% y)
for (i in seq_len(ncol(X))) # set zeros in the lower triangular side of X
X[seq.int(i+1, nr),i] <- 0
Rsq <- (X[1:nc,1:nc])^2
return(list(Rsq=Rsq, y = y, beta = beta, e = e))
}
UPDATE:
my.QR <- function(y, X) {
X <- as.matrix(X)
y <- as.vector(y)
p <- as.integer(ncol(X))
if (is.na(p)) stop("ncol(X) is invalid")
n <- as.integer(nrow(X))
if (is.na(n)) stop("nrow(X) is invalid")
qr.X <- qr(X)
b <- solve(t(X) %*% X, t(X) %*% y)
e <- as.vector(y - X %*% beta) #e
R2 <- (X[1:p, 1:p])^2
return(list(b = b, e= e, R2 = R2 ))
}
X <- matrix(c(1,2,3,4,5,6), nrow = 2, ncol = 3)
y <- c(1,2,3,4)
my.QR(X, y)
這一切都取決於你可以用多少R的內置設施來解決這個問題。 我已經知道lm
是不被允許的,所以這是故事的其余部分。
如果允許您使用除lm
任何其他例程
然后你可以簡單地使用lm.fit
, .lm.fit
或lsfit
進行基於QR的普通最小二乘求解。
lm.fit(X, y)
.lm.fit(X, y)
lsfit(X, y, intercept = FALSE)
其中, .lm.fit
是最輕量級的,而lm.fit
和lsfit
非常相似。 以下是我們可以通過.lm.fit
做的.lm.fit
:
f1 <- function (X, y) {
z <- .lm.fit(X, y)
RSS <- crossprod(z$residuals)[1]
TSS <- crossprod(y - mean(y))[1]
R2 <- 1 - RSS / TSS
list(coefficients = z$coefficients, residuals = z$residuals, R2 = R2)
}
在你的同學的問題中: 玩具R函數通過奇異值分解求解普通最小二乘法 ,我已經用它來檢查SVD方法的正確性。
如果您不允許使用R的內置QR分解例程qr.default
如果.lm.fit
是不允許的,但qr.default
是,那么它也沒有那么復雜。
f2 <- function (X, y) {
## QR factorization `X = QR`
QR <- qr.default(X)
## After rotation of `X` and `y`, solve upper triangular system `Rb = Q'y`
b <- backsolve(QR$qr, qr.qty(QR, y))
## residuals
e <- as.numeric(y - X %*% b)
## R-squared
RSS <- crossprod(e)[1]
TSS <- crossprod(y - mean(y))[1]
R2 <- 1 - RSS / TSS
## multiple return
list(coefficients = b, residuals = e, R2 = R2)
}
如果您還需要估計系數的方差 - 協方差,請按照如何使用R中的QR分解計算最小二乘估計的方差? 。
如果您甚至不允許使用qr.default
然后我們必須自己編寫QR分解。 在R代碼中編寫Householder QR分解函數就是這樣。
在那里使用myqr
函數,我們可以寫
f3 <- function (X, y) {
## our own QR factorization
## complete Q factor is not required
QR <- myqr(X, complete = FALSE)
Q <- QR$Q
R <- QR$R
## rotation of `y`
Qty <- as.numeric(crossprod(Q, y))
## solving upper triangular system
b <- backsolve(R, Qty)
## residuals
e <- as.numeric(y - X %*% b)
## R-squared
RSS <- crossprod(e)[1]
TSS <- crossprod(y - mean(y))[1]
R2 <- 1 - RSS / TSS
## multiple return
list(coefficients = b, residuals = e, R2 = R2)
}
f3
並不是非常有效,因為我們明確地形成了Q
,即使它是薄Q
因子。 原則上,我們應該將y
隨着X
的QR因子分解而旋轉,因此不需要形成Q
如果要修復現有代碼
這需要一些調試工作,因此需要一些時間。 我稍后會就此作出另一個答案。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.