Entendendo a decomposição do QR

Eu tenho um exemplo trabalhado (em R), que estou tentando entender melhor. Estou usando o Limma para criar um modelo linear e estou tentando entender o que está acontecendo passo a passo nos cálculos de alteração de dobras. Estou principalmente tentando descobrir o que acontece para calcular os coeficientes. Pelo que pude descobrir, a decomposição QR é usada para obter os coeficientes, então estou procurando uma explicação ou uma maneira de ver passo a passo as equações que estão sendo calculadas ou o código-fonte para qr () em R para rastrear eu mesmo.

Usando os seguintes dados:

expression_data <- c(1.27135202935009, 1.41816160331787, 1.2572772420417, 1.70943398046296, 1.30290218641586, 0.632660015122616, 1.73084258791384, 0.863826352944684, 0.62481665344628, 0.356064235030147, 1.31542028558644, 0.30549909383238, 0.464963176430548, 0.132181421105667, -0.284799809563931, 0.216198538884642, -0.0841133304341238, -0.00184472290008803, -0.0924271878885008, -0.340291804468472, -0.236829711453303, 0.0529690806587626, 0.16321956624511, -0.310513510587778, -0.12970035111176, -0.126398635780533, 0.152550803185228, -0.458542514769473, 0.00243517688116406, -0.0190192219685527, 0.199329876859774, 0.0493831375210439, -0.30903829000185, -0.289604319193543, -0.110019942085281, -0.220289950537685, 0.0680403723818882, -0.210977291862137, 0.253649629045288, 0.0740109953273042, 0.115109148186167, 0.187043445057404, 0.705155251555554, 0.105479342752451, 0.344672919872447, 0.303316487542805, 0.332595721664644, 0.0512213943473417, 0.440756755046719, 0.091642538588249, 0.477236022595909, 0.109140019847968, 0.685001267317616, 0.183154080053337, 0.314190891668279, -0.123285017407119, 0.603094973500324, 1.53723917249845, 0.180518835745199, 1.5520102749957, -0.339656677699664, 0.888791974821514, 0.321402618155527, 1.31133008668306, 0.287587853884556, -0.513896569786498, 1.01400498573403, -0.145552182640197, -0.0466811491949621, 1.34418631328095, -0.188666887863983, 0.920227741574566, -0.0182196762358299, 1.18398082848213, 0.0680539755381465, 0.389472802053599, 1.14920099633956, 1.35363045061024, -0.0400907708395635, 1.14405154287124, 0.365672853509181, -0.0742688460368051, 1.60927415300638, -0.0312210890874907, -0.302097025523754, 0.214897201115632, 2.029775196118, 1.46210810601113, -0.126836819148653, -0.0799005522761045, 0.958505775644153, -0.209758749029421, 0.273568395649965, 0.488150388217536, -0.230312627718208, -0.0115780974342431, 0.351708198671371, 0.11803520077305, -0.201488605868396, 0.0814169684941098, 1.32266103732873, 1.9077004570343, 1.34748531668521, 1.37847539147601, 1.85761827653095, 1.11327229058024, 1.21377936983249, 1.167867701785, 1.3119314966728, 1.01502530573911, 1.22109375841952, 1.23026951795161, 1.30638557237133, 1.02569437924906, 0.812852833149196) 

treatment <- c('A', 'A', 'A', 'A', 'A', 'A', 'A', 'B', 'B', 'B', 'B', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'B', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'C', 'A', 'B', 'A', 'C', 'A', 'C', 'A', 'B', 'C', 'B', 'C', 'C', 'A', 'C', 'A', 'B', 'A', 'C', 'B', 'B', 'A', 'C', 'A', 'C', 'C', 'A', 'C', 'B', 'C', 'A', 'A', 'B', 'C', 'A', 'C', 'B', 'B', 'C', 'C', 'B', 'B', 'C', 'C', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A')

variation <- c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3)

... e o seguinte modelo de design

design               <- model.matrix(~0 + factor(treatment,
                                                 levels=unique(treatment)) +
                                          factor(variation))
colnames(design)     <- c(unique(treatment),
                          paste0("b",
                                 unique(variation)[-1]))
#expression_data consists of more than the data given. The data given is just one row from the object
fit                  <- lmFit((expression_data), design)

cont_mat             <- makeContrasts(B-A,
                                      levels=design)
fit2                 <- contrasts.fit(fit,
                                      contrasts=cont_mat)
fit2                 <- eBayes(fit2)

Dá-me uma dobra de -0,8709646.

A obtenção dos coeficientes pode ser feita através de:

qr.solve(design, expression_data)

Então é um caso simples de BA para obter a mudança de dobra.

Agora, o que me deixa perplexo é como qr.solverealmente funciona, ele chama a qrfunção, mas não consigo encontrar a fonte para isso.

Alguém tem uma boa explicação sobre a decomposição qr, ou uma maneira de rastrear exatamente o que está acontecendo para derivar os coeficientes?

Obrigado por qualquer ajuda!

r regression linear-model A_Skelton73
fonte

Veja en.wikipedia.org/wiki/… .

whuber

Aqui está a fonte: github.com/wch/r-source/blob/… Você está a um nível do fortran.

Matthew Drury

Minha resposta aqui também pode ser interessante para você: stats.stackexchange.com/questions/154485/…

Matthew Drury

A ideia da decomposição do QR como um procedimento para obter estimativas de OLS já está explicada no post vinculado por @MatthewDrury.

O código fonte da função qrestá escrito em Fortran e pode ser difícil de seguir. Aqui, mostro uma implementação mínima que reproduz os principais resultados para um modelo ajustado pelo OLS. Espero que os passos sejam mais fáceis de seguir.

Recapitular: O procedimento de QR é utilizado para decompor a matriz de variáveis regressoras em uma matriz ortonormal e uma matriz não singular triangular superior . Substituindo nas equações normais produz: $X$ $Q$ $R$ $X = QR$ $X'X\hat\beta = X'y$

R^{'} Q^{'} Q R \hat{β} = R^{'} Q^{'} y .

$R'Q'QR\hat\beta = R'Q'y \,.$

A pré- por e o fato de ser uma matriz diagonal fornece: $R^{-1}$ $Q'Q$

\begin{matrix} (1) & R \hat{β} = Q^{'} y . \end{matrix}

$R\hat\beta = Q'y \,. \tag 1$

O objetivo deste resultado é que, como é uma matriz triangular superior, essa equação é fácil de resolver para por substituições inversas. $R$ $\hat\beta$

Agora, como obtemos as matrizes e ? Podemos transformar a transformação doméstica, rotações de Givens ou o procedimento de Gram-Schmidt. $Q$ $R$

Abaixo, uso transformações de chefe de família. Veja detalhes por exemplo aqui . O código abaixo é baseado no código Pascal descrito no livro Pollock (1999), capítulos 7 e 8. A matriz de regressores é usada para armazenar a matriz da decomposição QR. A variável dependente é substituída pelos resultados de (lado direito da equação (1) acima). Observe também que na última etapa a soma residual dos quadrados pode ser obtida desse vetor. $R$ $Y$ $Q'y$

QR.regression <- function(y, X)
{
  nr <- length(y)
  nc <- NCOL(X)

  # Householder transformations
  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 Householder

  # residual sum of squares
  rss <- sum(y[seq.int(nc+1, nr)]^2)

  # Backsolve
  beta <- rep(NA, nc)
  for (j in seq.int(nc, 1))
  {
    beta[j] <- y[j]
    if (j < nc)
    for (i in seq.int(j+1, nc))
      beta[j] <- beta[j] - X[j,i] * beta[i]
    beta[j] <- beta[j] / X[j,j]
  }

  # set zeros in the lower triangular side of X (which stores) 
  # not really necessary, this is just to return R for illustration
  for (i in seq_len(ncol(X)))
    X[seq.int(i+1, nr),i] <- 0

  list(R=X[1:nc,1:nc], y=y, beta=beta, rss=rss)
}

Podemos verificar as mesmas estimativas que lmsão obtidas.

# benchmark results
fit <- lm(expression_data ~ 0+design)
# OLS by QR decomposition
y <- expression_data
X <- design
res <- QR.regression(y, X)
res$beta
# [1]  1.43235881  0.56139421  0.07744044 -0.15611038 -0.15021796    
all.equal(res$beta, coef(fit), check.attributes=FALSE)
# [1] TRUE
all.equal(res$rss, sum(residuals(fit)^2))
# [1] TRUE

Também podemos obter a matriz e verificar se ela é ortogonal: $Q$

Q <- X %*% solve(res$R)
round(crossprod(Q), 3)
#   1 2 3 4 5
# 1 1 0 0 0 0
# 2 0 1 0 0 0
# 3 0 0 1 0 0
# 4 0 0 0 1 0
# 5 0 0 0 0 1

Os resíduos podem ser obtidos como y - X %*% res$beta.

Referências

DSG Pollock (1999) Um manual de análise de séries temporais, processamento de sinais e dinâmica , Academic Press.

javlacalle
fonte

Um ponto menor - acredito que o código em seu segundo pedaço deve ter QR.regressioncomo a chamada de função e não QR.Householder. Fora isso, não posso agradecer o suficiente por uma explicação tão perspicaz.

A_Skelton73

Renomeei a função, mas esqueci de atualizar a chamada, obrigado! Fico feliz em ver que foi útil.

Javlacalle

Entendendo a decomposição do QR

Respostas: