簡體   English   中英

如何使用R中的QR分解計算最小二乘估計量的方差?

[英]How to calculate variance of least squares estimator using QR decomposition in R?

我正在嘗試學習 QR 分解,但無法弄清楚如何在不求助於傳統矩陣計算的情況下獲得 beta_hat 的方差。 我正在練習iris數據集,這是我目前所擁有的:

y<-(iris$Sepal.Length)
x<-(iris$Sepal.Width)
X<-cbind(1,x)
n<-nrow(X)
p<-ncol(X)
qr.X<-qr(X)
b<-(t(qr.Q(qr.X)) %*% y)[1:p]
R<-qr.R(qr.X)
beta<-as.vector(backsolve(R,b))
res<-as.vector(y-X %*% beta)

謝謝你的幫助!

設置(復制您的代碼)

y <- iris$Sepal.Length
x <- iris$Sepal.Width
X <- cbind(1,x)
n <- nrow(X)
p <- ncol(X)
qr.X <- qr(X)
b <- (t(qr.Q(qr.X)) %*% y)[1:p]  ## can be optimized; see Remark 1 below
R <- qr.R(qr.X)  ## can be optimized; see Remark 2 below
beta <- as.vector(backsolve(R, b))
res <- as.vector(y - X %*% beta)

數學

在此處輸入圖片說明

計算

剩余自由度為n - p ,因此估計方差為

se2 <- sum(res ^ 2) / (n - p)

因此,估計系數的方差協方差矩陣為

V <- chol2inv(R) * se2

#           [,1]         [,2]
#[1,]  0.22934170 -0.07352916
#[2,] -0.07352916  0.02405009

驗證

讓我們通過與lm比較來檢查正確性:

fit <- lm(Sepal.Length ~ Sepal.Width, iris)

vcov(fit)

#            (Intercept) Sepal.Width
#(Intercept)  0.22934170 -0.07352916
#Sepal.Width -0.07352916  0.02405009

結果一模一樣!


備注 1(跳過形成 'Q' 因子)

而不是b <- (t(qr.Q(qr.X)) %*% y)[1:p] ,您可以使用函數qr.qty (以避免形成 'Q' 矩陣):

b <- qr.qty(qr.X, y)[1:p]

備注 2(跳過形成 'R' 因子)

您不必為backsolve提取R <- qr.R(qr.X) 使用qr.X$qr就足夠了:

beta <- as.vector(backsolve(qr.X$qr, b))

附錄:估計函數

以上是最簡單的演示。 在實踐中,需要處理列旋轉和排名缺陷。 下面是一個實現。 X是模型矩陣, y是響應。 結果應與lm(y ~ X + 0)

qr_estimation <- function (X, y) {
  ## QR factorization
  QR <- qr(X)
  r <- QR$rank
  piv <- QR$pivot[1:r]
  ## estimate identifiable coefficients
  b <- qr.qty(QR, y)[1:r]
  beta <- backsolve(QR$qr, b, r)
  ## fitted values
  yhat <- base::c(X[, piv] %*% beta)
  ## residuals
  resi <- y - yhat
  ## error variance
  se2 <- base::c(crossprod(resi)) / (nrow(X) - r)
  ## variance-covariance for coefficients
  V <- chol2inv(QR$qr, r) * se2
  ## post-processing on pivoting and rank-deficiency
  p <- ncol(X)
  beta_full <- rep.int(NA_real_, p)
  beta_full[piv] <- beta
  V_full <- matrix(NA_real_, p, p)
  V_full[piv, piv] <- V
  ## return
  list(coefficients = beta_full, vcov = V_full,
       fitted.values = yhat, residuals = resi, sig = sqrt(se2))
  }

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM