# Base R (always available)
# - Matrix operations: %*%, t(), solve()
# - Basic functions: matrix(), diag(), det()
# MASS package for generalized inverse
library(MASS) # ginv()
# Matrix package for advanced operations
library(Matrix) # rankMatrix(), sparse matrices, cond()
# Set display options
options(digits = 4) # Display 4 decimal places16 Appendix B: Matrix Algebra Review
Appendix B: Matrix Algebra Review
16.1 Introduction
16.1.1 Purpose of This Appendix
This appendix serves as a comprehensive reference for matrix algebra concepts used throughout the 15-week linear models course. It is designed to complement Week 2: Linear Algebra Essentials by providing:
- Deeper coverage of fundamental concepts
- Complete property listings with proofs and examples
- Comprehensive R implementations for every operation
- Quick reference tables for identities and formulas
- Cross-references to specific course weeks where concepts are applied
NoteRelationship to Week 2
Week 2 introduces essential matrix algebra concepts needed to get started with linear models. This appendix provides the detailed reference material you’ll need as you progress through the course and encounter more advanced applications.
16.1.2 How to Use This Appendix
- As a quick reference: Look up specific properties, formulas, or R functions
- For deeper understanding: Read detailed explanations and work through examples
- To verify your work: Use the provided R code templates to check your calculations
- To connect concepts: Follow cross-references to see how matrix operations appear in different contexts
16.1.3 Organization
The appendix is organized into 13 main sections:
- Introduction (this section)
- Basic Matrix Operations - Addition, multiplication, transpose
- Special Types of Matrices - Identity, diagonal, symmetric, orthogonal, idempotent
- Matrix Properties - Rank, trace, determinant
- Matrix Inverses - Regular, generalized, identities
- Projection Matrices and Quadratic Forms - Critical for least squares theory
- Eigenvalues and Eigenvectors - Spectral decomposition, SVD
- Matrix Calculus - Derivatives, deriving normal equations
- Kronecker Products - For Animal models and multi-trait analysis
- Matrix Identities - Quick reference tables
- Computational Considerations - Stability, efficiency, verification
- Cross-Reference Table - Concept to week mapping
- R Code Templates - Ready-to-use functions
TipNavigation Tip
Use the table of contents sidebar to quickly jump to any section. Within sections, look for Cross-references boxes that link to relevant course weeks.
16.1.4 R Package Setup
Throughout this appendix, we’ll use the following R packages:
ImportantRequired Packages
Make sure to install these packages if you haven’t already:
install.packages("MASS")
install.packages("Matrix")16.2 Basic Matrix Operations
16.2.1 Matrix Addition and Scalar Multiplication
Definition:
For matrices A and B of the same dimensions (m × n), matrix addition is element-wise:
\[ (\mathbf{A} + \mathbf{B})_{ij} = a_{ij} + b_{ij} \tag{16.1}\]
Scalar multiplication multiplies every element by a constant c:
\[ (c\mathbf{A})_{ij} = c \cdot a_{ij} \tag{16.2}\]
Properties:
- Commutative: \(\mathbf{A} + \mathbf{B} = \mathbf{B} + \mathbf{A}\)
- Associative: \((\mathbf{A} + \mathbf{B}) + \mathbf{C} = \mathbf{A} + (\mathbf{B} + \mathbf{C})\)
- Distributive: \(c(\mathbf{A} + \mathbf{B}) = c\mathbf{A} + c\mathbf{B}\)
- Identity element: \(\mathbf{A} + \mathbf{0} = \mathbf{A}\) where 0 is the zero matrix
R Implementation:
# Define two 2x3 matrices
A <- matrix(c(1, 2, 3, 4, 5, 6), nrow = 2, ncol = 3, byrow = TRUE)
B <- matrix(c(2, 1, 0, 1, 2, 1), nrow = 2, ncol = 3, byrow = TRUE)
cat("Matrix A:\n")Matrix A:print(A) [,1] [,2] [,3]
[1,] 1 2 3
[2,] 4 5 6cat("\nMatrix B:\n")
Matrix B:print(B) [,1] [,2] [,3]
[1,] 2 1 0
[2,] 1 2 1# Addition
cat("\nA + B:\n")
A + B:print(A + B) [,1] [,2] [,3]
[1,] 3 3 3
[2,] 5 7 7# Scalar multiplication
c <- 3
cat("\n3A:\n")
3A:print(c * A) [,1] [,2] [,3]
[1,] 3 6 9
[2,] 12 15 18# Verify commutative property
cat("\nVerify A + B = B + A:\n")
Verify A + B = B + A:all.equal(A + B, B + A)[1] TRUELivestock Example:
Consider average daily gain (kg/day) for two groups of beef steers on different rations:
# Pen 1 ADG (3 steers)
pen1 <- matrix(c(1.2, 1.3, 1.1), nrow = 1)
# Pen 2 ADG (3 steers)
pen2 <- matrix(c(1.0, 1.1, 0.9), nrow = 1)
cat("Pen 1 ADG:\n")Pen 1 ADG:print(pen1) [,1] [,2] [,3]
[1,] 1.2 1.3 1.1cat("\nPen 2 ADG:\n")
Pen 2 ADG:print(pen2) [,1] [,2] [,3]
[1,] 1 1.1 0.9# Combined average
cat("\nAverage of both pens:\n")
Average of both pens:print((pen1 + pen2) / 2) [,1] [,2] [,3]
[1,] 1.1 1.2 1
NoteCross-Reference
Matrix addition is used throughout the course, starting in Week 1 for basic computations and appearing in every subsequent week.
16.2.2 Matrix Multiplication
Definition:
For matrix A of dimension (m × n) and matrix B of dimension (n × p), the product AB is an (m × p) matrix where:
\[ (\mathbf{AB})_{ij} = \sum_{k=1}^{n} a_{ik}b_{kj} \tag{16.3}\]
The element in row i, column j of AB is the dot product of row i of A with column j of B.
Critical Requirement: The number of columns in A must equal the number of rows in B.
Dimension Rule: \[ \underbrace{\mathbf{A}}_{m \times n} \times \underbrace{\mathbf{B}}_{n \times p} = \underbrace{\mathbf{AB}}_{m \times p} \tag{16.4}\]
Properties:
- Non-commutative: In general, \(\mathbf{AB} \neq \mathbf{BA}\) (even when both are defined)
- Associative: \((\mathbf{AB})\mathbf{C} = \mathbf{A}(\mathbf{BC})\)
- Distributive: \(\mathbf{A}(\mathbf{B} + \mathbf{C}) = \mathbf{AB} + \mathbf{AC}\)
- Scalar multiplication: \((c\mathbf{A})\mathbf{B} = c(\mathbf{AB}) = \mathbf{A}(c\mathbf{B})\)
- Identity: \(\mathbf{AI} = \mathbf{IA} = \mathbf{A}\) where I is identity matrix of appropriate dimension
R Implementation:
# Example 1: Basic multiplication
A <- matrix(c(1, 2, 3, 4, 5, 6), nrow = 2, ncol = 3, byrow = TRUE)
B <- matrix(c(1, 0, 2, 1, 0, 1), nrow = 3, ncol = 2, byrow = TRUE)
cat("Matrix A (2×3):\n")Matrix A (2×3):print(A) [,1] [,2] [,3]
[1,] 1 2 3
[2,] 4 5 6cat("\nMatrix B (3×2):\n")
Matrix B (3×2):print(B) [,1] [,2]
[1,] 1 0
[2,] 2 1
[3,] 0 1cat("\nA %*% B (2×2):\n")
A %*% B (2×2):AB <- A %*% B # %*% is matrix multiplication in R
print(AB) [,1] [,2]
[1,] 5 5
[2,] 14 11# Manual calculation of element (1,1)
cat("\nManual calculation of (AB)[1,1]:\n")
Manual calculation of (AB)[1,1]:cat("= A[1,1]*B[1,1] + A[1,2]*B[2,1] + A[1,3]*B[3,1]\n")= A[1,1]*B[1,1] + A[1,2]*B[2,1] + A[1,3]*B[3,1]cat(sprintf("= %d*%d + %d*%d + %d*%d = %d\n",
A[1,1], B[1,1], A[1,2], B[2,1], A[1,3], B[3,1],
A[1,1]*B[1,1] + A[1,2]*B[2,1] + A[1,3]*B[3,1]))= 1*1 + 2*2 + 3*0 = 5# Verify non-commutativity
BA <- B %*% A # Different result!
cat("B %*% A (3×3):\n")B %*% A (3×3):print(BA) [,1] [,2] [,3]
[1,] 1 2 3
[2,] 6 9 12
[3,] 4 5 6cat("\nNote: A %*% B is 2×2, but B %*% A is 3×3")
Note: A %*% B is 2×2, but B %*% A is 3×3cat("\nMatrix multiplication is NOT commutative!\n")
Matrix multiplication is NOT commutative!Livestock Example - Normal Equations:
The most important matrix multiplication in linear models is forming the normal equations X’Xb = X’y.
# Simple regression: milk yield (y) vs days in milk (x)
# n = 4 dairy cows
days <- c(30, 60, 90, 120)
yield <- c(35, 32, 28, 25) # kg/day
# Design matrix (n×2): intercept and days
X <- cbind(1, days)
y <- matrix(yield, ncol = 1)
cat("Design matrix X (4×2):\n")Design matrix X (4×2):print(X) days
[1,] 1 30
[2,] 1 60
[3,] 1 90
[4,] 1 120cat("\nResponse vector y (4×1):\n")
Response vector y (4×1):print(y) [,1]
[1,] 35
[2,] 32
[3,] 28
[4,] 25# Form X'X (the "information matrix")
XtX <- t(X) %*% X
cat("\nX'X (2×2):\n")
X'X (2×2):print(XtX) days
4 300
days 300 27000# Form X'y (the "right-hand side")
Xty <- t(X) %*% y
cat("\nX'y (2×1):\n")
X'y (2×1):print(Xty) [,1]
120
days 8490# Solve for regression coefficients
b <- solve(XtX) %*% Xty
cat("\nRegression coefficients b = (X'X)^(-1)X'y:\n")
Regression coefficients b = (X'X)^(-1)X'y:print(b) [,1]
38.5000
days -0.1133cat(sprintf("\nInterpretation: Intercept = %.2f kg/day, Slope = %.4f kg/day per day\n",
b[1], b[2]))
Interpretation: Intercept = 38.50 kg/day, Slope = -0.1133 kg/day per dayImportant Special Cases:
Quadratic forms: \(\mathbf{x}'\mathbf{Ax}\) (scalar result)
- Example: Sum of squares = \(\mathbf{e}'\mathbf{e}\) where e is residual vector
Outer product: For vectors u (n×1) and v (m×1), \(\mathbf{uv}'\) is n×m matrix
Inner product: For vectors u and v (both n×1), \(\mathbf{u}'\mathbf{v}\) is scalar
# Quadratic form: sum of squares
e <- c(-1.2, 0.5, 0.8, -0.1) # Residuals
SSE <- t(e) %*% e # Same as sum(e^2)
cat("Sum of squared errors (e'e):\n")Sum of squared errors (e'e):print(SSE) [,1]
[1,] 2.34cat(sprintf("Verification: sum(e^2) = %.4f\n", sum(e^2)))Verification: sum(e^2) = 2.3400# Outer product
u <- matrix(c(1, 2, 3), ncol = 1)
v <- matrix(c(4, 5), ncol = 1)
outer_prod <- u %*% t(v)
cat("\nOuter product u v' (3×2):\n")
Outer product u v' (3×2):print(outer_prod) [,1] [,2]
[1,] 4 5
[2,] 8 10
[3,] 12 15# Inner product (dot product)
w <- c(1, 2, 3)
z <- c(4, 5, 6)
inner_prod <- t(w) %*% z # Or: sum(w * z)
cat("\nInner product w'z (scalar):\n")
Inner product w'z (scalar):print(inner_prod) [,1]
[1,] 32Livestock Example - Multi-Trait Analysis:
# Swine: 3 pigs, 2 traits (backfat mm, loin depth mm)
# Raw data matrix
Y <- matrix(c(12, 15, 10, # Backfat for pigs 1, 2, 3
65, 70, 68), # Loin depth for pigs 1, 2, 3
nrow = 3, ncol = 2)
colnames(Y) <- c("Backfat", "LoinDepth")
cat("Multi-trait data Y (3 pigs × 2 traits):\n")Multi-trait data Y (3 pigs × 2 traits):print(Y) Backfat LoinDepth
[1,] 12 65
[2,] 15 70
[3,] 10 68# Compute trait covariance matrix: (Y'Y) / (n-1)
# This involves matrix multiplication
YtY <- t(Y) %*% Y
cat("\nY'Y (sums of squares and cross-products):\n")
Y'Y (sums of squares and cross-products):print(YtY) Backfat LoinDepth
Backfat 469 2510
LoinDepth 2510 13749cov_matrix <- YtY / (nrow(Y) - 1)
cat("\nCovariance matrix (2×2):\n")
Covariance matrix (2×2):print(cov_matrix) Backfat LoinDepth
Backfat 234.5 1255
LoinDepth 1255.0 6874cat(sprintf("\nInterpretation:\n"))
Interpretation:cat(sprintf(" Var(Backfat) = %.2f\n", cov_matrix[1,1])) Var(Backfat) = 234.50cat(sprintf(" Var(LoinDepth) = %.2f\n", cov_matrix[2,2])) Var(LoinDepth) = 6874.50cat(sprintf(" Cov(Backfat, LoinDepth) = %.2f\n", cov_matrix[1,2])) Cov(Backfat, LoinDepth) = 1255.00
WarningCommon Mistakes with Matrix Multiplication
- Wrong operator: Use
%*%for matrix multiplication, not*(which is element-wise) - Dimension mismatch: Check that ncol(A) == nrow(B) before computing A %*% B
- Order matters: AB ≠ BA in general
- Vectors: R treats vectors flexibly; be explicit with
matrix()or transposet()to avoid confusion
NoteCross-References
Matrix multiplication appears constantly in linear models:
- Week 3: Building design matrix X and forming X’X
- Week 4-6: Normal equations X’Xb = X’y
- Week 5: Hat matrix H = X(X’X)^(-1)X’ involves three matrix multiplications
- Week 11: Computing fitted values ŷ = Xb and residuals e = y - Xb
16.2.3 Matrix Transpose
Definition:
The transpose of a matrix A (denoted A’ or AT) is obtained by interchanging rows and columns:
\[ (\mathbf{A}')_{ij} = (\mathbf{A})_{ji} \tag{16.5}\]
If A is m × n, then A’ is n × m.
Properties:
- Double transpose: \((\mathbf{A}')' = \mathbf{A}\)
- Sum transpose: \((\mathbf{A} + \mathbf{B})' = \mathbf{A}' + \mathbf{B}'\)
- Product transpose: \((\mathbf{AB})' = \mathbf{B}'\mathbf{A}'\) (reverse order!)
- Scalar multiply: \((c\mathbf{A})' = c\mathbf{A}'\)
- Inverse transpose: \((\mathbf{A}^{-1})' = (\mathbf{A}')^{-1}\) (for invertible matrices)
Critical Property for Linear Models:
The transpose of a product reverses the order: \((\mathbf{ABC})' = \mathbf{C}'\mathbf{B}'\mathbf{A}'\)
This is essential when manipulating expressions like \((\mathbf{X}'\mathbf{X})^{-1}\) or \((\mathbf{y} - \mathbf{Xb})'(\mathbf{y} - \mathbf{Xb})\).
R Implementation:
# Create a 3x2 matrix
A <- matrix(c(1, 2, 3, 4, 5, 6), nrow = 3, ncol = 2, byrow = TRUE)
cat("Matrix A (3×2):\n")Matrix A (3×2):print(A) [,1] [,2]
[1,] 1 2
[2,] 3 4
[3,] 5 6cat("\nTranspose A' (2×3):\n")
Transpose A' (2×3):At <- t(A)
print(At) [,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6# Verify double transpose
cat("\nVerify (A')' = A:\n")
Verify (A')' = A:all.equal(t(At), A)[1] TRUE# Product transpose rule
B <- matrix(c(1, 0, 2, 1), nrow = 2, ncol = 2, byrow = TRUE)
cat("\nMatrix B (2×2):\n")
Matrix B (2×2):print(B) [,1] [,2]
[1,] 1 0
[2,] 2 1AB <- A %*% B
cat("\nA %*% B (3×2):\n")
A %*% B (3×2):print(AB) [,1] [,2]
[1,] 5 2
[2,] 11 4
[3,] 17 6cat("\n(AB)':\n")
(AB)':print(t(AB)) [,1] [,2] [,3]
[1,] 5 11 17
[2,] 2 4 6cat("\nB' %*% A' (should equal (AB)'):\n")
B' %*% A' (should equal (AB)'):print(t(B) %*% t(A)) [,1] [,2] [,3]
[1,] 5 11 17
[2,] 2 4 6cat("\nVerify (AB)' = B'A':\n")
Verify (AB)' = B'A':all.equal(t(AB), t(B) %*% t(A))[1] TRUELivestock Example - Normal Equations:
The normal equations X’Xb = X’y rely fundamentally on the transpose operation.
# Beef cattle: ADG (kg/day) for 5 steers
adg <- c(1.2, 1.4, 1.1, 1.3, 1.5)
y <- matrix(adg, ncol = 1) # Column vector (5×1)
cat("Response vector y (5×1):\n")Response vector y (5×1):print(y) [,1]
[1,] 1.2
[2,] 1.4
[3,] 1.1
[4,] 1.3
[5,] 1.5cat("\nTranspose y' (1×5):\n")
Transpose y' (1×5):print(t(y)) [,1] [,2] [,3] [,4] [,5]
[1,] 1.2 1.4 1.1 1.3 1.5# Simple model: y = μ + e (estimate the mean)
X <- matrix(1, nrow = 5, ncol = 1) # Column of ones
cat("\nDesign matrix X (5×1):\n")
Design matrix X (5×1):print(X) [,1]
[1,] 1
[2,] 1
[3,] 1
[4,] 1
[5,] 1# Form X'X
XtX <- t(X) %*% X
cat("\nX'X (1×1 scalar):\n")
X'X (1×1 scalar):print(XtX) [,1]
[1,] 5cat(sprintf("Interpretation: X'X = %d (the sample size)\n", XtX[1,1]))Interpretation: X'X = 5 (the sample size)# Form X'y
Xty <- t(X) %*% y
cat("\nX'y (1×1 scalar):\n")
X'y (1×1 scalar):print(Xty) [,1]
[1,] 6.5cat(sprintf("Interpretation: X'y = %.1f (the sum of observations)\n", Xty[1,1]))Interpretation: X'y = 6.5 (the sum of observations)# Solve: b = (X'X)^(-1) X'y = sum(y) / n
b <- solve(XtX) %*% Xty
cat(sprintf("\nEstimated mean: %.3f kg/day\n", b[1,1]))
Estimated mean: 1.300 kg/daycat(sprintf("Verification: mean(y) = %.3f\n", mean(adg)))Verification: mean(y) = 1.300Symmetric Matrices:
A matrix is symmetric if A = A’. This property is crucial in linear models.
# X'X is always symmetric
X <- matrix(c(1, 1, 1, 1,
2, 3, 1, 4), nrow = 4, ncol = 2)
cat("Design matrix X (4×2):\n")Design matrix X (4×2):print(X) [,1] [,2]
[1,] 1 2
[2,] 1 3
[3,] 1 1
[4,] 1 4XtX <- t(X) %*% X
cat("\nX'X (2×2):\n")
X'X (2×2):print(XtX) [,1] [,2]
[1,] 4 10
[2,] 10 30cat("\n(X'X)' (transpose of X'X):\n")
(X'X)' (transpose of X'X):print(t(XtX)) [,1] [,2]
[1,] 4 10
[2,] 10 30cat("\nVerify X'X is symmetric:\n")
Verify X'X is symmetric:all.equal(XtX, t(XtX))[1] TRUE# Why is X'X always symmetric? Proof:
# (X'X)' = X'(X')' = X'X ✓Livestock Example - Sum of Squares:
The sum of squared errors SSE = e’e uses transpose to convert a column vector to a scalar.
# Residuals from a regression
e <- matrix(c(-0.5, 0.8, -0.3, 0.2, -0.2), ncol = 1)
cat("Residual vector e (5×1):\n")Residual vector e (5×1):print(e) [,1]
[1,] -0.5
[2,] 0.8
[3,] -0.3
[4,] 0.2
[5,] -0.2cat("\nTranspose e' (1×5):\n")
Transpose e' (1×5):print(t(e)) [,1] [,2] [,3] [,4] [,5]
[1,] -0.5 0.8 -0.3 0.2 -0.2# Sum of squared errors
SSE <- t(e) %*% e # (1×5) %*% (5×1) = (1×1) scalar
cat("\nSSE = e'e:\n")
SSE = e'e:print(SSE) [,1]
[1,] 1.06cat(sprintf("\nInterpretation: SSE = %.4f\n", SSE[1,1]))
Interpretation: SSE = 1.0600cat(sprintf("Verification: sum(e^2) = %.4f\n", sum(e^2)))Verification: sum(e^2) = 1.0600# Equivalent computations
cat("\nThree ways to compute SSE:\n")
Three ways to compute SSE:cat(sprintf("1. t(e) %%*%% e = %.4f\n", (t(e) %*% e)[1,1]))1. t(e) %*% e = 1.0600cat(sprintf("2. sum(e^2) = %.4f\n", sum(e^2)))2. sum(e^2) = 1.0600cat(sprintf("3. crossprod(e) = %.4f\n", crossprod(e)[1,1])) # More efficient3. crossprod(e) = 1.0600Useful R Functions:
t(A): Transpose of matrix Acrossprod(X, y): Computes X’y efficiently (more efficient thant(X) %*% y)crossprod(X): Computes X’X efficiently (more efficient thant(X) %*% X)tcrossprod(X, Y): Computes XY’ efficiently
# Efficiency comparison for large matrices
X <- matrix(rnorm(1000), nrow = 100, ncol = 10)
# Standard way
system.time({
XtX_standard <- t(X) %*% X
}) user system elapsed
0 0 0 # Efficient way
system.time({
XtX_efficient <- crossprod(X)
}) user system elapsed
0 0 0 cat("Results are identical:\n")Results are identical:all.equal(XtX_standard, XtX_efficient)[1] TRUEcat("\nFor normal equations, always use:\n")
For normal equations, always use:cat(" XtX <- crossprod(X) # Instead of t(X) %*% X\n") XtX <- crossprod(X) # Instead of t(X) %*% Xcat(" Xty <- crossprod(X, y) # Instead of t(X) %*% y\n") Xty <- crossprod(X, y) # Instead of t(X) %*% y
ImportantCritical for Linear Models
The transpose appears in virtually every linear model calculation:
- Normal equations: X’Xb = X’y
- Sum of squares: SSE = (y - Xb)’(y - Xb) = e’e
- Variance of estimates: Var(b) = (X’X)^(-1)σ²
- Hat matrix: H = X(X’X)^(-1)X’
Always remember: \((\mathbf{AB})' = \mathbf{B}'\mathbf{A}'\) (reverse the order!)
NoteCross-References
The transpose operation is used in:
- Week 1-2: Basic matrix operations
- Week 3: Forming X’X from design matrix
- Week 4-6: All regression calculations
- Week 5: Deriving least squares via \(\partial(\mathbf{e}'\mathbf{e})/\partial\mathbf{β}\)
- Week 8: Testing contrasts \(\mathbf{c}'\mathbf{b}\)
- Week 11: Computing residuals and diagnostics
16.3 Special Types of Matrices
16.3.1 Identity Matrix
Definition:
The identity matrix In is an n × n square matrix with 1’s on the main diagonal and 0’s elsewhere:
\[ \mathbf{I}_n = \begin{bmatrix} 1 & 0 & 0 & \cdots & 0 \\ 0 & 1 & 0 & \cdots & 0 \\ 0 & 0 & 1 & \cdots & 0 \\ \vdots & \vdots & \vdots & \ddots & \vdots \\ 0 & 0 & 0 & \cdots & 1 \end{bmatrix} \tag{16.6}\]
Equivalently: \((\mathbf{I})_{ij} = \begin{cases} 1 & \text{if } i = j \\ 0 & \text{if } i \neq j \end{cases}\)
Key Properties:
- Multiplicative identity: \(\mathbf{AI} = \mathbf{IA} = \mathbf{A}\) for any matrix A of compatible dimension
- Inverse of itself: \(\mathbf{I}^{-1} = \mathbf{I}\)
- Idempotent: \(\mathbf{I}^2 = \mathbf{I}\)
- Symmetric: \(\mathbf{I}' = \mathbf{I}\)
- Trace: \(\text{tr}(\mathbf{I}_n) = n\)
- Determinant: \(\det(\mathbf{I}_n) = 1\)
- Rank: \(r(\mathbf{I}_n) = n\) (full rank)
R Implementation:
# Create identity matrices of various sizes
I2 <- diag(2)
I3 <- diag(3)
I5 <- diag(5)
cat("I_2 (2×2 identity):\n")I_2 (2×2 identity):print(I2) [,1] [,2]
[1,] 1 0
[2,] 0 1cat("\nI_3 (3×3 identity):\n")
I_3 (3×3 identity):print(I3) [,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 1 0
[3,] 0 0 1# Verify multiplicative identity property
A <- matrix(c(1, 2, 3, 4, 5, 6), nrow = 2, ncol = 3)
cat("\nMatrix A (2×3):\n")
Matrix A (2×3):print(A) [,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6cat("\nI_2 %*% A (should equal A):\n")
I_2 %*% A (should equal A):print(I2 %*% A) [,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6cat("\nA %*% I_3 (should equal A):\n")
A %*% I_3 (should equal A):print(A %*% I3) [,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6cat("\nVerify IA = A:\n")
Verify IA = A:all.equal(I2 %*% A, A)[1] TRUEcat("\nVerify AI = A:\n")
Verify AI = A:all.equal(A %*% I3, A)[1] TRUERole in Linear Models:
The identity matrix appears frequently in variance-covariance structures and residual matrices.
1. Homoscedastic, Independent Errors:
The assumption \(\text{Var}(\mathbf{e}) = \sigma^2\mathbf{I}_n\) means: - All errors have the same variance \(\sigma^2\) (homoscedasticity) - Errors are uncorrelated (independence)
# Example: n = 4 observations
n <- 4
sigma_sq <- 2.5
# Variance-covariance matrix of errors
Var_e <- sigma_sq * diag(n)
cat("Var(e) = σ²I where σ² = 2.5:\n")Var(e) = σ²I where σ² = 2.5:print(Var_e) [,1] [,2] [,3] [,4]
[1,] 2.5 0.0 0.0 0.0
[2,] 0.0 2.5 0.0 0.0
[3,] 0.0 0.0 2.5 0.0
[4,] 0.0 0.0 0.0 2.5cat("\nInterpretation:\n")
Interpretation:cat(" - Diagonal elements = 2.5 (common variance)\n") - Diagonal elements = 2.5 (common variance)cat(" - Off-diagonal elements = 0 (no correlation)\n") - Off-diagonal elements = 0 (no correlation)2. Residual Projection:
The matrix \(\mathbf{I} - \mathbf{H}\) projects observations onto the residual space (see Section 16.6.1).
# Simple example with n=3
X <- cbind(1, c(1, 2, 3)) # Intercept and slope
n <- nrow(X)
# Hat matrix
H <- X %*% solve(t(X) %*% X) %*% t(X)
cat("Hat matrix H (3×3):\n")Hat matrix H (3×3):print(H) [,1] [,2] [,3]
[1,] 0.8333 0.3333 -0.1667
[2,] 0.3333 0.3333 0.3333
[3,] -0.1667 0.3333 0.8333# Residual projection matrix
I_minus_H <- diag(n) - H
cat("\nI - H (3×3):\n")
I - H (3×3):print(I_minus_H) [,1] [,2] [,3]
[1,] 0.1667 -0.3333 0.1667
[2,] -0.3333 0.6667 -0.3333
[3,] 0.1667 -0.3333 0.1667# Verify idempotence
cat("\nVerify (I-H)² = I-H:\n")
Verify (I-H)² = I-H:all.equal((I_minus_H) %*% (I_minus_H), I_minus_H)[1] TRUELivestock Example - Weighted Least Squares:
When observations have different precisions, we use \(\mathbf{W} = \text{diag}(w_1, ..., w_n)\) instead of \(\mathbf{I}\).
# Pen-average ADG with different pen sizes
pen_avg <- c(1.2, 1.3, 1.1, 1.4) # kg/day
pen_size <- c(10, 15, 8, 12) # Number of pigs per pen
# Weights proportional to pen size (more pigs = more precise)
weights <- pen_size / mean(pen_size) # Standardized weights
cat("Pen averages and sizes:\n")Pen averages and sizes:print(data.frame(ADG = pen_avg, PenSize = pen_size, Weight = weights)) ADG PenSize Weight
1 1.2 10 0.8889
2 1.3 15 1.3333
3 1.1 8 0.7111
4 1.4 12 1.0667# Weight matrix (diagonal)
W <- diag(weights)
cat("\nWeight matrix W (4×4):\n")
Weight matrix W (4×4):print(W) [,1] [,2] [,3] [,4]
[1,] 0.8889 0.000 0.0000 0.000
[2,] 0.0000 1.333 0.0000 0.000
[3,] 0.0000 0.000 0.7111 0.000
[4,] 0.0000 0.000 0.0000 1.067# Weighted mean: (1'W1)^(-1) 1'Wy
ones <- matrix(1, nrow = 4, ncol = 1)
y <- matrix(pen_avg, ncol = 1)
weighted_mean <- solve(t(ones) %*% W %*% ones) %*% t(ones) %*% W %*% y
cat(sprintf("\nWeighted mean ADG: %.3f kg/day\n", weighted_mean[1,1]))
Weighted mean ADG: 1.269 kg/day# Compare with unweighted mean
cat(sprintf("Unweighted mean ADG: %.3f kg/day\n", mean(pen_avg)))Unweighted mean ADG: 1.250 kg/day
NoteCreating Identity Matrices in R
Three equivalent ways:
I <- diag(n) # Most common
I <- diag(1, n) # Explicit
I <- diag(rep(1, n)) # Using rep()
NoteCross-References
Identity matrix appears in:
- Week 5: Variance assumption \(\text{Var}(\mathbf{e}) = \sigma^2\mathbf{I}\)
- Week 6: Residual projection matrix \(\mathbf{I} - \mathbf{H}\)
- Week 10: Weighted least squares with \(\mathbf{W}\) replacing \(\mathbf{I}\)
- Week 14: Generalizations to non-identity covariance structures
16.3.2 Diagonal Matrices
Definition:
A diagonal matrix D is a square matrix with non-zero elements only on the main diagonal:
\[ \mathbf{D} = \begin{bmatrix} d_1 & 0 & 0 & \cdots & 0 \\ 0 & d_2 & 0 & \cdots & 0 \\ 0 & 0 & d_3 & \cdots & 0 \\ \vdots & \vdots & \vdots & \ddots & \vdots \\ 0 & 0 & 0 & \cdots & d_n \end{bmatrix} \tag{16.7}\]
Notation: \(\mathbf{D} = \text{diag}(d_1, d_2, ..., d_n)\)
Equivalently: \((\mathbf{D})_{ij} = \begin{cases} d_i & \text{if } i = j \\ 0 & \text{if } i \neq j \end{cases}\)
Key Properties:
- Multiplication is commutative: \(\mathbf{D}_1\mathbf{D}_2 = \mathbf{D}_2\mathbf{D}_1\) (rare for matrices!)
- Simple inverse: \(\mathbf{D}^{-1} = \text{diag}(1/d_1, 1/d_2, ..., 1/d_n)\) if all \(d_i \neq 0\)
- Determinant: \(\det(\mathbf{D}) = \prod_{i=1}^{n} d_i\) (product of diagonal elements)
- Trace: \(\text{tr}(\mathbf{D}) = \sum_{i=1}^{n} d_i\) (sum of diagonal elements)
- Rank: \(r(\mathbf{D})\) = number of non-zero \(d_i\)
- Powers: \(\mathbf{D}^k = \text{diag}(d_1^k, d_2^k, ..., d_n^k)\)
- Symmetric: \(\mathbf{D}' = \mathbf{D}\)
R Implementation:
# Create diagonal matrices
D1 <- diag(c(2, 3, 5))
D2 <- diag(c(1, 4, 2))
cat("D1:\n")D1:print(D1) [,1] [,2] [,3]
[1,] 2 0 0
[2,] 0 3 0
[3,] 0 0 5cat("\nD2:\n")
D2:print(D2) [,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 4 0
[3,] 0 0 2# Multiplication is commutative
cat("\nD1 %*% D2:\n")
D1 %*% D2:print(D1 %*% D2) [,1] [,2] [,3]
[1,] 2 0 0
[2,] 0 12 0
[3,] 0 0 10cat("\nD2 %*% D1:\n")
D2 %*% D1:print(D2 %*% D1) [,1] [,2] [,3]
[1,] 2 0 0
[2,] 0 12 0
[3,] 0 0 10cat("\nVerify D1*D2 = D2*D1:\n")
Verify D1*D2 = D2*D1:all.equal(D1 %*% D2, D2 %*% D1)[1] TRUE# Inverse
D1_inv <- solve(D1)
cat("\nD1^(-1):\n")
D1^(-1):print(D1_inv) [,1] [,2] [,3]
[1,] 0.5 0.0000 0.0
[2,] 0.0 0.3333 0.0
[3,] 0.0 0.0000 0.2cat("\nManual inverse: diag(1/2, 1/3, 1/5):\n")
Manual inverse: diag(1/2, 1/3, 1/5):print(diag(1/c(2, 3, 5))) [,1] [,2] [,3]
[1,] 0.5 0.0000 0.0
[2,] 0.0 0.3333 0.0
[3,] 0.0 0.0000 0.2# Verify inverse
cat("\nVerify D1 * D1^(-1) = I:\n")
Verify D1 * D1^(-1) = I:print(D1 %*% D1_inv) [,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 1 0
[3,] 0 0 1Scaling Rows and Columns:
Diagonal matrices are useful for scaling. Pre-multiplying scales rows; post-multiplying scales columns.
# Example matrix
A <- matrix(c(1, 2, 3, 4, 5, 6, 7, 8, 9), nrow = 3, ncol = 3)
cat("Matrix A (3×3):\n")Matrix A (3×3):print(A) [,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
[3,] 3 6 9# Scale rows by diag(2, 3, 4)
D_row <- diag(c(2, 3, 4))
DA <- D_row %*% A
cat("\nD %*% A (scales rows):\n")
D %*% A (scales rows):print(DA) [,1] [,2] [,3]
[1,] 2 8 14
[2,] 6 15 24
[3,] 12 24 36cat("Row 1 scaled by 2, Row 2 by 3, Row 3 by 4\n")Row 1 scaled by 2, Row 2 by 3, Row 3 by 4# Scale columns by diag(10, 20, 30)
D_col <- diag(c(10, 20, 30))
AD <- A %*% D_col
cat("\nA %*% D (scales columns):\n")
A %*% D (scales columns):print(AD) [,1] [,2] [,3]
[1,] 10 80 210
[2,] 20 100 240
[3,] 30 120 270cat("Column 1 scaled by 10, Column 2 by 20, Column 3 by 30\n")Column 1 scaled by 10, Column 2 by 20, Column 3 by 30Livestock Example - Weighted Least Squares:
In weighted regression, observations with different variances get different weights.
# Swine ADG data with heterogeneous variances
# 4 treatment groups with different precisions
adg <- c(0.85, 0.90, 0.88, 0.92)
n_pigs <- c(20, 30, 15, 25) # Group sizes
# Variance inversely proportional to group size
# Var(mean) = σ²/n, so weight = n/σ²
weights <- n_pigs / mean(n_pigs) # Standardized
cat("Treatment data:\n")Treatment data:print(data.frame(Treatment = 1:4, ADG = adg, n = n_pigs, Weight = round(weights, 2))) Treatment ADG n Weight
1 1 0.85 20 0.89
2 2 0.90 30 1.33
3 3 0.88 15 0.67
4 4 0.92 25 1.11# Weight matrix
W <- diag(weights)
cat("\nWeight matrix W (4×4):\n")
Weight matrix W (4×4):print(round(W, 2)) [,1] [,2] [,3] [,4]
[1,] 0.89 0.00 0.00 0.00
[2,] 0.00 1.33 0.00 0.00
[3,] 0.00 0.00 0.67 0.00
[4,] 0.00 0.00 0.00 1.11# Weighted least squares: (X'WX)^(-1) X'Wy
X <- matrix(1, nrow = 4, ncol = 1) # Just intercept (estimate overall mean)
y <- matrix(adg, ncol = 1)
# Normal equations with weights
XtWX <- t(X) %*% W %*% X
XtWy <- t(X) %*% W %*% y
b_weighted <- solve(XtWX) %*% XtWy
b_unweighted <- mean(adg)
cat(sprintf("\nWeighted mean: %.4f kg/day\n", b_weighted[1,1]))
Weighted mean: 0.8911 kg/daycat(sprintf("Unweighted mean: %.4f kg/day\n", b_unweighted))Unweighted mean: 0.8875 kg/daycat("\nWeighted mean gives more influence to groups with larger n\n")
Weighted mean gives more influence to groups with larger nLivestock Example - Variance Components:
Diagonal matrices represent variances when effects are independent.
# Genetic evaluation: 3 sires, assume independent
# Sire breeding values have different reliabilities
reliability <- c(0.90, 0.75, 0.85)
genetic_variance <- 10 # Additive genetic variance
# Variance of estimated breeding value = (1-r²) * σ²_a
var_ebv <- (1 - reliability^2) * genetic_variance
cat("Sire reliabilities and EBV variances:\n")Sire reliabilities and EBV variances:print(data.frame(Sire = 1:3, Reliability = reliability,
Var_EBV = round(var_ebv, 2))) Sire Reliability Var_EBV
1 1 0.90 1.90
2 2 0.75 4.38
3 3 0.85 2.78# Variance-covariance matrix (diagonal because sires are independent)
V <- diag(var_ebv)
cat("\nVariance-covariance matrix V (3×3):\n")
Variance-covariance matrix V (3×3):print(round(V, 2)) [,1] [,2] [,3]
[1,] 1.9 0.00 0.00
[2,] 0.0 4.38 0.00
[3,] 0.0 0.00 2.78cat("\nInterpretation:\n")
Interpretation:cat(" - Diagonal: variances of each sire's EBV\n") - Diagonal: variances of each sire's EBVcat(" - Off-diagonal zeros: sires are unrelated (independent)\n") - Off-diagonal zeros: sires are unrelated (independent)Extracting and Creating Diagonals:
# Extract diagonal from matrix
A <- matrix(c(1, 2, 3, 4, 5, 6, 7, 8, 9), nrow = 3)
cat("Matrix A:\n")Matrix A:print(A) [,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
[3,] 3 6 9diag_A <- diag(A)
cat("\nDiagonal of A:\n")
Diagonal of A:print(diag_A)[1] 1 5 9# Create diagonal matrix from vector
v <- c(10, 20, 30)
D <- diag(v)
cat("\nDiagonal matrix from vector:\n")
Diagonal matrix from vector:print(D) [,1] [,2] [,3]
[1,] 10 0 0
[2,] 0 20 0
[3,] 0 0 30# Replace diagonal
A_new <- A
diag(A_new) <- c(99, 99, 99)
cat("\nA with diagonal replaced:\n")
A with diagonal replaced:print(A_new) [,1] [,2] [,3]
[1,] 99 4 7
[2,] 2 99 8
[3,] 3 6 99Special Case - Singular Diagonal Matrix:
If any \(d_i = 0\), the matrix is singular (not invertible).
# Diagonal matrix with a zero
D_singular <- diag(c(2, 0, 5))
cat("Singular diagonal matrix:\n")Singular diagonal matrix:print(D_singular) [,1] [,2] [,3]
[1,] 2 0 0
[2,] 0 0 0
[3,] 0 0 5cat(sprintf("\nDeterminant: %.1f\n", det(D_singular)))
Determinant: 0.0cat(sprintf("Rank: %d (less than 3)\n", qr(D_singular)$rank))Rank: 2 (less than 3)cat("\nThis matrix is not invertible because det = 0\n")
This matrix is not invertible because det = 0# But we can compute generalized inverse
library(MASS)
D_ginv <- ginv(D_singular)
cat("\nGeneralized inverse:\n")
Generalized inverse:print(D_ginv) [,1] [,2] [,3]
[1,] 0.5 0 0.0
[2,] 0.0 0 0.0
[3,] 0.0 0 0.2
TipComputational Advantages
Diagonal matrices are computationally efficient:
- Storage: Store only n values instead of n²
- Multiplication: O(n) instead of O(n³)
- Inversion: O(n) instead of O(n³)
- Determinant: Simple product instead of complex calculation
For large-scale problems, use sparse matrix representations.
NoteCross-References
Diagonal matrices appear in:
- Week 5: Variance matrix \(\mathbf{Var}(\mathbf{e}) = \sigma^2\mathbf{I}\) (special case)
- Week 10: Weighted least squares with weight matrix \(\mathbf{W}\)
- Week 11: Leverage values (diagonal of hat matrix)
- Week 14: Variance components in genetic evaluation
16.3.3 Symmetric Matrices
Definition:
A matrix A is symmetric if \(\mathbf{A} = \mathbf{A}'\) (equals its own transpose).
This requires: 1. A must be square (n × n) 2. \(a_{ij} = a_{ji}\) for all i, j
\[ \mathbf{A} = \begin{bmatrix} a_{11} & a_{12} & a_{13} \\ a_{12} & a_{22} & a_{23} \\ a_{13} & a_{23} & a_{33} \end{bmatrix} \tag{16.8}\]
Key Properties:
- Transpose: \(\mathbf{A}' = \mathbf{A}\) (by definition)
- Sum: If A and B are symmetric, then \(\mathbf{A} + \mathbf{B}\) is symmetric
- Scalar multiple: If A is symmetric, then \(c\mathbf{A}\) is symmetric
- Product with transpose: \(\mathbf{X}'\mathbf{X}\) and \(\mathbf{XX}'\) are always symmetric for any X
- Inverse: If A is symmetric and invertible, then \(\mathbf{A}^{-1}\) is symmetric
- Eigenvalues: All eigenvalues are real
- Eigenvectors: Eigenvectors corresponding to distinct eigenvalues are orthogonal
Why Symmetric Matrices Are Crucial for Linear Models:
The matrix \(\mathbf{X}'\mathbf{X}\) is always symmetric, and this matrix appears in every linear model calculation.
Proof that X’X is symmetric: \[ (\mathbf{X}'\mathbf{X})' = \mathbf{X}'(\mathbf{X}')' = \mathbf{X}'\mathbf{X} \quad \checkmark \]
R Implementation:
# Create a symmetric matrix
A <- matrix(c(4, 2, 1,
2, 5, 3,
1, 3, 6), nrow = 3, ncol = 3, byrow = TRUE)
cat("Symmetric matrix A:\n")Symmetric matrix A:print(A) [,1] [,2] [,3]
[1,] 4 2 1
[2,] 2 5 3
[3,] 1 3 6cat("\nTranspose A':\n")
Transpose A':print(t(A)) [,1] [,2] [,3]
[1,] 4 2 1
[2,] 2 5 3
[3,] 1 3 6cat("\nVerify A = A':\n")
Verify A = A':all.equal(A, t(A))[1] TRUE# Check if a matrix is symmetric
is_symmetric <- function(M) {
isTRUE(all.equal(M, t(M)))
}
cat("\nIs A symmetric?", is_symmetric(A), "\n")
Is A symmetric? TRUE # Non-symmetric matrix
B <- matrix(c(1, 2, 3, 4, 5, 6, 7, 8, 9), nrow = 3, ncol = 3, byrow = TRUE)
cat("\nNon-symmetric matrix B:\n")
Non-symmetric matrix B:print(B) [,1] [,2] [,3]
[1,] 1 2 3
[2,] 4 5 6
[3,] 7 8 9cat("Is B symmetric?", is_symmetric(B), "\n")Is B symmetric? FALSE Creating Symmetric Matrices - X’X:
# Design matrix for simple regression
# n = 5 observations
X <- cbind(1, c(10, 20, 30, 40, 50))
cat("Design matrix X (5×2):\n")Design matrix X (5×2):print(X) [,1] [,2]
[1,] 1 10
[2,] 1 20
[3,] 1 30
[4,] 1 40
[5,] 1 50# Form X'X
XtX <- t(X) %*% X
cat("\nX'X (2×2):\n")
X'X (2×2):print(XtX) [,1] [,2]
[1,] 5 150
[2,] 150 5500cat("\nVerify X'X is symmetric:\n")
Verify X'X is symmetric:all.equal(XtX, t(XtX))[1] TRUEcat("\nStructure of X'X:\n")
Structure of X'X:cat(" [1,1] = sum of 1² = n = 5\n") [1,1] = sum of 1² = n = 5cat(" [1,2] = [2,1] = sum of x = 150\n") [1,2] = [2,1] = sum of x = 150cat(" [2,2] = sum of x² = 5500\n") [2,2] = sum of x² = 5500Livestock Example - Variance-Covariance Matrix:
Sample covariance matrices are always symmetric.
# Broiler data: 6 birds, 3 traits (body weight, breast yield, leg yield)
traits <- matrix(c(
2.5, 0.85, 0.45, # Bird 1
2.8, 0.90, 0.48, # Bird 2
2.3, 0.80, 0.42, # Bird 3
2.7, 0.88, 0.47, # Bird 4
2.6, 0.87, 0.46, # Bird 5
2.9, 0.92, 0.50 # Bird 6
), nrow = 6, ncol = 3, byrow = TRUE)
colnames(traits) <- c("BodyWt_kg", "BreastYield", "LegYield")
cat("Broiler trait data (6 birds × 3 traits):\n")Broiler trait data (6 birds × 3 traits):print(traits) BodyWt_kg BreastYield LegYield
[1,] 2.5 0.85 0.45
[2,] 2.8 0.90 0.48
[3,] 2.3 0.80 0.42
[4,] 2.7 0.88 0.47
[5,] 2.6 0.87 0.46
[6,] 2.9 0.92 0.50# Compute covariance matrix
cov_matrix <- cov(traits)
cat("\nCovariance matrix (3×3):\n")
Covariance matrix (3×3):print(round(cov_matrix, 4)) BodyWt_kg BreastYield LegYield
BodyWt_kg 0.0467 0.0090 0.0059
BreastYield 0.0090 0.0018 0.0011
LegYield 0.0059 0.0011 0.0007cat("\nVerify symmetry:\n")
Verify symmetry:all.equal(cov_matrix, t(cov_matrix))[1] TRUEcat("\nInterpretation:\n")
Interpretation:cat(sprintf(" Var(BodyWt) = %.4f\n", cov_matrix[1,1])) Var(BodyWt) = 0.0467cat(sprintf(" Cov(BodyWt, BreastYield) = %.4f\n", cov_matrix[1,2])) Cov(BodyWt, BreastYield) = 0.0090cat(sprintf(" Note: cov[1,2] = cov[2,1] = %.4f (symmetric!)\n", cov_matrix[1,2])) Note: cov[1,2] = cov[2,1] = 0.0090 (symmetric!)Symmetric Matrices in ANOVA:
For a one-way ANOVA with balanced data, \(\mathbf{X}'\mathbf{X}\) has special structure.
# One-way ANOVA: 3 breeds, 2 observations per breed
breed <- factor(rep(1:3, each = 2))
X <- model.matrix(~ breed - 1) # Cell means model
cat("Design matrix X (6×3):\n")Design matrix X (6×3):print(X) breed1 breed2 breed3
1 1 0 0
2 1 0 0
3 0 1 0
4 0 1 0
5 0 0 1
6 0 0 1
attr(,"assign")
[1] 1 1 1
attr(,"contrasts")
attr(,"contrasts")$breed
[1] "contr.treatment"XtX <- t(X) %*% X
cat("\nX'X (3×3):\n")
X'X (3×3):print(XtX) breed1 breed2 breed3
breed1 2 0 0
breed2 0 2 0
breed3 0 0 2cat("\nVerify X'X is symmetric:\n")
Verify X'X is symmetric:all.equal(XtX, t(XtX))[1] TRUEcat("\nFor balanced design, X'X is diagonal:\n")
For balanced design, X'X is diagonal:cat("Each breed has n=2 observations, so diagonal = 2\n")Each breed has n=2 observations, so diagonal = 2Inverse of Symmetric Matrix:
If A is symmetric, then \(\mathbf{A}^{-1}\) is also symmetric.
# Symmetric matrix
A <- matrix(c(4, 1, 1, 3), nrow = 2, ncol = 2, byrow = TRUE)
cat("Symmetric matrix A:\n")Symmetric matrix A:print(A) [,1] [,2]
[1,] 4 1
[2,] 1 3# Inverse
A_inv <- solve(A)
cat("\nInverse A^(-1):\n")
Inverse A^(-1):print(A_inv) [,1] [,2]
[1,] 0.27273 -0.09091
[2,] -0.09091 0.36364cat("\nVerify A^(-1) is symmetric:\n")
Verify A^(-1) is symmetric:all.equal(A_inv, t(A_inv))[1] TRUEcat("\nVerify A * A^(-1) = I:\n")
Verify A * A^(-1) = I:print(round(A %*% A_inv, 10)) [,1] [,2]
[1,] 1 0
[2,] 0 1Livestock Example - Normal Equations:
The entire normal equation system is symmetric.
# Dairy cow milk yield (kg/day) vs days in milk
days <- c(30, 60, 90, 120, 150)
yield <- c(35, 32, 28, 25, 22)
# Design matrix (n×2): intercept and days
X <- cbind(1, days)
y <- matrix(yield, ncol = 1)
cat("Design matrix X (5×2):\n")Design matrix X (5×2):print(X) days
[1,] 1 30
[2,] 1 60
[3,] 1 90
[4,] 1 120
[5,] 1 150# Normal equations: X'Xb = X'y
XtX <- t(X) %*% X
Xty <- t(X) %*% y
cat("\nX'X (symmetric coefficient matrix):\n")
X'X (symmetric coefficient matrix):print(XtX) days
5 450
days 450 49500cat("\nX'y (right-hand side):\n")
X'y (right-hand side):print(Xty) [,1]
142
days 11790# Solve
b <- solve(XtX) %*% Xty
cat("\nSolution b:\n")
Solution b:print(b) [,1]
38.30
days -0.11cat(sprintf("\nRegression equation: y = %.2f + %.4f * days\n", b[1], b[2]))
Regression equation: y = 38.30 + -0.1100 * days# Variance of estimates: (X'X)^(-1) σ²
XtX_inv <- solve(XtX)
cat("\n(X'X)^(-1) (also symmetric):\n")
(X'X)^(-1) (also symmetric):print(round(XtX_inv, 6)) days
1.10 -0.010000
days -0.01 0.000111cat("\nVerify (X'X)^(-1) is symmetric:\n")
Verify (X'X)^(-1) is symmetric:all.equal(XtX_inv, t(XtX_inv))[1] TRUEChecking Symmetry Numerically:
Due to floating-point arithmetic, sometimes need to check “near symmetry.”
# Create matrix with small numerical errors
A_perfect <- matrix(c(1, 0.5, 0.5, 2), nrow = 2, ncol = 2)
A_noisy <- A_perfect
A_noisy[1,2] <- A_noisy[1,2] + 1e-15 # Tiny numerical error
cat("Matrix with numerical noise:\n")Matrix with numerical noise:print(A_noisy, digits = 20) [,1] [,2]
[1,] 1.0 0.5000000000000009992
[2,] 0.5 2.0000000000000000000cat("\nExact equality fails:\n")
Exact equality fails:print(identical(A_noisy, t(A_noisy)))[1] FALSEcat("\nBut all.equal() handles tolerance:\n")
But all.equal() handles tolerance:print(all.equal(A_noisy, t(A_noisy)))[1] TRUE# Force exact symmetry
make_symmetric <- function(M) {
(M + t(M)) / 2
}
A_fixed <- make_symmetric(A_noisy)
cat("\nForced symmetric matrix:\n")
Forced symmetric matrix:print(A_fixed, digits = 20) [,1] [,2]
[1,] 1.00000000000000000000 0.50000000000000044409
[2,] 0.50000000000000044409 2.00000000000000000000cat("\nNow exactly symmetric:\n")
Now exactly symmetric:print(identical(A_fixed, t(A_fixed)))[1] TRUE
ImportantX’X is Always Symmetric
In every linear model calculation, the matrix \(\mathbf{X}'\mathbf{X}\) is symmetric. This property:
- Reduces computational cost (only need to compute upper or lower triangle)
- Guarantees real eigenvalues
- Enables specialized algorithms (Cholesky decomposition)
- Ensures variance-covariance matrix \(\text{Var}(\mathbf{b}) = (\mathbf{X}'\mathbf{X})^{-1}\sigma^2\) is symmetric
Always verify symmetry when implementing linear model solvers!
NoteCross-References
Symmetric matrices are central to:
- Week 2: Properties of \(\mathbf{X}'\mathbf{X}\)
- Week 5: Variance-covariance matrices
- Week 6: Correlation matrices
- Week 8: Testing contrasts with \(\mathbf{c}'(\mathbf{X}'\mathbf{X})^{-1}\mathbf{c}\)
- Week 14: Genetic covariance matrices G and A
16.3.4 Orthogonal Matrices
Definition:
A square matrix Q is orthogonal if its columns are orthonormal (orthogonal unit vectors).
Equivalently: \(\mathbf{Q}'\mathbf{Q} = \mathbf{QQ}' = \mathbf{I}\)
This means: \(\mathbf{Q}' = \mathbf{Q}^{-1}\) (transpose equals inverse!)
Orthonormal Columns:
The columns \(\mathbf{q}_1, \mathbf{q}_2, ..., \mathbf{q}_n\) satisfy: \[ \mathbf{q}_i'\mathbf{q}_j = \begin{cases} 1 & \text{if } i = j \text{ (unit length)} \\ 0 & \text{if } i \neq j \text{ (orthogonal)} \end{cases} \tag{16.9}\]
Key Properties:
- Inverse is transpose: \(\mathbf{Q}^{-1} = \mathbf{Q}'\) (very fast to compute!)
- Preserves lengths: \(||\mathbf{Qx}|| = ||\mathbf{x}||\) for any vector x
- Preserves angles: Inner products preserved
- Determinant: \(\det(\mathbf{Q}) = \pm 1\)
- Product: If Q₁ and Q₂ are orthogonal, so is Q₁Q₂
- Eigenvalues: All eigenvalues have magnitude 1
R Implementation:
# Simple 2×2 rotation matrix (rotation by 45°)
theta <- pi/4 # 45 degrees
Q <- matrix(c(cos(theta), sin(theta),
-sin(theta), cos(theta)), nrow = 2, ncol = 2, byrow = TRUE)
cat("Orthogonal matrix Q (2×2 rotation):\n")Orthogonal matrix Q (2×2 rotation):print(round(Q, 4)) [,1] [,2]
[1,] 0.7071 0.7071
[2,] -0.7071 0.7071# Verify Q'Q = I
QtQ <- t(Q) %*% Q
cat("\nQ'Q (should be I):\n")
Q'Q (should be I):print(round(QtQ, 10)) [,1] [,2]
[1,] 1 0
[2,] 0 1# Verify QQ' = I
QQt <- Q %*% t(Q)
cat("\nQQ' (should be I):\n")
QQ' (should be I):print(round(QQt, 10)) [,1] [,2]
[1,] 1 0
[2,] 0 1# Verify Q' = Q^(-1)
Q_inv <- solve(Q)
cat("\nQ^(-1):\n")
Q^(-1):print(round(Q_inv, 4)) [,1] [,2]
[1,] 0.7071 -0.7071
[2,] 0.7071 0.7071cat("\nQ' (should equal Q^(-1)):\n")
Q' (should equal Q^(-1)):print(round(t(Q), 4)) [,1] [,2]
[1,] 0.7071 -0.7071
[2,] 0.7071 0.7071cat("\nVerify Q' = Q^(-1):\n")
Verify Q' = Q^(-1):all.equal(t(Q), Q_inv)[1] TRUECreating Orthogonal Matrices - Gram-Schmidt:
Convert a set of vectors into orthonormal vectors.
# Start with two non-orthogonal vectors
v1 <- c(1, 1, 0)
v2 <- c(1, 0, 1)
cat("Original vectors:\n")Original vectors:cat("v1 =", v1, "\n")v1 = 1 1 0 cat("v2 =", v2, "\n")v2 = 1 0 1 # Gram-Schmidt orthogonalization
# Step 1: Normalize v1
q1 <- v1 / sqrt(sum(v1^2))
cat("\nq1 (normalized v1):\n")
q1 (normalized v1):print(q1)[1] 0.7071 0.7071 0.0000# Step 2: Remove component of v2 in direction of q1
v2_perp <- v2 - sum(v2 * q1) * q1
cat("\nv2_perp (v2 minus projection onto q1):\n")
v2_perp (v2 minus projection onto q1):print(v2_perp)[1] 0.5 -0.5 1.0# Step 3: Normalize
q2 <- v2_perp / sqrt(sum(v2_perp^2))
cat("\nq2 (normalized v2_perp):\n")
q2 (normalized v2_perp):print(q2)[1] 0.4082 -0.4082 0.8165# Verify orthonormality
cat("\nq1'q1 (should be 1):", sum(q1 * q1), "\n")
q1'q1 (should be 1): 1 cat("q2'q2 (should be 1):", sum(q2 * q2), "\n")q2'q2 (should be 1): 1 cat("q1'q2 (should be 0):", sum(q1 * q2), "\n")q1'q2 (should be 0): 1.11e-16 # Built-in QR decomposition does this automatically
A <- cbind(v1, v2)
QR <- qr(A)
Q_auto <- qr.Q(QR)
cat("\nQ from qr() decomposition:\n")
Q from qr() decomposition:print(Q_auto) [,1] [,2]
[1,] -0.7071 0.4082
[2,] -0.7071 -0.4082
[3,] 0.0000 0.8165Length Preservation:
Orthogonal transformations preserve vector lengths.
# Vector
x <- c(3, 4)
cat("Original vector x:", x, "\n")Original vector x: 3 4 cat("Length ||x||:", sqrt(sum(x^2)), "\n")Length ||x||: 5 # Rotate by 45°
Q <- matrix(c(cos(pi/4), sin(pi/4),
-sin(pi/4), cos(pi/4)), nrow = 2, ncol = 2, byrow = TRUE)
# Transform
Qx <- Q %*% x
cat("\nTransformed vector Qx:", Qx, "\n")
Transformed vector Qx: 4.95 0.7071 cat("Length ||Qx||:", sqrt(sum(Qx^2)), "\n")Length ||Qx||: 5 cat("\nLengths are preserved!\n")
Lengths are preserved!Orthogonal Matrices in Linear Models - QR Decomposition:
Any matrix X can be factored as X = QR where Q is orthogonal and R is upper triangular.
# Design matrix for simple regression
X <- cbind(1, c(1, 2, 3, 4, 5))
cat("Design matrix X (5×2):\n")Design matrix X (5×2):print(X) [,1] [,2]
[1,] 1 1
[2,] 1 2
[3,] 1 3
[4,] 1 4
[5,] 1 5# QR decomposition
qr_obj <- qr(X)
Q <- qr.Q(qr_obj)
R <- qr.R(qr_obj)
cat("\nQ (orthogonal, 5×2):\n")
Q (orthogonal, 5×2):print(round(Q, 4)) [,1] [,2]
[1,] -0.4472 -0.6325
[2,] -0.4472 -0.3162
[3,] -0.4472 0.0000
[4,] -0.4472 0.3162
[5,] -0.4472 0.6325cat("\nR (upper triangular, 2×2):\n")
R (upper triangular, 2×2):print(round(R, 4)) [,1] [,2]
[1,] -2.236 -6.708
[2,] 0.000 3.162# Verify X = QR
cat("\nVerify X = QR:\n")
Verify X = QR:QR_product <- Q %*% R
print(round(QR_product, 4)) [,1] [,2]
[1,] 1 1
[2,] 1 2
[3,] 1 3
[4,] 1 4
[5,] 1 5all.equal(X, QR_product, check.attributes = FALSE)[1] TRUE# Verify Q'Q = I
cat("\nVerify Q'Q = I:\n")
Verify Q'Q = I:QtQ <- t(Q) %*% Q
print(round(QtQ, 10)) [,1] [,2]
[1,] 1 0
[2,] 0 1Solving Normal Equations with QR:
If X = QR, then X’X = R’Q’QR = R’R (since Q’Q = I).
The normal equations simplify: R’Rb = R’Q’y
Or: Rb = Q’y (much more stable numerically!)
# Example data
y <- c(2, 4, 6, 8, 10)
# Traditional method: (X'X)^(-1)X'y
XtX <- t(X) %*% X
Xty <- t(X) %*% y
b_traditional <- solve(XtX) %*% Xty
cat("Traditional solution b:\n")Traditional solution b:print(b_traditional) [,1]
[1,] 0
[2,] 2# QR method: R^(-1)Q'y
b_qr <- solve(R) %*% t(Q) %*% y
cat("\nQR solution b:\n")
QR solution b:print(b_qr) [,1]
[1,] 0
[2,] 2cat("\nVerify both methods give same answer:\n")
Verify both methods give same answer:all.equal(b_traditional, b_qr, check.attributes = FALSE)[1] TRUEcat("\nQR method is numerically more stable for ill-conditioned X'X\n")
QR method is numerically more stable for ill-conditioned X'XLivestock Example - Orthogonal Contrasts:
In balanced ANOVA, orthogonal contrasts correspond to orthogonal directions.
# Three feed types, n=3 per feed
# Treatment means (estimated)
mu <- c(25, 28, 22) # kg, body weight gain
cat("Treatment means:", mu, "\n")Treatment means: 25 28 22 # Two orthogonal contrasts
# C1: Treatment 1 vs Treatment 2
c1 <- c(1, -1, 0)
# C2: Average of (1,2) vs Treatment 3
c2 <- c(1, 1, -2)
cat("\nContrast 1:", c1, "\n")
Contrast 1: 1 -1 0 cat("Contrast 2:", c2, "\n")Contrast 2: 1 1 -2 # Check orthogonality: c1'c2 = 0
cat("\nc1'c2 =", sum(c1 * c2), "(orthogonal!)\n")
c1'c2 = 0 (orthogonal!)# Estimates
psi1 <- sum(c1 * mu)
psi2 <- sum(c2 * mu)
cat(sprintf("\nContrast 1 estimate: %.1f kg (T1 - T2)\n", psi1))
Contrast 1 estimate: -3.0 kg (T1 - T2)cat(sprintf("Contrast 2 estimate: %.1f kg (Avg(T1,T2) - T3)\n", psi2))Contrast 2 estimate: 9.0 kg (Avg(T1,T2) - T3)cat("\nOrthogonal contrasts partition the treatment sum of squares\n")
Orthogonal contrasts partition the treatment sum of squaresOrthogonal Polynomials:
# Five time points
time <- 1:5
# Orthogonal polynomials (up to degree 4)
poly_matrix <- poly(time, degree = 4)
cat("Orthogonal polynomial matrix (5×4):\n")Orthogonal polynomial matrix (5×4):print(round(poly_matrix, 4)) 1 2 3 4
[1,] -0.6325 0.5345 -0.3162 0.1195
[2,] -0.3162 -0.2673 0.6325 -0.4781
[3,] 0.0000 -0.5345 0.0000 0.7171
[4,] 0.3162 -0.2673 -0.6325 -0.4781
[5,] 0.6325 0.5345 0.3162 0.1195
attr(,"coefs")
attr(,"coefs")$alpha
[1] 3 3 3 3
attr(,"coefs")$norm2
[1] 1.000 5.000 10.000 14.000 14.400 8.229
attr(,"degree")
[1] 1 2 3 4
attr(,"class")
[1] "poly" "matrix"# Verify orthonormality
cat("\nX'X (should be identity):\n")
X'X (should be identity):XtX <- t(poly_matrix) %*% poly_matrix
print(round(XtX, 10)) 1 2 3 4
1 1 0 0 0
2 0 1 0 0
3 0 0 1 0
4 0 0 0 1cat("\nThese orthogonal polynomials reduce collinearity in polynomial regression\n")
These orthogonal polynomials reduce collinearity in polynomial regression
TipWhy Orthogonal Matrices Matter
- Numerical stability: \(\mathbf{Q}^{-1} = \mathbf{Q}'\) is trivial to compute
- QR decomposition: More stable than solving \((X'X)^{-1}\) directly
- Geometry: Represents rotations and reflections
- Condition number: \(\kappa(\mathbf{Q}) = 1\) (perfectly conditioned)
- Orthogonal contrasts: Partition sums of squares cleanly
NoteCross-References
Orthogonal matrices appear in:
- Week 2: QR decomposition
- Week 5: Stable solution of normal equations
- Week 8: Orthogonal contrasts in balanced ANOVA
- Week 14: Polynomial regression with orthogonal polynomials
- Appendix: Eigenvalue decomposition A = QΛQ’ for symmetric A
16.3.5 Idempotent Matrices
Definition:
A matrix P is idempotent if \(\mathbf{P}^2 = \mathbf{P}\) (applying it twice gives same result as applying once).
Equivalently: \(\mathbf{PP} = \mathbf{P}\)
Geometric Interpretation:
Idempotent matrices represent projections. Projecting onto a subspace twice is the same as projecting once.
Key Properties:
- Repeated application: \(\mathbf{P}^k = \mathbf{P}\) for all \(k \geq 1\)
- Eigenvalues: Only 0 or 1 (no other values possible!)
- Rank equals trace: \(r(\mathbf{P}) = \text{tr}(\mathbf{P})\) (very useful!)
- Complement is idempotent: If P is idempotent, so is \(\mathbf{I} - \mathbf{P}\)
- Orthogonal projections: If P is also symmetric, it’s an orthogonal projection
Proof that I - P is idempotent: \[ (\mathbf{I} - \mathbf{P})^2 = \mathbf{I}^2 - 2\mathbf{P} + \mathbf{P}^2 = \mathbf{I} - 2\mathbf{P} + \mathbf{P} = \mathbf{I} - \mathbf{P} \quad \checkmark \]
Most Important Examples in Linear Models:
- Hat matrix: \(\mathbf{H} = \mathbf{X}(\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}'\) (projects onto column space of X)
- Residual matrix: \(\mathbf{I} - \mathbf{H}\) (projects onto orthogonal complement)
- Centering matrix: \(\mathbf{C} = \mathbf{I} - n^{-1}\mathbf{J}_n\) where \(\mathbf{J}_n = \mathbf{11}'\)
R Implementation:
# Simple example: projection onto first coordinate
P <- matrix(c(1, 0, 0, 0, 0, 0, 0, 0, 0), nrow = 3, ncol = 3, byrow = TRUE)
cat("Projection matrix P:\n")Projection matrix P:print(P) [,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 0 0
[3,] 0 0 0# Test idempotence
P2 <- P %*% P
cat("\nP² (should equal P):\n")
P² (should equal P):print(P2) [,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 0 0
[3,] 0 0 0cat("\nVerify P² = P:\n")
Verify P² = P:all.equal(P2, P)[1] TRUE# Apply to vector
x <- c(3, 4, 5)
Px <- P %*% x
cat("\nOriginal vector x:", x, "\n")
Original vector x: 3 4 5 cat("Projected vector Px:", Px, "\n")Projected vector Px: 3 0 0 cat("(Projects onto first coordinate, zeros out others)\n")(Projects onto first coordinate, zeros out others)# Apply twice
PPx <- P %*% Px
cat("P(Px) (should equal Px):", PPx, "\n")P(Px) (should equal Px): 3 0 0 Hat Matrix - THE Central Example:
# Simple regression: n=4 observations
X <- cbind(1, c(1, 2, 3, 4))
cat("Design matrix X (4×2):\n")Design matrix X (4×2):print(X) [,1] [,2]
[1,] 1 1
[2,] 1 2
[3,] 1 3
[4,] 1 4# Construct hat matrix
H <- X %*% solve(t(X) %*% X) %*% t(X)
cat("\nHat matrix H (4×4):\n")
Hat matrix H (4×4):print(round(H, 4)) [,1] [,2] [,3] [,4]
[1,] 0.7 0.4 0.1 -0.2
[2,] 0.4 0.3 0.2 0.1
[3,] 0.1 0.2 0.3 0.4
[4,] -0.2 0.1 0.4 0.7# Verify idempotence: H² = H
H2 <- H %*% H
cat("\nH² (should equal H):\n")
H² (should equal H):print(round(H2, 4)) [,1] [,2] [,3] [,4]
[1,] 0.7 0.4 0.1 -0.2
[2,] 0.4 0.3 0.2 0.1
[3,] 0.1 0.2 0.3 0.4
[4,] -0.2 0.1 0.4 0.7cat("\nVerify H² = H:\n")
Verify H² = H:all.equal(H2, H)[1] TRUE# Verify rank = trace
rank_H <- qr(H)$rank
trace_H <- sum(diag(H))
cat(sprintf("\nrank(H) = %d\n", rank_H))
rank(H) = 2cat(sprintf("trace(H) = %.4f\n", trace_H))trace(H) = 2.0000cat("rank(H) = trace(H) ✓\n")rank(H) = trace(H) ✓cat("\nInterpretation: trace(H) = p = 2 (number of parameters)\n")
Interpretation: trace(H) = p = 2 (number of parameters)Residual Matrix - Orthogonal Complement:
# Residual matrix
I <- diag(4)
M <- I - H
cat("Residual matrix I - H (4×4):\n")Residual matrix I - H (4×4):print(round(M, 4)) [,1] [,2] [,3] [,4]
[1,] 0.3 -0.4 -0.1 0.2
[2,] -0.4 0.7 -0.2 -0.1
[3,] -0.1 -0.2 0.7 -0.4
[4,] 0.2 -0.1 -0.4 0.3# Verify idempotence: (I-H)² = I-H
M2 <- M %*% M
cat("\n(I-H)² (should equal I-H):\n")
(I-H)² (should equal I-H):print(round(M2, 4)) [,1] [,2] [,3] [,4]
[1,] 0.3 -0.4 -0.1 0.2
[2,] -0.4 0.7 -0.2 -0.1
[3,] -0.1 -0.2 0.7 -0.4
[4,] 0.2 -0.1 -0.4 0.3cat("\nVerify (I-H)² = I-H:\n")
Verify (I-H)² = I-H:all.equal(M2, M)[1] TRUE# Verify rank = trace
rank_M <- qr(M)$rank
trace_M <- sum(diag(M))
cat(sprintf("\nrank(I-H) = %d\n", rank_M))
rank(I-H) = 2cat(sprintf("trace(I-H) = %.4f\n", trace_M))trace(I-H) = 2.0000cat("rank(I-H) = trace(I-H) ✓\n")rank(I-H) = trace(I-H) ✓cat(sprintf("\nInterpretation: trace(I-H) = n-p = %d - %d = %d (degrees of freedom for error)\n",
nrow(X), ncol(X), nrow(X) - ncol(X)))
Interpretation: trace(I-H) = n-p = 4 - 2 = 2 (degrees of freedom for error)Orthogonal Decomposition:
The hat matrix H and residual matrix I-H provide an orthogonal decomposition of any vector.
# Any observation vector y
y <- c(2, 4, 5, 7)
cat("Observation vector y:", y, "\n")Observation vector y: 2 4 5 7 # Fitted values (projection onto column space of X)
y_hat <- H %*% y
cat("\nFitted values ŷ = Hy:", as.vector(y_hat), "\n")
Fitted values ŷ = Hy: 2.1 3.7 5.3 6.9 # Residuals (projection onto orthogonal complement)
e <- (I - H) %*% y
cat("Residuals e = (I-H)y:", as.vector(e), "\n")Residuals e = (I-H)y: -0.1 0.3 -0.3 0.1 # Verify y = ŷ + e
cat("\nVerify y = ŷ + e:\n")
Verify y = ŷ + e:all.equal(y, as.vector(y_hat + e))[1] TRUE# Verify orthogonality: ŷ'e = 0
cat(sprintf("\nŷ'e = %.10f (should be 0)\n", sum(y_hat * e)))
ŷ'e = -0.0000000000 (should be 0)cat("\nThis is the fundamental decomposition: y = Hy + (I-H)y\n")
This is the fundamental decomposition: y = Hy + (I-H)ycat("Fitted values + Residuals = Observations\n")Fitted values + Residuals = ObservationsCentering Matrix:
The centering matrix removes the mean from data.
# Data vector
x <- c(10, 20, 30, 40, 50)
n <- length(x)
cat("Data x:", x, "\n")Data x: 10 20 30 40 50 cat("Mean:", mean(x), "\n")Mean: 30 # Centering matrix: C = I - (1/n)J where J = 11'
J <- matrix(1, nrow = n, ncol = n) # All ones
C <- diag(n) - (1/n) * J
cat("\nCentering matrix C (5×5):\n")
Centering matrix C (5×5):print(round(C, 2)) [,1] [,2] [,3] [,4] [,5]
[1,] 0.8 -0.2 -0.2 -0.2 -0.2
[2,] -0.2 0.8 -0.2 -0.2 -0.2
[3,] -0.2 -0.2 0.8 -0.2 -0.2
[4,] -0.2 -0.2 -0.2 0.8 -0.2
[5,] -0.2 -0.2 -0.2 -0.2 0.8# Apply centering matrix
x_centered <- C %*% x
cat("\nCentered data Cx:\n")
Centered data Cx:print(x_centered) [,1]
[1,] -20
[2,] -10
[3,] 0
[4,] 10
[5,] 20cat("\nVerify mean of centered data is 0:\n")
Verify mean of centered data is 0:cat(sprintf("Mean = %.10f\n", mean(x_centered)))Mean = 0.0000000000# Verify idempotence
C2 <- C %*% C
cat("\nVerify C² = C:\n")
Verify C² = C:all.equal(C2, C)[1] TRUEcat("\nCentering is a projection (idempotent operation)\n")
Centering is a projection (idempotent operation)Livestock Example - Sum of Squares Decomposition:
Idempotent matrices decompose total sum of squares into components.
# Broiler weights (kg)
weight <- c(2.1, 2.3, 2.5, 2.7, 2.9)
y <- matrix(weight, ncol = 1)
n <- length(weight)
cat("Broiler weights (kg):", weight, "\n")Broiler weights (kg): 2.1 2.3 2.5 2.7 2.9 # Design matrix (just intercept - estimate mean)
X <- matrix(1, nrow = n, ncol = 1)
# Hat matrix
H <- X %*% solve(t(X) %*% X) %*% t(X)
# For intercept-only: H = (1/n)J (all elements = 1/n)
# Centering matrix
J_n <- matrix(1/n, nrow = n, ncol = n)
C <- diag(n) - J_n
cat("\nHat matrix H (all elements 1/5 = 0.2):\n")
Hat matrix H (all elements 1/5 = 0.2):print(round(H, 2)) [,1] [,2] [,3] [,4] [,5]
[1,] 0.2 0.2 0.2 0.2 0.2
[2,] 0.2 0.2 0.2 0.2 0.2
[3,] 0.2 0.2 0.2 0.2 0.2
[4,] 0.2 0.2 0.2 0.2 0.2
[5,] 0.2 0.2 0.2 0.2 0.2# Total sum of squares: y'Cy
SST <- t(y) %*% C %*% y
cat(sprintf("\nSST = y'(I - n⁻¹J)y = %.4f\n", SST[1,1]))
SST = y'(I - n⁻¹J)y = 0.4000# Verify with formula
SST_formula <- sum((weight - mean(weight))^2)
cat(sprintf("Verification: Σ(y - ȳ)² = %.4f\n", SST_formula))Verification: Σ(y - ȳ)² = 0.4000cat("\nThe centering matrix C = I - n⁻¹J is idempotent and computes SST\n")
The centering matrix C = I - n⁻¹J is idempotent and computes SSTProperties of Symmetric Idempotent Matrices:
If P is symmetric and idempotent, it’s an orthogonal projection.
# Hat matrix is both symmetric and idempotent
X <- cbind(1, c(1, 2, 3))
H <- X %*% solve(t(X) %*% X) %*% t(X)
cat("Hat matrix H:\n")Hat matrix H:print(round(H, 4)) [,1] [,2] [,3]
[1,] 0.8333 0.3333 -0.1667
[2,] 0.3333 0.3333 0.3333
[3,] -0.1667 0.3333 0.8333cat("\nCheck symmetry:\n")
Check symmetry:all.equal(H, t(H))[1] TRUEcat("\nCheck idempotence:\n")
Check idempotence:all.equal(H %*% H, H)[1] TRUEcat("\nH is symmetric AND idempotent → orthogonal projection\n")
H is symmetric AND idempotent → orthogonal projection# Eigenvalues are only 0 or 1
eigenvalues <- eigen(H)$values
cat("\nEigenvalues of H:\n")
Eigenvalues of H:print(round(eigenvalues, 10))[1] 1 1 0cat("Only 0's and 1's (characteristic of idempotent matrices)\n")Only 0's and 1's (characteristic of idempotent matrices)cat(sprintf("Number of 1's = %d = rank(H) = trace(H)\n", sum(eigenvalues > 0.5)))Number of 1's = 2 = rank(H) = trace(H)Why Idempotent Matrices Matter:
# Example: repeated projection doesn't change result
X <- cbind(1, 1:5)
y <- c(2, 4, 6, 8, 10)
H <- X %*% solve(t(X) %*% X) %*% t(X)
# Fitted values
y_hat1 <- H %*% y
y_hat2 <- H %*% y_hat1 # Project fitted values again
y_hat3 <- H %*% y_hat2 # And again
cat("Original y:", y, "\n")Original y: 2 4 6 8 10 cat("Hy (1st projection):", round(as.vector(y_hat1), 4), "\n")Hy (1st projection): 2 4 6 8 10 cat("H(Hy) (2nd projection):", round(as.vector(y_hat2), 4), "\n")H(Hy) (2nd projection): 2 4 6 8 10 cat("H(H(Hy)) (3rd projection):", round(as.vector(y_hat3), 4), "\n")H(H(Hy)) (3rd projection): 2 4 6 8 10 cat("\nAll identical! Projection is idempotent.\n")
All identical! Projection is idempotent.cat("Once you're in the subspace, projecting again does nothing.\n")Once you're in the subspace, projecting again does nothing.
ImportantHat Matrix is Idempotent
The hat matrix \(\mathbf{H} = \mathbf{X}(\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}'\) is:
- Symmetric: \(\mathbf{H}' = \mathbf{H}\)
- Idempotent: \(\mathbf{H}^2 = \mathbf{H}\)
- Rank = Trace: \(r(\mathbf{H}) = \text{tr}(\mathbf{H}) = p\) (number of parameters)
The residual matrix \(\mathbf{I} - \mathbf{H}\) has the same properties with: - \(r(\mathbf{I} - \mathbf{H}) = \text{tr}(\mathbf{I} - \mathbf{H}) = n - p\) (error degrees of freedom)
This is why trace gives degrees of freedom!
NoteCross-References
Idempotent matrices are fundamental to:
- Week 5: Hat matrix H and fitted values \(\hat{\mathbf{y}} = \mathbf{Hy}\)
- Week 5: Residuals \(\mathbf{e} = (\mathbf{I} - \mathbf{H})\mathbf{y}\)
- Week 5: Degrees of freedom = \(\text{tr}(\mathbf{I} - \mathbf{H}) = n - p\)
- Week 6: Sum of squares decomposition using centering matrix
- Week 11: Leverage values (diagonal of H)
- Section Section 16.6.1: Complete coverage of projection matrices
16.4 Matrix Properties
Understanding the fundamental properties of matrices - rank, trace, and determinant - is essential for working with linear models. These properties determine invertibility, degrees of freedom, and the structure of solutions.
16.4.1 Rank
The rank of a matrix is one of its most important properties, especially in linear models where it determines whether we can uniquely solve for parameters.
Definition
The rank of an m × n matrix A, denoted r(A), is:
- The maximum number of linearly independent rows, OR
- The maximum number of linearly independent columns, OR
- The dimension of the column space (or row space) of A
These three definitions are equivalent.
Key fact: For any matrix A, \(r(\mathbf{A}^{\text{rows}}) = r(\mathbf{A}^{\text{columns}})\)
Properties and Theorems
1. Basic Properties
- \(0 \leq r(\mathbf{A}) \leq \min(m, n)\) for m × n matrix
- \(r(\mathbf{A}) = r(\mathbf{A}')\) (rank of transpose equals rank)
- \(r(c\mathbf{A}) = r(\mathbf{A})\) for any scalar \(c \neq 0\)
2. Full Rank
An m × n matrix A is full rank if: - \(r(\mathbf{A}) = \min(m, n)\) - If m < n: full row rank (r = m) - If m > n: full column rank (r = n) - If m = n: A is square and invertible
3. Rank Deficient
A matrix is rank deficient if \(r(\mathbf{A}) < \min(m, n)\)
For square n × n matrices: - Full rank: r(A) = n (invertible, det(A) ≠ 0) - Rank deficient: r(A) < n (singular, det(A) = 0)
4. Product Rule
\[ r(\mathbf{AB}) \leq \min(r(\mathbf{A}), r(\mathbf{B})) \tag{16.10}\]
Proof: The columns of AB are linear combinations of columns of A, so column space of AB is a subspace of column space of A.
5. Sum Rule
\[ r(\mathbf{A} + \mathbf{B}) \leq r(\mathbf{A}) + r(\mathbf{B}) \tag{16.11}\]
6. Critical Result for Linear Models
\[ r(\mathbf{X}'\mathbf{X}) = r(\mathbf{X}\mathbf{X}') = r(\mathbf{X}) \tag{16.12}\]
This is fundamental for understanding when normal equations have unique solutions.
Proof: We need to show \(r(\mathbf{X}'\mathbf{X}) = r(\mathbf{X})\).
First, \(r(\mathbf{X}'\mathbf{X}) \leq r(\mathbf{X})\) by the product rule.
For the reverse inequality, suppose \(\mathbf{X}\mathbf{c} = \mathbf{0}\) for some vector c. Then: \[ \mathbf{c}'\mathbf{X}'\mathbf{X}\mathbf{c} = (\mathbf{X}\mathbf{c})'(\mathbf{X}\mathbf{c}) = \mathbf{0}'\mathbf{0} = 0 \]
This implies \(\mathbf{X}'\mathbf{X}\mathbf{c} = \mathbf{0}\) (since the quadratic form equals zero).
Therefore, null space of X equals null space of X’X, which means they have the same rank.
ImportantWhy This Matters for Linear Models
The result \(r(\mathbf{X}'\mathbf{X}) = r(\mathbf{X})\) tells us:
- If X is full column rank (r = p), then X’X is invertible
- If X is rank deficient, X’X is also rank deficient (singular)
- This determines whether normal equations have a unique solution
This is central to understanding Week 12: Non-Full Rank Models!
Computing Rank in R
# Method 1: QR decomposition (most reliable)
A <- matrix(c(1, 2, 3,
2, 4, 6,
1, 1, 1), nrow = 3, byrow = TRUE)
cat("Matrix A:\n")Matrix A:print(A) [,1] [,2] [,3]
[1,] 1 2 3
[2,] 2 4 6
[3,] 1 1 1rank_qr <- qr(A)$rank
cat("\nRank using QR:", rank_qr, "\n")
Rank using QR: 2 # Method 2: Using Matrix package
library(Matrix)
rank_matrix <- rankMatrix(A)
cat("Rank using rankMatrix:", rank_matrix[1], "\n")Rank using rankMatrix: 2 # Check: Second row is 2 times first row, so rank < 3
cat("\nRow 2 = 2 * Row 1?", all.equal(A[2,], 2 * A[1,]), "\n")
Row 2 = 2 * Row 1? TRUE cat("Therefore rank should be 2 (not 3)\n")Therefore rank should be 2 (not 3)Livestock Example: Design Matrix Rank
# Example: Sheep fleece weight by breed (unbalanced data)
breed <- c(rep("Merino", 3), rep("Suffolk", 2), rep("Dorset", 1))
weight <- c(5.2, 5.4, 5.3, 4.8, 5.0, 5.6)
# Cell means model (always full rank)
X_cell <- model.matrix(~ breed - 1)
cat("Cell Means Model Design Matrix:\n")Cell Means Model Design Matrix:print(X_cell) breedDorset breedMerino breedSuffolk
1 0 1 0
2 0 1 0
3 0 1 0
4 0 0 1
5 0 0 1
6 1 0 0
attr(,"assign")
[1] 1 1 1
attr(,"contrasts")
attr(,"contrasts")$breed
[1] "contr.treatment"cat("Rank:", qr(X_cell)$rank, "\n")Rank: 3 cat("Dimensions:", nrow(X_cell), "×", ncol(X_cell), "\n")Dimensions: 6 × 3 cat("Full column rank?", qr(X_cell)$rank == ncol(X_cell), "\n\n")Full column rank? TRUE # Effects model (overparameterized, not full rank)
X_effects <- model.matrix(~ breed)
cat("Effects Model Design Matrix:\n")Effects Model Design Matrix:print(X_effects) (Intercept) breedMerino breedSuffolk
1 1 1 0
2 1 1 0
3 1 1 0
4 1 0 1
5 1 0 1
6 1 0 0
attr(,"assign")
[1] 0 1 1
attr(,"contrasts")
attr(,"contrasts")$breed
[1] "contr.treatment"cat("Rank:", qr(X_effects)$rank, "\n")Rank: 3 cat("Dimensions:", nrow(X_effects), "×", ncol(X_effects), "\n")Dimensions: 6 × 3 cat("Full column rank?", qr(X_effects)$rank == ncol(X_effects), "\n")Full column rank? TRUE cat("Rank deficient by:", ncol(X_effects) - qr(X_effects)$rank, "\n\n")Rank deficient by: 0 # Verify X'X has same rank as X
XtX_cell <- t(X_cell) %*% X_cell
XtX_effects <- t(X_effects) %*% X_effects
cat("Rank verification:\n")Rank verification:cat("X (cell means): rank =", qr(X_cell)$rank, "\n")X (cell means): rank = 3 cat("X'X (cell means): rank =", qr(XtX_cell)$rank, "\n")X'X (cell means): rank = 3 cat("Agreement:", qr(X_cell)$rank == qr(XtX_cell)$rank, "\n\n")Agreement: TRUE cat("X (effects): rank =", qr(X_effects)$rank, "\n")X (effects): rank = 3 cat("X'X (effects): rank =", qr(XtX_effects)$rank, "\n")X'X (effects): rank = 3 cat("Agreement:", qr(X_effects)$rank == qr(XtX_effects)$rank, "\n")Agreement: TRUE Implications for Estimability
When X is rank deficient:
- X’Xb = X’y has infinitely many solutions
- Individual parameters \(\beta_j\) are not uniquely estimable
- But linear combinations \(\mathbf{c}'\boldsymbol{\beta}\) may still be estimable if c is in the row space of X
Example: In effects model μ + α₁ + α₂ + α₃ with \(\sum \alpha_i = 0\) constraint: - μ is not uniquely estimable (confounded with αᵢ) - Individual αᵢ are not uniquely estimable - Contrasts α₁ - α₂ are uniquely estimable
NoteCross-References
- Week 2: Linear Algebra Essentials - Introduction to rank
- Week 7: One-Way ANOVA - Full rank cell means vs. rank deficient effects model
- Week 8: Contrasts and Estimable Functions - What’s estimable when rank deficient
- Week 12: Non-Full Rank Models - Complete treatment of rank deficiency
16.4.2 Trace
The trace of a square matrix is the sum of its diagonal elements. It has elegant properties that make it useful in linear models.
Definition
For an n × n matrix A:
\[ \text{tr}(\mathbf{A}) = \sum_{i=1}^n a_{ii} \tag{16.13}\]
The trace is a scalar (single number).
Properties
1. Linearity
\[ \text{tr}(\mathbf{A} + \mathbf{B}) = \text{tr}(\mathbf{A}) + \text{tr}(\mathbf{B}) \]
\[ \text{tr}(c\mathbf{A}) = c \cdot \text{tr}(\mathbf{A}) \]
2. Cyclic Property (Most Important!)
\[ \text{tr}(\mathbf{ABC}) = \text{tr}(\mathbf{BCA}) = \text{tr}(\mathbf{CAB}) \tag{16.14}\]
Special cases: - \(\text{tr}(\mathbf{AB}) = \text{tr}(\mathbf{BA})\) (even if AB ≠ BA) - \(\text{tr}(\mathbf{A}'\mathbf{A}) = \text{tr}(\mathbf{A}\mathbf{A}') = \sum_{i,j} a_{ij}^2\) (sum of all squared elements)
3. Trace of Transpose
\[ \text{tr}(\mathbf{A}') = \text{tr}(\mathbf{A}) \]
4. Trace and Eigenvalues
\[ \text{tr}(\mathbf{A}) = \sum_{i=1}^n \lambda_i \tag{16.15}\]
where λᵢ are the eigenvalues of A (including multiplicities).
5. Trace of Idempotent Matrix
For an idempotent matrix P (where P² = P):
\[ \text{tr}(\mathbf{P}) = \text{rank}(\mathbf{P}) \tag{16.16}\]
This is crucial for projection matrices!
Proof: Since P is idempotent, its eigenvalues are 0 or 1. If P has rank r, then r eigenvalues equal 1 and n - r equal 0. Therefore: \[ \text{tr}(\mathbf{P}) = \sum \lambda_i = r \cdot 1 + (n-r) \cdot 0 = r = \text{rank}(\mathbf{P}) \]
Applications in Linear Models
1. Degrees of Freedom
For hat matrix \(\mathbf{H} = \mathbf{X}(\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}'\):
\[ \text{tr}(\mathbf{H}) = p \]
where p = rank(X) = number of parameters.
This is the model degrees of freedom.
For residual projection \(\mathbf{I} - \mathbf{H}\):
\[ \text{tr}(\mathbf{I} - \mathbf{H}) = n - p \]
This is the error degrees of freedom.
2. Sum of Squared Elements
\[ \text{tr}(\mathbf{A}'\mathbf{A}) = \sum_{i=1}^m \sum_{j=1}^n a_{ij}^2 = ||\mathbf{A}||_F^2 \]
This is the squared Frobenius norm of A.
3. Quadratic Forms
For any matrices A (n × n) and B (n × n):
\[ \text{tr}(\mathbf{AB}) = \text{tr}(\mathbf{BA}) \]
Special case: If y is n × 1 and A is n × n:
\[ \mathbf{y}'\mathbf{A}\mathbf{y} = \text{tr}(\mathbf{A}\mathbf{y}\mathbf{y}') \tag{16.17}\]
This connects quadratic forms to traces.
R Examples
# Define trace function (R doesn't have built-in)
tr <- function(A) sum(diag(A))
# Example 1: Basic trace
A <- matrix(c(1, 2, 3, 4), 2, 2)
cat("Matrix A:\n")Matrix A:print(A) [,1] [,2]
[1,] 1 3
[2,] 2 4cat("Trace:", tr(A), "= 1 + 4 =", 1 + 4, "\n\n")Trace: 5 = 1 + 4 = 5 # Example 2: Cyclic property tr(AB) = tr(BA)
B <- matrix(c(5, 6, 7, 8), 2, 2)
AB <- A %*% B
BA <- B %*% A
cat("Cyclic property:\n")Cyclic property:cat("tr(AB) =", tr(AB), "\n")tr(AB) = 69 cat("tr(BA) =", tr(BA), "\n")tr(BA) = 69 cat("Equal?", all.equal(tr(AB), tr(BA)), "\n")Equal? TRUE cat("But AB ≠ BA:\n")But AB ≠ BA:cat("AB =\n")AB =print(AB) [,1] [,2]
[1,] 23 31
[2,] 34 46cat("BA =\n")BA =print(BA) [,1] [,2]
[1,] 19 43
[2,] 22 50cat("\n")# Example 3: Trace of A'A = sum of squared elements
cat("tr(A'A) = sum of all squared elements:\n")tr(A'A) = sum of all squared elements:cat("tr(A'A) =", tr(t(A) %*% A), "\n")tr(A'A) = 30 cat("Sum of squared elements =", sum(A^2), "\n")Sum of squared elements = 30 cat("Agreement:", all.equal(tr(t(A) %*% A), sum(A^2)), "\n\n")Agreement: TRUE # Example 4: Trace of idempotent matrix = rank
# Use projection matrix from earlier
X <- cbind(1, c(1, 2, 3, 4, 5)) # 5x2 design matrix
H <- X %*% solve(t(X) %*% X) %*% t(X)
cat("Projection matrix H:\n")Projection matrix H:cat("Trace(H) =", tr(H), "\n")Trace(H) = 2 cat("Rank(H) =", qr(H)$rank, "\n")Rank(H) = 2 cat("Number of parameters p =", ncol(X), "\n")Number of parameters p = 2 cat("All equal?", all.equal(tr(H), qr(H)$rank), "\n")All equal? TRUE Livestock Example: Degrees of Freedom
# Beef cattle: ADG for 10 steers, 2 breeds (5 per breed)
adg <- c(1.2, 1.3, 1.1, 1.4, 1.2, # Angus
1.0, 1.1, 0.9, 1.2, 1.0) # Hereford
breed <- factor(rep(c("Angus", "Hereford"), each = 5))
# Design matrix (cell means model)
X <- model.matrix(~ breed - 1)
n <- nrow(X)
p <- ncol(X)
# Compute projection matrices
H <- X %*% solve(t(X) %*% X) %*% t(X)
I_minus_H <- diag(n) - H
cat("Sample size n =", n, "\n")Sample size n = 10 cat("Number of parameters p =", p, "\n\n")Number of parameters p = 2 cat("Model degrees of freedom:\n")Model degrees of freedom:cat(" tr(H) =", tr(H), "\n") tr(H) = 2 cat(" rank(H) =", qr(H)$rank, "\n") rank(H) = 2 cat(" p =", p, "\n\n") p = 2 cat("Error degrees of freedom:\n")Error degrees of freedom:cat(" tr(I - H) =", tr(I_minus_H), "\n") tr(I - H) = 8 cat(" rank(I - H) =", qr(I_minus_H)$rank, "\n") rank(I - H) = 8 cat(" n - p =", n - p, "\n\n") n - p = 8 cat("Verification: tr(H) + tr(I-H) = n\n")Verification: tr(H) + tr(I-H) = ncat(" ", tr(H), "+", tr(I_minus_H), "=", tr(H) + tr(I_minus_H), "\n") 2 + 8 = 10 cat(" n =", n, "\n") n = 10
NoteCross-References
- Week 2: Linear Algebra Essentials - Introduction to trace
- Week 5: Least Squares Theory - Uses tr(H) = p for degrees of freedom
- Week 6: Multiple Regression - Degrees of freedom in ANOVA tables
- Week 11: Model Diagnostics - Leverage as diagonal elements of H
16.4.3 Determinant
The determinant is a scalar value computed from a square matrix that provides information about invertibility, volume scaling, and system solvability.
Definition
For a square n × n matrix A, the determinant det(A) or |A| is defined recursively:
1 × 1 matrix: det([a]) = a
2 × 2 matrix: \[ \det\begin{pmatrix} a & b \\ c & d \end{pmatrix} = ad - bc \tag{16.18}\]
n × n matrix: Using cofactor expansion along row i: \[ \det(\mathbf{A}) = \sum_{j=1}^n (-1)^{i+j} a_{ij} M_{ij} \]
where \(M_{ij}\) is the minor (determinant of (n-1) × (n-1) submatrix obtained by deleting row i and column j).
Properties
1. Invertibility
\[ \det(\mathbf{A}) \neq 0 \iff \mathbf{A} \text{ is invertible} \tag{16.19}\]
\[ \det(\mathbf{A}) = 0 \iff \mathbf{A} \text{ is singular} \]
2. Product Rule
\[ \det(\mathbf{AB}) = \det(\mathbf{A}) \cdot \det(\mathbf{B}) \tag{16.20}\]
3. Inverse
\[ \det(\mathbf{A}^{-1}) = \frac{1}{\det(\mathbf{A})} \tag{16.21}\]
4. Transpose
\[ \det(\mathbf{A}') = \det(\mathbf{A}) \]
5. Scalar Multiplication
For n × n matrix: \[ \det(c\mathbf{A}) = c^n \det(\mathbf{A}) \tag{16.22}\]
6. Determinant and Eigenvalues
\[ \det(\mathbf{A}) = \prod_{i=1}^n \lambda_i \tag{16.23}\]
where λᵢ are the eigenvalues.
7. Geometric Interpretation
|det(A)| is the volume (or area in 2D) of the parallelepiped formed by the column vectors of A.
If det(A) < 0, the transformation reverses orientation.
Computing Determinants in R
# Example 1: 2x2 matrix
A_2x2 <- matrix(c(3, 1, 2, 4), 2, 2)
cat("2×2 Matrix A:\n")2×2 Matrix A:print(A_2x2) [,1] [,2]
[1,] 3 2
[2,] 1 4cat("det(A) =", det(A_2x2), "\n")det(A) = 10 cat("Manual: (3)(4) - (1)(2) =", 3*4 - 1*2, "\n\n")Manual: (3)(4) - (1)(2) = 10 # Example 2: Singular matrix (det = 0)
A_sing <- matrix(c(1, 2, 2, 4), 2, 2) # Row 2 = 2 * Row 1
cat("Singular Matrix (row 2 = 2*row 1):\n")Singular Matrix (row 2 = 2*row 1):print(A_sing) [,1] [,2]
[1,] 1 2
[2,] 2 4cat("det(A) =", det(A_sing), "\n")det(A) = 0 cat("Is singular?", abs(det(A_sing)) < 1e-10, "\n\n")Is singular? TRUE # Example 3: Product rule
B_2x2 <- matrix(c(1, 3, 2, 1), 2, 2)
cat("Product rule: det(AB) = det(A) * det(B)\n")Product rule: det(AB) = det(A) * det(B)cat("det(A) =", det(A_2x2), "\n")det(A) = 10 cat("det(B) =", det(B_2x2), "\n")det(B) = -5 cat("det(A) * det(B) =", det(A_2x2) * det(B_2x2), "\n")det(A) * det(B) = -50 cat("det(AB) =", det(A_2x2 %*% B_2x2), "\n")det(AB) = -50 cat("Agreement:", all.equal(det(A_2x2) * det(B_2x2),
det(A_2x2 %*% B_2x2)), "\n\n")Agreement: TRUE # Example 4: Inverse rule
cat("Inverse rule: det(A^{-1}) = 1/det(A)\n")Inverse rule: det(A^{-1}) = 1/det(A)A_inv <- solve(A_2x2)
cat("det(A) =", det(A_2x2), "\n")det(A) = 10 cat("1/det(A) =", 1/det(A_2x2), "\n")1/det(A) = 0.1 cat("det(A^{-1}) =", det(A_inv), "\n")det(A^{-1}) = 0.1 cat("Agreement:", all.equal(1/det(A_2x2), det(A_inv)), "\n")Agreement: TRUE Application: Testing Rank Deficiency
# Create rank-deficient design matrix (overparameterized ANOVA)
treatment <- factor(rep(1:3, each = 3))
X_full <- model.matrix(~ treatment) # Intercept + 2 treatment effects
cat("Full effects model design matrix:\n")Full effects model design matrix:print(X_full) (Intercept) treatment2 treatment3
1 1 0 0
2 1 0 0
3 1 0 0
4 1 1 0
5 1 1 0
6 1 1 0
7 1 0 1
8 1 0 1
9 1 0 1
attr(,"assign")
[1] 0 1 1
attr(,"contrasts")
attr(,"contrasts")$treatment
[1] "contr.treatment"cat("Rank:", qr(X_full)$rank, "\n")Rank: 3 cat("Columns:", ncol(X_full), "\n")Columns: 3 cat("Rank deficient?", qr(X_full)$rank < ncol(X_full), "\n\n")Rank deficient? FALSE # Compute X'X
XtX <- t(X_full) %*% X_full
cat("X'X:\n")X'X:print(XtX) (Intercept) treatment2 treatment3
(Intercept) 9 3 3
treatment2 3 3 0
treatment3 3 0 3cat("det(X'X) =", det(XtX), "\n")det(X'X) = 27 cat("Is X'X singular?", abs(det(XtX)) < 1e-10, "\n\n")Is X'X singular? FALSE # Compare with full rank (cell means model)
X_cell <- model.matrix(~ treatment - 1)
XtX_cell <- t(X_cell) %*% X_cell
cat("Cell means model:\n")Cell means model:cat("X'X:\n")X'X:print(XtX_cell) treatment1 treatment2 treatment3
treatment1 3 0 0
treatment2 0 3 0
treatment3 0 0 3cat("det(X'X) =", det(XtX_cell), "\n")det(X'X) = 27 cat("Is X'X invertible?", abs(det(XtX_cell)) > 1e-10, "\n")Is X'X invertible? TRUE Livestock Example: Checking Invertibility
# Swine growth: 6 pigs, measure weight at 3 time points
# Question: Can we fit polynomial growth curve?
pig_id <- rep(1:6, each = 3)
age_days <- rep(c(30, 60, 90), 6)
weight <- c(15, 35, 60, # Pig 1
14, 33, 58, # Pig 2
16, 36, 62, # Pig 3
15, 34, 59, # Pig 4
14, 35, 61, # Pig 5
16, 37, 63) # Pig 6
# Try to fit quadratic model: weight ~ age + age²
# Design matrix for one pig's data
age_one_pig <- c(30, 60, 90)
X_quad <- cbind(1, age_one_pig, age_one_pig^2)
cat("Quadratic model design matrix (one pig):\n")Quadratic model design matrix (one pig):print(X_quad) age_one_pig
[1,] 1 30 900
[2,] 1 60 3600
[3,] 1 90 8100cat("Rank:", qr(X_quad)$rank, "\n")Rank: 3 cat("Dimensions:", nrow(X_quad), "×", ncol(X_quad), "\n\n")Dimensions: 3 × 3 cat("Can we fit quadratic (3 parameters) with 3 observations?\n")Can we fit quadratic (3 parameters) with 3 observations?XtX_quad <- t(X_quad) %*% X_quad
cat("X'X:\n")X'X:print(XtX_quad) age_one_pig
3 180 12600
age_one_pig 180 12600 972000
12600 972000 79380000cat("det(X'X) =", det(XtX_quad), "\n")det(X'X) = 2.916e+09 cat("Is X'X invertible?", abs(det(XtX_quad)) > 1e-10, "\n")Is X'X invertible? TRUE cat("\nYes! Exactly identified (3 parameters, 3 observations)\n")
Yes! Exactly identified (3 parameters, 3 observations)# What about cubic?
X_cubic <- cbind(X_quad, age_one_pig^3)
cat("\nCubic model (4 parameters) with 3 observations:\n")
Cubic model (4 parameters) with 3 observations:cat("Rank:", qr(X_cubic)$rank, "\n")Rank: 3 cat("Dimensions:", nrow(X_cubic), "×", ncol(X_cubic), "\n")Dimensions: 3 × 4 cat("Can estimate 4 parameters with 3 observations? No - rank deficient\n")Can estimate 4 parameters with 3 observations? No - rank deficient
WarningNumerical Issues
For large matrices or nearly singular matrices, computed determinants can be unreliable due to:
- Overflow/underflow: det(A) can be extremely large or small
- Rounding errors: Near-zero determinants may not be exactly zero
Better approaches: - Use rank to check singularity: qr(A)$rank < ncol(A) - Use condition number to check “near singularity”: kappa(A) - Don’t use det() for large matrices (computational cost is O(n³))
NoteCross-References
- Week 2: Linear Algebra Essentials - Introduction to determinants
- Week 12: Non-Full Rank Models - Determinant zero for rank-deficient X’X
- Week 14: Computational Considerations - Numerical stability issues
ImportantSummary: Matrix Properties
Rank: Determines uniqueness of solutions - r(X’X) = r(X) - fundamental result - Full rank → unique least squares solution - Rank deficient → need constraints or estimable functions
Trace: Sum of diagonal elements - tr(H) = p (model degrees of freedom) - tr(I - H) = n - p (error degrees of freedom) - tr(P) = rank(P) for idempotent P
Determinant: Tests invertibility - det(X’X) ≠ 0 → X’X invertible - det(X’X) = 0 → rank deficient - Use rank for numerical stability
16.5 Matrix Inverses
Matrix inverses are fundamental for solving linear systems, including the normal equations in linear models. When X is rank deficient, we need generalized inverses.
16.5.1 Regular Inverse
The regular inverse (or simply “inverse”) of a matrix exists only for square, full-rank matrices.
Definition
For a square n × n matrix A, the inverse A⁻¹ (if it exists) satisfies:
\[ \mathbf{A}\mathbf{A}^{-1} = \mathbf{A}^{-1}\mathbf{A} = \mathbf{I} \tag{16.24}\]
Existence conditions: - A must be square (n × n) - A must be full rank (rank n) - Equivalently: det(A) ≠ 0
Properties
1. Uniqueness: If A⁻¹ exists, it is unique
2. Reverse order: \[ (\mathbf{AB})^{-1} = \mathbf{B}^{-1}\mathbf{A}^{-1} \tag{16.25}\]
3. Transpose: \[ (\mathbf{A}')^{-1} = (\mathbf{A}^{-1})' \tag{16.26}\]
4. Inverse of inverse: \[ (\mathbf{A}^{-1})^{-1} = \mathbf{A} \]
5. Scalar multiplication: \[ (c\mathbf{A})^{-1} = \frac{1}{c}\mathbf{A}^{-1}, \quad c \neq 0 \]
Formula for 2 × 2 Matrix
For quick reference: \[ \begin{pmatrix} a & b \\ c & d \end{pmatrix}^{-1} = \frac{1}{ad-bc} \begin{pmatrix} d & -b \\ -c & a \end{pmatrix} \tag{16.27}\]
provided \(ad - bc \neq 0\) (determinant is non-zero).
Computing Inverses in R
# Example 1: 2x2 matrix
A <- matrix(c(3, 1, 2, 4), 2, 2)
cat("Matrix A:\n")Matrix A:print(A) [,1] [,2]
[1,] 3 2
[2,] 1 4# Compute inverse
A_inv <- solve(A)
cat("\nA inverse:\n")
A inverse:print(A_inv) [,1] [,2]
[1,] 0.4 -0.2
[2,] -0.1 0.3# Verify AA^{-1} = I
I_check <- A %*% A_inv
cat("\nA * A^{-1} =\n")
A * A^{-1} =print(round(I_check, 10)) [,1] [,2]
[1,] 1 0
[2,] 0 1cat("\nIs identity?", all.equal(I_check, diag(2)), "\n\n")
Is identity? TRUE # Example 2: Verify manual 2x2 formula
det_A <- det(A)
A_inv_manual <- (1/det_A) * matrix(c(4, -1, -2, 3), 2, 2)
cat("Manual 2x2 inverse formula:\n")Manual 2x2 inverse formula:print(A_inv_manual) [,1] [,2]
[1,] 0.4 -0.2
[2,] -0.1 0.3cat("Agreement with solve():", all.equal(A_inv, A_inv_manual), "\n\n")Agreement with solve(): TRUE # Example 3: Transpose property (A')^{-1} = (A^{-1})'
At_inv <- solve(t(A))
Ainv_t <- t(A_inv)
cat("Transpose property:\n")Transpose property:cat("(A')^{-1} = (A^{-1})'?\n")(A')^{-1} = (A^{-1})'?cat(all.equal(At_inv, Ainv_t), "\n")TRUE Application: Solving Normal Equations
When X is full rank, the normal equations \(\mathbf{X}'\mathbf{X}\mathbf{b} = \mathbf{X}'\mathbf{y}\) have unique solution:
\[ \mathbf{b} = (\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}'\mathbf{y} \tag{16.28}\]
# Simple regression example
x <- c(1, 2, 3, 4, 5)
y <- c(2.1, 3.9, 6.2, 7.8, 10.1)
# Design matrix
X <- cbind(1, x)
cat("Design matrix X:\n")Design matrix X:print(X) x
[1,] 1 1
[2,] 1 2
[3,] 1 3
[4,] 1 4
[5,] 1 5cat("Rank:", qr(X)$rank, "Columns:", ncol(X), "\n")Rank: 2 Columns: 2 cat("Full rank?", qr(X)$rank == ncol(X), "\n\n")Full rank? TRUE # Normal equations: X'Xb = X'y
XtX <- t(X) %*% X
Xty <- t(X) %*% y
cat("X'X:\n")X'X:print(XtX) x
5 15
x 15 55cat("det(X'X) =", det(XtX), "\n")det(X'X) = 50 cat("Is X'X invertible?", abs(det(XtX)) > 1e-10, "\n\n")Is X'X invertible? TRUE # Solve using inverse
XtX_inv <- solve(XtX)
b <- XtX_inv %*% Xty
cat("Solution b = (X'X)^{-1}X'y:\n")Solution b = (X'X)^{-1}X'y:print(b) [,1]
0.05
x 1.99# Verify with lm()
fit <- lm(y ~ x)
cat("\nComparison with lm():\n")
Comparison with lm():cat("Our b:", c(b), "\n")Our b: 0.05 1.99 cat("lm() coef:", coef(fit), "\n")lm() coef: 0.05 1.99
NoteCross-References
- Week 2: Linear Algebra Essentials - Introduction to matrix inverses
- Week 4-6: Regression - Uses (X’X)⁻¹ throughout
- Week 5: Least Squares - Derives b = (X’X)⁻¹X’y
16.5.2 Generalized Inverse
When a matrix is not square or not full rank, the regular inverse doesn’t exist. Generalized inverses extend the concept of inversion to such matrices.
Definition: Reflexive Generalized Inverse
A matrix A⁻ is a generalized inverse (or g-inverse) of A if:
\[ \mathbf{A}\mathbf{A}^{-}\mathbf{A} = \mathbf{A} \tag{16.29}\]
Key properties: - A⁻ is not unique (many g-inverses exist) - If A is square and invertible, then A⁻ = A⁻¹ (unique) - Works for any m × n matrix A (doesn’t need to be square)
Moore-Penrose Inverse
The Moore-Penrose inverse A⁺ is a unique generalized inverse satisfying four conditions:
- \(\mathbf{A}\mathbf{A}^{+}\mathbf{A} = \mathbf{A}\) (reflexive)
- \(\mathbf{A}^{+}\mathbf{A}\mathbf{A}^{+} = \mathbf{A}^{+}\) (reflexive for A⁺)
- \((\mathbf{A}\mathbf{A}^{+})' = \mathbf{A}\mathbf{A}^{+}\) (symmetric)
- \((\mathbf{A}^{+}\mathbf{A})' = \mathbf{A}^{+}\mathbf{A}\) (symmetric)
A⁺ is the unique matrix satisfying all four conditions.
Computing Generalized Inverses
Method 1: Using SVD (Most Stable)
If \(\mathbf{A} = \mathbf{U}\mathbf{D}\mathbf{V}'\) is the singular value decomposition, then:
\[ \mathbf{A}^{+} = \mathbf{V}\mathbf{D}^{+}\mathbf{U}' \tag{16.30}\]
where D⁺ is formed by taking reciprocals of non-zero diagonal elements of D and transposing.
Method 2: Using ginv() from MASS package
library(MASS)
A_ginv <- ginv(A)Properties of Generalized Inverses
1. Not unique (except Moore-Penrose):
Different g-inverses give different solutions to Ax = b, BUT:
2. Estimable functions are unique:
If \(\mathbf{c}'\boldsymbol{\beta}\) is estimable (i.e., c’ is in row space of X), then \(\mathbf{c}'\mathbf{b}\) is the same for all g-inverses used to compute b = (X’X)⁻X’y.
This is crucial for rank-deficient models!
3. For symmetric A: - (A⁻)’ is also a g-inverse of A - AA⁻ and A⁻A are symmetric and idempotent (projection matrices)
R Examples
library(MASS)
# Example 1: Rank-deficient matrix
A_rd <- matrix(c(1, 2, 3,
2, 4, 6,
1, 1, 1), 3, 3, byrow = TRUE)
cat("Rank-deficient matrix A:\n")Rank-deficient matrix A:print(A_rd) [,1] [,2] [,3]
[1,] 1 2 3
[2,] 2 4 6
[3,] 1 1 1cat("Rank:", qr(A_rd)$rank, "\n")Rank: 2 cat("Dimensions: 3 x 3\n")Dimensions: 3 x 3cat("det(A) =", det(A_rd), "\n\n")det(A) = 0 # Try regular inverse (will fail)
cat("Attempting regular inverse...\n")Attempting regular inverse...tryCatch({
A_rd_inv <- solve(A_rd)
cat("Success!\n")
}, error = function(e) {
cat("Error:", conditionMessage(e), "\n")
})Error: Lapack routine dgesv: system is exactly singular: U[3,3] = 0 # Compute generalized inverse
A_rd_ginv <- ginv(A_rd)
cat("\nGeneralized inverse A^-:\n")
Generalized inverse A^-:print(round(A_rd_ginv, 4)) [,1] [,2] [,3]
[1,] -0.1 -0.2 1.3333
[2,] 0.0 0.0 0.3333
[3,] 0.1 0.2 -0.6667# Verify AA^-A = A
AAminusA <- A_rd %*% A_rd_ginv %*% A_rd
cat("\nVerify AA^-A = A:\n")
Verify AA^-A = A:cat("Max difference:", max(abs(AAminusA - A_rd)), "\n")Max difference: 4.441e-15 cat("Agreement:", all.equal(AAminusA, A_rd), "\n")Agreement: TRUE Application: Non-Full Rank Design Matrix
# Three-breed ANOVA with cell means model
breed <- factor(rep(c("A", "B", "C"), each = 3))
y <- c(10, 11, 12, # Breed A
15, 16, 14, # Breed B
18, 19, 20) # Breed C
# Cell means model: y = μ_breed + e (one mean per breed)
X <- model.matrix(~ breed - 1) # -1 removes intercept
cat("Design matrix (cell means model):\n")Design matrix (cell means model):print(X) breedA breedB breedC
1 1 0 0
2 1 0 0
3 1 0 0
4 0 1 0
5 0 1 0
6 0 1 0
7 0 0 1
8 0 0 1
9 0 0 1
attr(,"assign")
[1] 1 1 1
attr(,"contrasts")
attr(,"contrasts")$breed
[1] "contr.treatment"cat("Rank:", qr(X)$rank, "\n")Rank: 3 cat("Columns:", ncol(X), "\n")Columns: 3 cat("Full rank?", qr(X)$rank == ncol(X), "\n\n")Full rank? TRUE # Compute X'X (will be full rank for cell means model)
XtX <- t(X) %*% X
cat("X'X:\n")X'X:print(XtX) breedA breedB breedC
breedA 3 0 0
breedB 0 3 0
breedC 0 0 3cat("det(X'X) =", det(XtX), "\n")det(X'X) = 27 cat("Is invertible?", abs(det(XtX)) > 1e-10, "\n\n")Is invertible? TRUE # Solve for breed means
XtX_inv <- solve(XtX)
Xty <- t(X) %*% y
b <- XtX_inv %*% Xty
cat("Breed means (μ_A, μ_B, μ_C):\n")Breed means (μ_A, μ_B, μ_C):print(b) [,1]
breedA 11
breedB 15
breedC 19# Contrasts are directly estimable
# Contrast: μ_A - μ_B (breed A vs breed B)
contrast <- c(1, -1, 0) # μ_A - μ_B
contrast_estimate <- t(contrast) %*% b
cat("\nContrast μ_A - μ_B =", c(contrast_estimate), "\n")
Contrast μ_A - μ_B = -4 # Verify this equals difference in breed means
mean_A <- mean(y[breed == "A"])
mean_B <- mean(y[breed == "B"])
cat("Direct calculation:", mean_A - mean_B, "\n")Direct calculation: -4 cat("Agreement:", all.equal(c(contrast_estimate), mean_A - mean_B), "\n")Agreement: TRUE Computing Moore-Penrose via SVD
# Demonstrate computing Moore-Penrose inverse manually
A <- matrix(c(1, 2, 2, 4), 2, 2) # Rank 1 matrix
cat("Matrix A (rank deficient):\n")Matrix A (rank deficient):print(A) [,1] [,2]
[1,] 1 2
[2,] 2 4cat("Rank:", qr(A)$rank, "\n\n")Rank: 1 # Compute SVD
svd_A <- svd(A)
U <- svd_A$u
D_diag <- svd_A$d
V <- svd_A$v
cat("Singular values:", D_diag, "\n")Singular values: 5 1.986e-16 cat("Number of non-zero singular values:", sum(D_diag > 1e-10), "\n\n")Number of non-zero singular values: 1 # Create D^+ (reciprocals of non-zero singular values)
D_plus_diag <- ifelse(D_diag > 1e-10, 1/D_diag, 0)
D_plus <- diag(D_plus_diag)
# A^+ = V D^+ U'
A_plus_manual <- V %*% D_plus %*% t(U)
cat("Moore-Penrose inverse (manual via SVD):\n")Moore-Penrose inverse (manual via SVD):print(round(A_plus_manual, 6)) [,1] [,2]
[1,] 0.04 0.08
[2,] 0.08 0.16# Compare with ginv()
A_plus_ginv <- ginv(A)
cat("\nMoore-Penrose inverse (ginv):\n")
Moore-Penrose inverse (ginv):print(round(A_plus_ginv, 6)) [,1] [,2]
[1,] 0.04 0.08
[2,] 0.08 0.16cat("\nAgreement:", all.equal(A_plus_manual, A_plus_ginv, tolerance = 1e-6), "\n")
Agreement: TRUE # Verify four Moore-Penrose conditions
cat("\n Verifying four Moore-Penrose conditions:\n")
Verifying four Moore-Penrose conditions:cat("1. AA^+A = A?", all.equal(A %*% A_plus_ginv %*% A, A), "\n")1. AA^+A = A? TRUE cat("2. A^+AA^+ = A^+?", all.equal(A_plus_ginv %*% A %*% A_plus_ginv, A_plus_ginv), "\n")2. A^+AA^+ = A^+? TRUE cat("3. (AA^+)' = AA^+?", all.equal(t(A %*% A_plus_ginv), A %*% A_plus_ginv), "\n")3. (AA^+)' = AA^+? TRUE cat("4. (A^+A)' = A^+A?", all.equal(t(A_plus_ginv %*% A), A_plus_ginv %*% A), "\n")4. (A^+A)' = A^+A? TRUE
ImportantKey Insight: Estimability
When using generalized inverses for rank-deficient X:
- Non-estimable functions: \(\mathbf{c}'\mathbf{b}\) depends on which g-inverse is used
- Estimable functions: \(\mathbf{c}'\mathbf{b}\) is unique regardless of g-inverse
Example: In effects model μ + αᵢ: - μ alone: NOT estimable (changes with g-inverse) - αᵢ alone: NOT estimable - αᵢ - αⱼ: ESTIMABLE (unique across all g-inverses)
This is why we focus on contrasts in Week 8!
NoteCross-References
- Week 2: Linear Algebra Essentials - Introduction to generalized inverses
- Week 8: Contrasts and Estimable Functions - Which functions are estimable
- Week 12: Non-Full Rank Models - Extensive use of g-inverses
- Week 13: Special Topics I - Different g-inverse choices
16.5.3 Useful Inverse Identities
Several matrix identities make working with inverses more efficient, especially for structured matrices.
Woodbury Matrix Identity
Also called matrix inversion lemma:
\[ (\mathbf{A} + \mathbf{UCV})^{-1} = \mathbf{A}^{-1} - \mathbf{A}^{-1}\mathbf{U}(\mathbf{C}^{-1} + \mathbf{V}\mathbf{A}^{-1}\mathbf{U})^{-1}\mathbf{V}\mathbf{A}^{-1} \tag{16.31}\]
Special cases:
Sherman-Morrison Formula (rank-1 update):
If A is n × n invertible and u, v are n × 1 vectors:
\[ (\mathbf{A} + \mathbf{uv}')^{-1} = \mathbf{A}^{-1} - \frac{\mathbf{A}^{-1}\mathbf{uv}'\mathbf{A}^{-1}}{1 + \mathbf{v}'\mathbf{A}^{-1}\mathbf{u}} \tag{16.32}\]
This is useful when updating an inverse after a rank-1 change.
Block Matrix Inversion
For a block matrix: \[ \mathbf{M} = \begin{pmatrix} \mathbf{A} & \mathbf{B} \\ \mathbf{C} & \mathbf{D} \end{pmatrix} \]
If A and \(\mathbf{D} - \mathbf{CA}^{-1}\mathbf{B}\) (the Schur complement) are invertible:
\[ \mathbf{M}^{-1} = \begin{pmatrix} \mathbf{A}^{-1} + \mathbf{A}^{-1}\mathbf{B}\mathbf{S}^{-1}\mathbf{CA}^{-1} & -\mathbf{A}^{-1}\mathbf{B}\mathbf{S}^{-1} \\ -\mathbf{S}^{-1}\mathbf{CA}^{-1} & \mathbf{S}^{-1} \end{pmatrix} \tag{16.33}\]
where \(\mathbf{S} = \mathbf{D} - \mathbf{CA}^{-1}\mathbf{B}\) is the Schur complement.
Inverse of Sum
In general, \((\mathbf{A} + \mathbf{B})^{-1} \neq \mathbf{A}^{-1} + \mathbf{B}^{-1}\)
But if A and B commute (AB = BA): \[ (\mathbf{A} + \mathbf{B})^{-1}\mathbf{A} = \mathbf{A}(\mathbf{A} + \mathbf{B})^{-1} \]
R Examples
# Example 1: Sherman-Morrison formula
A <- matrix(c(4, 1, 1, 3), 2, 2)
u <- c(1, 2)
v <- c(3, 1)
cat("Sherman-Morrison Formula:\n")Sherman-Morrison Formula:cat("A =\n")A =print(A) [,1] [,2]
[1,] 4 1
[2,] 1 3cat("u =", u, "\n")u = 1 2 cat("v =", v, "\n\n")v = 3 1 # Direct computation
A_plus_uv <- A + u %*% t(v)
A_plus_uv_inv_direct <- solve(A_plus_uv)
cat("Direct: (A + uv')^{-1} =\n")Direct: (A + uv')^{-1} =print(round(A_plus_uv_inv_direct, 4)) [,1] [,2]
[1,] 0.2381 -0.0952
[2,] -0.3333 0.3333# Sherman-Morrison formula
A_inv <- solve(A)
numerator <- A_inv %*% u %*% t(v) %*% A_inv
denominator <- 1 + c(t(v) %*% A_inv %*% u)
A_plus_uv_inv_SM <- A_inv - numerator / denominator
cat("\nSherman-Morrison: (A + uv')^{-1} =\n")
Sherman-Morrison: (A + uv')^{-1} =print(round(A_plus_uv_inv_SM, 4)) [,1] [,2]
[1,] 0.2381 -0.0952
[2,] -0.3333 0.3333cat("\nAgreement:", all.equal(A_plus_uv_inv_direct, A_plus_uv_inv_SM), "\n")
Agreement: TRUE cat("\nComputational advantage: Don't need to invert (A + uv'),\n")
Computational advantage: Don't need to invert (A + uv'),cat("just use existing A^{-1} with vector operations\n")just use existing A^{-1} with vector operations# Example 2: Block matrix inversion
# Useful for partitioned models
A_block <- matrix(c(2, 0, 0, 3), 2, 2)
B_block <- matrix(c(1, 0, 0, 1), 2, 2)
C_block <- matrix(c(0, 1, 1, 0), 2, 2)
D_block <- matrix(c(4, 1, 1, 5), 2, 2)
M <- rbind(cbind(A_block, B_block),
cbind(C_block, D_block))
cat("Block matrix M:\n")Block matrix M:print(M) [,1] [,2] [,3] [,4]
[1,] 2 0 1 0
[2,] 0 3 0 1
[3,] 0 1 4 1
[4,] 1 0 1 5# Direct inversion
M_inv_direct <- solve(M)
cat("\nDirect M^{-1}:\n")
Direct M^{-1}:print(round(M_inv_direct, 4)) [,1] [,2] [,3] [,4]
[1,] 0.4915 0.0424 -0.1271 0.0169
[2,] 0.0339 0.3305 0.0085 -0.0678
[3,] 0.0169 -0.0847 0.2542 -0.0339
[4,] -0.1017 0.0085 -0.0254 0.2034# Block inversion formula
A_inv <- solve(A_block)
S <- D_block - C_block %*% A_inv %*% B_block # Schur complement
S_inv <- solve(S)
M11 <- A_inv + A_inv %*% B_block %*% S_inv %*% C_block %*% A_inv
M12 <- -A_inv %*% B_block %*% S_inv
M21 <- -S_inv %*% C_block %*% A_inv
M22 <- S_inv
M_inv_block <- rbind(cbind(M11, M12),
cbind(M21, M22))
cat("\nBlock formula M^{-1}:\n")
Block formula M^{-1}:print(round(M_inv_block, 4)) [,1] [,2] [,3] [,4]
[1,] 0.4915 0.0424 -0.1271 0.0169
[2,] 0.0339 0.3305 0.0085 -0.0678
[3,] 0.0169 -0.0847 0.2542 -0.0339
[4,] -0.1017 0.0085 -0.0254 0.2034cat("\nAgreement:", all.equal(M_inv_direct, M_inv_block), "\n")
Agreement: TRUE
TipWhen to Use These Identities
Sherman-Morrison: - Updating regression after adding one observation - Sequential estimation - Rank-1 modifications to covariance matrices
Woodbury: - Weighted least squares - Ridge regression - Kalman filtering
Block inversion: - Partitioned regression models - Testing subsets of parameters - Mixed models (Week 14 preview)
These identities can dramatically reduce computation when you have structure to exploit!
NoteCross-References
- Week 14: Special Topics II - Weighted least squares uses these identities
- Advanced mixed models courses - Block inversion for MME
ImportantSummary: Matrix Inverses
Regular Inverse: - Only for square, full-rank matrices - Unique: AA⁻¹ = A⁻¹A = I - R: solve(A)
Generalized Inverse: - For any matrix (rank deficient OK) - Not unique: AA⁻A = A - Moore-Penrose A⁺ is unique - R: ginv(A) from MASS - Key: Estimable functions are unique across all g-inverses
Identities: - Sherman-Morrison: Rank-1 updates - Woodbury: Low-rank updates - Block inversion: Partitioned matrices
16.6 Projection Matrices and Quadratic Forms
ImportantCritical Section
This section is foundational for understanding least squares theory in Week 5. It receives extra emphasis with additional examples and detailed coverage. The concepts here are central to all of linear models.
16.6.1 Projection Matrices
Projection matrices are fundamental to least squares theory. They provide the geometric interpretation of fitting linear models and decomposing variation into model and error components.
Definition
A projection matrix P is a square matrix satisfying:
\[ \mathbf{P}^2 = \mathbf{P} \tag{16.34}\]
This property is called idempotence. If additionally P is symmetric (\(\mathbf{P}' = \mathbf{P}\)), then P is an orthogonal projection matrix.
NoteGeometric Interpretation
An orthogonal projection matrix projects vectors onto a subspace and is “idempotent” because projecting twice is the same as projecting once - you’re already in the subspace after the first projection.
The Hat Matrix H
The most important projection matrix in linear models is the hat matrix:
\[ \mathbf{H} = \mathbf{X}(\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}' \tag{16.35}\]
where X is the n × p design matrix with full column rank (rank p).
Why “hat matrix”? Because it puts the “hat” on y:
\[ \hat{\mathbf{y}} = \mathbf{H}\mathbf{y} \tag{16.36}\]
where \(\hat{\mathbf{y}}\) is the vector of fitted values.
Properties of the Hat Matrix
The hat matrix H has several critical properties:
Symmetric: \(\mathbf{H}' = \mathbf{H}\)
Proof: \(\mathbf{H}' = [\mathbf{X}(\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}']' = \mathbf{X}[(\mathbf{X}'\mathbf{X})^{-1}]'\mathbf{X}' = \mathbf{X}(\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}' = \mathbf{H}\)
Idempotent: \(\mathbf{H}^2 = \mathbf{H}\)
Proof: \[\begin{align} \mathbf{H}^2 &= \mathbf{X}(\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}' \cdot \mathbf{X}(\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}' \\ &= \mathbf{X}(\mathbf{X}'\mathbf{X})^{-1}[\mathbf{X}'\mathbf{X}](\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}' \\ &= \mathbf{X}(\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}' = \mathbf{H} \end{align}\]
Rank and Trace: \(\text{rank}(\mathbf{H}) = \text{tr}(\mathbf{H}) = p\)
For idempotent matrices, rank equals trace. Since H projects onto the p-dimensional column space of X, its rank is p.
Eigenvalues: All eigenvalues of H are either 0 or 1
- p eigenvalues equal 1 (corresponding to column space of X)
- n - p eigenvalues equal 0 (corresponding to orthogonal complement)
Projects onto column space of X: \(\mathbf{H}\mathbf{X} = \mathbf{X}\)
Proof: \(\mathbf{H}\mathbf{X} = \mathbf{X}(\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}'\mathbf{X} = \mathbf{X}\)
The Residual Projection Matrix I - H
The complement of the hat matrix is equally important:
\[ \mathbf{I} - \mathbf{H} \tag{16.37}\]
This matrix projects onto the space orthogonal to the column space of X.
Properties of I - H:
Symmetric: \((\mathbf{I} - \mathbf{H})' = \mathbf{I} - \mathbf{H}\)
Idempotent: \((\mathbf{I} - \mathbf{H})^2 = \mathbf{I} - \mathbf{H}\)
Proof: \[\begin{align} (\mathbf{I} - \mathbf{H})^2 &= \mathbf{I} - 2\mathbf{H} + \mathbf{H}^2 \\ &= \mathbf{I} - 2\mathbf{H} + \mathbf{H} \\ &= \mathbf{I} - \mathbf{H} \end{align}\]
Rank and Trace: \(\text{rank}(\mathbf{I} - \mathbf{H}) = \text{tr}(\mathbf{I} - \mathbf{H}) = n - p\)
Produces residuals: \(\mathbf{e} = (\mathbf{I} - \mathbf{H})\mathbf{y}\)
Orthogonal to X: \((\mathbf{I} - \mathbf{H})\mathbf{X} = \mathbf{0}\)
Proof: \((\mathbf{I} - \mathbf{H})\mathbf{X} = \mathbf{X} - \mathbf{H}\mathbf{X} = \mathbf{X} - \mathbf{X} = \mathbf{0}\)
Orthogonality of H and I - H
A key relationship:
\[ \mathbf{H}(\mathbf{I} - \mathbf{H}) = \mathbf{0} \tag{16.38}\]
Proof: \[\begin{align} \mathbf{H}(\mathbf{I} - \mathbf{H}) &= \mathbf{H} - \mathbf{H}^2 \\ &= \mathbf{H} - \mathbf{H} = \mathbf{0} \end{align}\]
This shows that fitted values \(\hat{\mathbf{y}} = \mathbf{H}\mathbf{y}\) and residuals \(\mathbf{e} = (\mathbf{I} - \mathbf{H})\mathbf{y}\) are orthogonal:
\[ \hat{\mathbf{y}}'\mathbf{e} = (\mathbf{H}\mathbf{y})'[(\mathbf{I} - \mathbf{H})\mathbf{y}] = \mathbf{y}'\mathbf{H}'(\mathbf{I} - \mathbf{H})\mathbf{y} = 0 \tag{16.39}\]
Hat Values (Leverage)
The diagonal elements of H are called hat values or leverage values:
\[ h_{ii} = [\mathbf{H}]_{ii} \tag{16.40}\]
Properties: - \(0 \leq h_{ii} \leq 1\) for all i - \(\sum_{i=1}^n h_{ii} = \text{tr}(\mathbf{H}) = p\) - Average hat value: \(\bar{h} = p/n\)
Interpretation: \(h_{ii}\) measures the leverage or influence that observation i has on its own fitted value. High leverage points have the potential to strongly influence the regression.
Rule of thumb: Observations with \(h_{ii} > 2p/n\) or \(h_{ii} > 3p/n\) are considered high leverage.
NoteCross-Reference
Hat values are used extensively in Week 11: Model Diagnostics to identify influential observations.
R Implementation
# Example: Simple regression with 5 observations
# Dairy cow milk yield (kg/day) vs days in milk
days <- c(30, 60, 90, 120, 150)
yield <- c(28, 32, 30, 27, 24)
# Build design matrix
X <- cbind(1, days) # Intercept and slope
n <- nrow(X)
p <- ncol(X)
cat("Design matrix X:\n")Design matrix X:print(X) days
[1,] 1 30
[2,] 1 60
[3,] 1 90
[4,] 1 120
[5,] 1 150# Compute hat matrix H = X(X'X)^{-1}X'
XtX <- t(X) %*% X
XtX_inv <- solve(XtX)
H <- X %*% XtX_inv %*% t(X)
cat("\nHat matrix H:\n")
Hat matrix H:print(round(H, 4)) [,1] [,2] [,3] [,4] [,5]
[1,] 0.6 0.4 0.2 0.0 -0.2
[2,] 0.4 0.3 0.2 0.1 0.0
[3,] 0.2 0.2 0.2 0.2 0.2
[4,] 0.0 0.1 0.2 0.3 0.4
[5,] -0.2 0.0 0.2 0.4 0.6# Verify H is symmetric
cat("\nIs H symmetric?\n")
Is H symmetric?cat(all.equal(H, t(H)), "\n")TRUE # Verify H is idempotent (H^2 = H)
cat("\nIs H idempotent (H^2 = H)?\n")
Is H idempotent (H^2 = H)?H2 <- H %*% H
cat(all.equal(H, H2), "\n")TRUE # Check rank and trace
cat("\nRank of H:", qr(H)$rank, "\n")
Rank of H: 2 cat("Trace of H:", sum(diag(H)), "\n")Trace of H: 2 cat("Expected (p):", p, "\n")Expected (p): 2 # Compute I - H
I_minus_H <- diag(n) - H
cat("\nResidual projection matrix (I - H):\n")
Residual projection matrix (I - H):print(round(I_minus_H, 4)) [,1] [,2] [,3] [,4] [,5]
[1,] 0.4 -0.4 -0.2 0.0 0.2
[2,] -0.4 0.7 -0.2 -0.1 0.0
[3,] -0.2 -0.2 0.8 -0.2 -0.2
[4,] 0.0 -0.1 -0.2 0.7 -0.4
[5,] 0.2 0.0 -0.2 -0.4 0.4# Verify (I-H) is idempotent
I_minus_H2 <- I_minus_H %*% I_minus_H
cat("\nIs (I-H) idempotent?\n")
Is (I-H) idempotent?cat(all.equal(I_minus_H, I_minus_H2), "\n")TRUE # Check trace of I-H
cat("\nTrace of (I-H):", sum(diag(I_minus_H)), "\n")
Trace of (I-H): 3 cat("Expected (n-p):", n - p, "\n")Expected (n-p): 3 # Verify orthogonality: H(I-H) = 0
H_times_IminusH <- H %*% I_minus_H
cat("\nIs H(I-H) = 0?\n")
Is H(I-H) = 0?cat(all(abs(H_times_IminusH) < 1e-10), "\n")TRUE # Compute fitted values and residuals
y_hat <- H %*% yield
e <- (I_minus_H) %*% yield
cat("\nFitted values:\n")
Fitted values:print(round(y_hat, 2)) [,1]
[1,] 30.8
[2,] 29.5
[3,] 28.2
[4,] 26.9
[5,] 25.6cat("\nResiduals:\n")
Residuals:print(round(e, 2)) [,1]
[1,] -2.8
[2,] 2.5
[3,] 1.8
[4,] 0.1
[5,] -1.6# Verify fitted and residuals are orthogonal
cat("\nAre fitted and residuals orthogonal (sum to 0)?\n")
Are fitted and residuals orthogonal (sum to 0)?cat(round(sum(y_hat * e), 10), "\n")0 # Hat values (leverage)
h_ii <- diag(H)
cat("\nHat values (leverage):\n")
Hat values (leverage):print(round(h_ii, 4))[1] 0.6 0.3 0.2 0.3 0.6cat("\nAverage leverage:", p/n, "\n")
Average leverage: 0.4 cat("High leverage threshold (2p/n):", 2*p/n, "\n")High leverage threshold (2p/n): 0.8 cat("Observations with high leverage:", which(h_ii > 2*p/n), "\n")Observations with high leverage: Extended Example: Multiple Regression
# Beef cattle: ADG (kg/day) vs initial weight (kg) and days on feed
# n = 8 steers
initial_wt <- c(250, 260, 245, 270, 255, 265, 240, 275)
days_feed <- c(120, 120, 120, 120, 150, 150, 150, 150)
adg <- c(1.2, 1.3, 1.1, 1.4, 1.0, 1.1, 0.9, 1.2)
# Design matrix: intercept, initial weight, days on feed
X <- cbind(1, initial_wt, days_feed)
n <- nrow(X)
p <- ncol(X)
cat("Design matrix X (first 4 rows):\n")Design matrix X (first 4 rows):print(head(X, 4)) initial_wt days_feed
[1,] 1 250 120
[2,] 1 260 120
[3,] 1 245 120
[4,] 1 270 120# Compute H
H <- X %*% solve(t(X) %*% X) %*% t(X)
# Verify all properties
cat("\nVerification of H properties:\n")
Verification of H properties:cat("1. Symmetric:", all.equal(H, t(H)), "\n")1. Symmetric: TRUE cat("2. Idempotent:", all.equal(H, H %*% H), "\n")2. Idempotent: TRUE cat("3. Rank:", qr(H)$rank, "= p =", p, "\n")3. Rank: 3 = p = 3 cat("4. Trace:", round(sum(diag(H)), 6), "= p =", p, "\n")4. Trace: 3 = p = 3 # Hat values
h_ii <- diag(H)
cat("\nHat values:\n")
Hat values:print(round(h_ii, 4))[1] 0.2877 0.2636 0.3720 0.4322 0.2636 0.2877 0.5889 0.5045# Identify high leverage points
threshold <- 2 * p / n
cat("\nLeverage threshold (2p/n):", round(threshold, 4), "\n")
Leverage threshold (2p/n): 0.75 high_leverage <- which(h_ii > threshold)
cat("High leverage observations:", high_leverage, "\n")High leverage observations: # Compute fitted and residual
y_hat <- H %*% adg
e <- adg - y_hat
cat("\nModel fit:\n")
Model fit:cat("R² =", 1 - sum(e^2) / sum((adg - mean(adg))^2), "\n")R² = 0.9799 cat("Residual sum of squares =", sum(e^2), "\n")Residual sum of squares = 0.003614
TipComputational Note
In practice, never compute H explicitly for large datasets. Instead:
- Use
lm()andhatvalues()to get leverage values - Compute projections via QR decomposition (more stable)
- For fitted values: \(\hat{\mathbf{y}} = \mathbf{X}\mathbf{b}\) (no need for H)
- For residuals: \(\mathbf{e} = \mathbf{y} - \mathbf{X}\mathbf{b}\)
# Practical approach
fit <- lm(adg ~ initial_wt + days_feed)
# Get leverage directly
h_practical <- hatvalues(fit)
cat("Leverage from lm():\n")Leverage from lm():print(round(h_practical, 4)) 1 2 3 4 5 6 7 8
0.2877 0.2636 0.3720 0.4322 0.2636 0.2877 0.5889 0.5045 # Compare with our manual calculation
cat("\nAgreement with manual H:\n")
Agreement with manual H:cat(all.equal(diag(H), h_practical, check.attributes = FALSE), "\n")TRUE 16.6.2 Quadratic Forms
A quadratic form is a scalar-valued function of a vector obtained by “sandwiching” a matrix between the vector and its transpose:
\[ q = \mathbf{y}'\mathbf{A}\mathbf{y} \tag{16.41}\]
where y is n × 1 and A is n × n symmetric.
Properties of Quadratic Forms
Result is a scalar: \(\mathbf{y}'\mathbf{A}\mathbf{y}\) is a 1 × 1 matrix (scalar)
Symmetry matters: For \(\mathbf{y}'\mathbf{A}\mathbf{y}\) to be well-defined, A should be symmetric
- If A is not symmetric, only \((\mathbf{A} + \mathbf{A}')/2\) contributes to the quadratic form
Trace relationship: \[ \mathbf{y}'\mathbf{A}\mathbf{y} = \text{tr}(\mathbf{A}\mathbf{y}\mathbf{y}') \tag{16.42}\]
Expected value: If \(\mathbf{y} \sim N(\boldsymbol{\mu}, \boldsymbol{\Sigma})\), then: \[ E(\mathbf{y}'\mathbf{A}\mathbf{y}) = \text{tr}(\mathbf{A}\boldsymbol{\Sigma}) + \boldsymbol{\mu}'\mathbf{A}\boldsymbol{\mu} \tag{16.43}\]
Variance: If \(\mathbf{y} \sim N(\boldsymbol{\mu}, \sigma^2\mathbf{I})\) and A is symmetric: \[ \text{Var}(\mathbf{y}'\mathbf{A}\mathbf{y}) = 2\sigma^4 \text{tr}(\mathbf{A}^2) + 4\sigma^2\boldsymbol{\mu}'\mathbf{A}^2\boldsymbol{\mu} \tag{16.44}\]
Distribution of Quadratic Forms
Theorem: If \(\mathbf{y} \sim N(\mathbf{0}, \sigma^2\mathbf{I})\) and A is symmetric and idempotent with rank r, then:
\[ \frac{\mathbf{y}'\mathbf{A}\mathbf{y}}{\sigma^2} \sim \chi^2_r \tag{16.45}\]
This is Cochran’s Theorem and is fundamental for hypothesis testing in linear models.
Quadratic Forms in Linear Models
Quadratic forms appear everywhere in linear models analysis. The key decomposition is:
\[ \mathbf{y}'\mathbf{y} = \mathbf{y}'\mathbf{H}\mathbf{y} + \mathbf{y}'(\mathbf{I} - \mathbf{H})\mathbf{y} \tag{16.46}\]
This leads to the sum of squares decomposition:
Total Sum of Squares (SST): \[ \text{SST} = \mathbf{y}'(\mathbf{I} - n^{-1}\mathbf{1}\mathbf{1}')\mathbf{y} = \sum_{i=1}^n (y_i - \bar{y})^2 \tag{16.47}\]
where \(\mathbf{1}\) is an n × 1 vector of ones and \(\bar{y} = n^{-1}\mathbf{1}'\mathbf{y}\).
Model Sum of Squares (SSM or SSR): \[ \text{SSM} = \mathbf{y}'[\mathbf{H} - n^{-1}\mathbf{1}\mathbf{1}']\mathbf{y} = \sum_{i=1}^n (\hat{y}_i - \bar{y})^2 \tag{16.48}\]
Alternatively: \[ \text{SSM} = \mathbf{b}'\mathbf{X}'\mathbf{y} - n\bar{y}^2 \tag{16.49}\]
Error Sum of Squares (SSE or RSS): \[ \text{SSE} = \mathbf{y}'(\mathbf{I} - \mathbf{H})\mathbf{y} = \mathbf{e}'\mathbf{e} = \sum_{i=1}^n e_i^2 \tag{16.50}\]
Alternatively: \[ \text{SSE} = \mathbf{y}'\mathbf{y} - \mathbf{b}'\mathbf{X}'\mathbf{y} \tag{16.51}\]
Decomposition: \[ \text{SST} = \text{SSM} + \text{SSE} \tag{16.52}\]
with degrees of freedom: - SST: n - 1 - SSM: p - 1 (or p if no intercept) - SSE: n - p
Variance Estimation via Quadratic Forms
The variance estimate is:
\[ \hat{\sigma}^2 = \frac{\text{SSE}}{n - p} = \frac{\mathbf{y}'(\mathbf{I} - \mathbf{H})\mathbf{y}}{n - p} \tag{16.53}\]
Under normality, \(\text{SSE}/\sigma^2 \sim \chi^2_{n-p}\), so:
\[ E(\hat{\sigma}^2) = \sigma^2 \tag{16.54}\]
Variance of Estimates
The variance of the least squares estimates b is also a quadratic form:
\[ \text{Var}(\mathbf{b}) = (\mathbf{X}'\mathbf{X})^{-1}\sigma^2 \tag{16.55}\]
For a linear combination \(\mathbf{c}'\mathbf{b}\):
\[ \text{Var}(\mathbf{c}'\mathbf{b}) = \mathbf{c}'(\mathbf{X}'\mathbf{X})^{-1}\mathbf{c} \cdot \sigma^2 \tag{16.56}\]
This is a quadratic form in c.
R Implementation
# Continue with dairy cow example from earlier
days <- c(30, 60, 90, 120, 150)
yield <- c(28, 32, 30, 27, 24)
n <- length(yield)
# Design matrix
X <- cbind(1, days)
p <- ncol(X)
# Compute projection matrices
H <- X %*% solve(t(X) %*% X) %*% t(X)
I_minus_H <- diag(n) - H
J_n <- matrix(1/n, n, n) # n^{-1}11'
# Demonstrate y'y = y'Hy + y'(I-H)y
yty <- t(yield) %*% yield
ytHy <- t(yield) %*% H %*% yield
yt_IminusH_y <- t(yield) %*% I_minus_H %*% yield
cat("Decomposition of y'y:\n")Decomposition of y'y:cat("y'y =", c(yty), "\n")y'y = 4013 cat("y'Hy =", c(ytHy), "\n")y'Hy = 3993 cat("y'(I-H)y =", c(yt_IminusH_y), "\n")y'(I-H)y = 19.9 cat("y'Hy + y'(I-H)y =", c(ytHy + yt_IminusH_y), "\n")y'Hy + y'(I-H)y = 4013 cat("Check:", all.equal(c(yty), c(ytHy + yt_IminusH_y)), "\n\n")Check: TRUE # Sum of squares decomposition
y_bar <- mean(yield)
# SST = y'(I - n^{-1}11')y
SST <- t(yield) %*% (diag(n) - J_n) %*% yield
SST_alt <- sum((yield - y_bar)^2)
cat("Total Sum of Squares (SST):\n")Total Sum of Squares (SST):cat("Quadratic form:", c(SST), "\n")Quadratic form: 36.8 cat("Direct calculation:", SST_alt, "\n")Direct calculation: 36.8 cat("Check:", all.equal(c(SST), SST_alt), "\n\n")Check: TRUE # SSM = y'(H - n^{-1}11')y
SSM <- t(yield) %*% (H - J_n) %*% yield
y_hat <- H %*% yield
SSM_alt <- sum((y_hat - y_bar)^2)
cat("Model Sum of Squares (SSM):\n")Model Sum of Squares (SSM):cat("Quadratic form:", c(SSM), "\n")Quadratic form: 16.9 cat("Direct calculation:", SSM_alt, "\n")Direct calculation: 16.9 cat("Check:", all.equal(c(SSM), SSM_alt, tolerance = 1e-10), "\n\n")Check: TRUE # SSE = y'(I-H)y
SSE <- t(yield) %*% I_minus_H %*% yield
e <- (I_minus_H) %*% yield
SSE_alt <- sum(e^2)
cat("Error Sum of Squares (SSE):\n")Error Sum of Squares (SSE):cat("Quadratic form:", c(SSE), "\n")Quadratic form: 19.9 cat("Direct calculation:", SSE_alt, "\n")Direct calculation: 19.9 cat("Check:", all.equal(c(SSE), SSE_alt), "\n\n")Check: TRUE # Verify SST = SSM + SSE
cat("Sum of Squares Decomposition:\n")Sum of Squares Decomposition:cat("SST =", c(SST), "\n")SST = 36.8 cat("SSM + SSE =", c(SSM + SSE), "\n")SSM + SSE = 36.8 cat("Check:", all.equal(c(SST), c(SSM + SSE)), "\n\n")Check: TRUE # Degrees of freedom
df_total <- n - 1
df_model <- p - 1
df_error <- n - p
cat("Degrees of Freedom:\n")Degrees of Freedom:cat("Total:", df_total, "\n")Total: 4 cat("Model:", df_model, "\n")Model: 1 cat("Error:", df_error, "\n")Error: 3 cat("Check:", df_model + df_error, "=", df_total, "\n\n")Check: 4 = 4 # Variance estimate
sigma2_hat <- c(SSE) / df_error
cat("Variance estimate: sigma^2 =", sigma2_hat, "\n\n")Variance estimate: sigma^2 = 6.633 # R-squared
R2 <- c(SSM) / c(SST)
R2_alt <- 1 - c(SSE) / c(SST)
cat("R-squared:\n")R-squared:cat("SSM/SST =", R2, "\n")SSM/SST = 0.4592 cat("1 - SSE/SST =", R2_alt, "\n")1 - SSE/SST = 0.4592 Complete Example: Beef Cattle ADG
# Beef cattle: ADG (kg/day) for 8 steers
# Model: ADG ~ breed (Angus vs Hereford, 4 steers each)
adg <- c(1.2, 1.3, 1.1, 1.4, # Angus
1.0, 1.1, 0.9, 1.2) # Hereford
breed <- factor(rep(c("Angus", "Hereford"), each = 4))
n <- length(adg)
# Cell means model: X has 2 columns (one per breed)
X <- model.matrix(~ breed - 1)
p <- ncol(X)
cat("Design matrix X:\n")Design matrix X:print(X) breedAngus breedHereford
1 1 0
2 1 0
3 1 0
4 1 0
5 0 1
6 0 1
7 0 1
8 0 1
attr(,"assign")
[1] 1 1
attr(,"contrasts")
attr(,"contrasts")$breed
[1] "contr.treatment"# Compute all needed matrices
H <- X %*% solve(t(X) %*% X) %*% t(X)
I_minus_H <- diag(n) - H
# Compute sum of squares
y_bar <- mean(adg)
SST <- sum((adg - y_bar)^2)
y_hat <- H %*% adg
SSM <- sum((y_hat - y_bar)^2)
e <- adg - y_hat
SSE <- sum(e^2)
cat("\nANOVA Table:\n")
ANOVA Table:cat("Source SS df MS F\n")Source SS df MS Fcat("-------------------------------------------\n")-------------------------------------------cat(sprintf("Breed %6.4f %2d %6.4f %6.2f\n",
SSM, p-1, SSM/(p-1), (SSM/(p-1))/(SSE/(n-p))))Breed 0.0800 1 0.0800 4.80cat(sprintf("Error %6.4f %2d %6.4f\n",
SSE, n-p, SSE/(n-p)))Error 0.1000 6 0.0167cat(sprintf("Total %6.4f %2d\n", SST, n-1))Total 0.1800 7cat("-------------------------------------------\n")-------------------------------------------# Verify with lm()
fit <- lm(adg ~ breed - 1)
cat("\nComparison with lm():\n")
Comparison with lm():print(anova(lm(adg ~ breed)))Analysis of Variance Table
Response: adg
Df Sum Sq Mean Sq F value Pr(>F)
breed 1 0.08 0.0800 4.8 0.071 .
Residuals 6 0.10 0.0167
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Demonstrate quadratic form properties
cat("\n\nQuadratic Form Verification:\n")
Quadratic Form Verification:cat("1. SSE = y'(I-H)y = e'e:\n")1. SSE = y'(I-H)y = e'e:SSE_qf <- c(t(adg) %*% I_minus_H %*% adg)
SSE_ee <- c(t(e) %*% e)
cat(" Quadratic form:", SSE_qf, "\n") Quadratic form: 0.1 cat(" e'e:", SSE_ee, "\n") e'e: 0.1 cat("\n2. SSM = y'(H - n^{-1}11')y:\n")
2. SSM = y'(H - n^{-1}11')y:J_n <- matrix(1/n, n, n)
SSM_qf <- c(t(adg) %*% (H - J_n) %*% adg)
cat(" Quadratic form:", SSM_qf, "\n") Quadratic form: 0.08 cat(" Sum of squared deviations:", SSM, "\n") Sum of squared deviations: 0.08 cat("\n3. SST = SSM + SSE:\n")
3. SST = SSM + SSE:cat(" SST:", SST, "\n") SST: 0.18 cat(" SSM + SSE:", SSM + SSE, "\n") SSM + SSE: 0.18 cat(" Agreement:", all.equal(SST, SSM + SSE), "\n") Agreement: TRUE
ImportantKey Takeaways
- Hat matrix H projects y onto the column space of X to give fitted values
- I - H projects onto the orthogonal complement to give residuals
- Both are idempotent and symmetric - essential for distribution theory
- Quadratic forms express sums of squares in matrix notation
- Sum of squares decomposition SST = SSM + SSE follows from orthogonality of projections
- Cochran’s Theorem provides the distributional basis for F-tests and t-tests
These concepts are the mathematical foundation of everything in linear models!
NoteCross-References
- Week 5: Least Squares Theory - Full derivation of these results
- Week 6: Multiple Regression - Application to multiple predictors
- Week 7-10: ANOVA models - Using quadratic forms for hypothesis tests
- Week 11: Model Diagnostics - Leverage values and residual analysis
16.7 Eigenvalues and Eigenvectors
16.7.1 Definitions
Definition:
Let A be an n × n square matrix. A scalar λ (lambda) is an eigenvalue of A if there exists a non-zero vector v such that:
\[ \mathbf{Av} = \lambda\mathbf{v} \tag{16.57}\]
The vector v is called an eigenvector corresponding to eigenvalue λ.
Geometric Interpretation:
When A acts on eigenvector v, it simply scales v by factor λ (no rotation, just scaling).
Characteristic Equation:
Rearranging: \(\mathbf{Av} = \lambda\mathbf{v} \Rightarrow (\mathbf{A} - \lambda\mathbf{I})\mathbf{v} = \mathbf{0}\)
For non-trivial solution (v ≠ 0), the matrix \((\mathbf{A} - \lambda\mathbf{I})\) must be singular:
\[ \det(\mathbf{A} - \lambda\mathbf{I}) = 0 \tag{16.58}\]
This characteristic equation is a polynomial of degree n in λ, yielding n eigenvalues (counting multiplicity).
Key Properties:
- Trace: \(\sum_{i=1}^{n} \lambda_i = \text{tr}(\mathbf{A})\) (sum of eigenvalues equals trace)
- Determinant: \(\prod_{i=1}^{n} \lambda_i = \det(\mathbf{A})\) (product of eigenvalues equals determinant)
- Eigenvectors for distinct eigenvalues: Linearly independent
- Matrix power: If \(\mathbf{Av} = \lambda\mathbf{v}\), then \(\mathbf{A}^k\mathbf{v} = \lambda^k\mathbf{v}\)
R Implementation:
# Simple 2x2 example
A <- matrix(c(4, 1, 2, 3), nrow = 2, ncol = 2, byrow = TRUE)
cat("Matrix A:\n")Matrix A:print(A) [,1] [,2]
[1,] 4 1
[2,] 2 3# Compute eigenvalues and eigenvectors
eigen_A <- eigen(A)
eigenvalues <- eigen_A$values
eigenvectors <- eigen_A$vectors
cat("\nEigenvalues:\n")
Eigenvalues:print(eigenvalues)[1] 5 2cat("\nEigenvectors (as columns):\n")
Eigenvectors (as columns):print(eigenvectors) [,1] [,2]
[1,] 0.7071 -0.4472
[2,] 0.7071 0.8944# Verify: Av = λv for first eigenvalue
lambda1 <- eigenvalues[1]
v1 <- eigenvectors[, 1]
Av1 <- A %*% v1
lambda_v1 <- lambda1 * v1
cat(sprintf("\nVerify Av = λv for λ₁ = %.4f:\n", lambda1))
Verify Av = λv for λ₁ = 5.0000:cat("Av₁:\n")Av₁:print(Av1) [,1]
[1,] 3.536
[2,] 3.536cat("λ₁v₁:\n")λ₁v₁:print(lambda_v1)[1] 3.536 3.536cat("\nAre they equal?\n")
Are they equal?all.equal(Av1, lambda_v1)[1] "Attributes: < Modes: list, NULL >"
[2] "Attributes: < Lengths: 1, 0 >"
[3] "Attributes: < names for target but not for current >"
[4] "Attributes: < current is not list-like >"
[5] "target is matrix, current is numeric" Characteristic Equation Example:
# 2×2 matrix
A <- matrix(c(5, 2, 2, 5), nrow = 2, ncol = 2, byrow = TRUE)
cat("Matrix A:\n")Matrix A:print(A) [,1] [,2]
[1,] 5 2
[2,] 2 5# Characteristic equation: det(A - λI) = 0
# For 2×2: det([5-λ, 2; 2, 5-λ]) = (5-λ)² - 4 = 0
# λ² - 10λ + 21 = 0
# (λ-7)(λ-3) = 0
# λ = 7 or λ = 3
eigen_A <- eigen(A)
cat("\nEigenvalues (computed):\n")
Eigenvalues (computed):print(eigen_A$values)[1] 7 3cat("\nManual calculation:\n")
Manual calculation:cat("det(A - λI) = (5-λ)² - 4 = λ² - 10λ + 21 = 0\n")det(A - λI) = (5-λ)² - 4 = λ² - 10λ + 21 = 0cat("Solutions: λ = 7 and λ = 3\n")Solutions: λ = 7 and λ = 3# Verify trace and determinant properties
cat(sprintf("\nSum of eigenvalues = %.1f\n", sum(eigen_A$values)))
Sum of eigenvalues = 10.0cat(sprintf("Trace of A = %.1f\n", sum(diag(A))))Trace of A = 10.0cat(sprintf("\nProduct of eigenvalues = %.1f\n", prod(eigen_A$values)))
Product of eigenvalues = 21.0cat(sprintf("Determinant of A = %.1f\n", det(A)))Determinant of A = 21.0Finding Eigenvectors:
# Using eigenvalue λ = 7, find eigenvector
A <- matrix(c(5, 2, 2, 5), nrow = 2, ncol = 2, byrow = TRUE)
lambda <- 7
# Solve (A - λI)v = 0
A_minus_lambdaI <- A - lambda * diag(2)
cat("A - 7I:\n")A - 7I:print(A_minus_lambdaI) [,1] [,2]
[1,] -2 2
[2,] 2 -2# Null space of this matrix gives eigenvector
# Row 1: -2v₁ + 2v₂ = 0 → v₁ = v₂
# So v = [1, 1]' (or any multiple)
v <- c(1, 1)
cat("\nEigenvector v = [1, 1]':\n")
Eigenvector v = [1, 1]':print(v)[1] 1 1# Verify Av = 7v
Av <- A %*% v
cat("\nAv:\n")
Av:print(Av) [,1]
[1,] 7
[2,] 7cat("\n7v:\n")
7v:print(7 * v)[1] 7 7cat("\nAv = 7v ✓\n")
Av = 7v ✓Livestock Example - Growth Model:
Eigenvalues describe long-term behavior of dynamic systems.
# Simplified population model: 2 age classes (juveniles, adults)
# Transition matrix: rows = next state, columns = current state
A <- matrix(c(
0.2, 2.0, # Juveniles: 20% survive, 2 offspring per adult
0.5, 0.8 # Adults: 50% juveniles mature, 80% adults survive
), nrow = 2, ncol = 2, byrow = TRUE)
cat("Population transition matrix A:\n")Population transition matrix A:print(A) [,1] [,2]
[1,] 0.2 2.0
[2,] 0.5 0.8# Eigenvalues
eigen_A <- eigen(A)
lambda_max <- max(eigen_A$values)
cat(sprintf("\nDominant eigenvalue: %.4f\n", lambda_max))
Dominant eigenvalue: 1.5440if (lambda_max > 1) {
cat("λ > 1: Population grows\n")
} else if (lambda_max < 1) {
cat("λ < 1: Population declines\n")
} else {
cat("λ = 1: Population stable\n")
}λ > 1: Population growscat(sprintf("\nGrowth rate: %.2f%% per time period\n", (lambda_max - 1) * 100))
Growth rate: 54.40% per time period# Stable age distribution (eigenvector for dominant eigenvalue)
v_stable <- eigen_A$vectors[, 1]
v_stable <- v_stable / sum(v_stable) # Normalize to sum to 1
cat("\nStable age distribution:\n")
Stable age distribution:cat(sprintf(" Juveniles: %.2f%%\n", v_stable[1] * 100)) Juveniles: 59.81%cat(sprintf(" Adults: %.2f%%\n", v_stable[2] * 100)) Adults: 40.19%Diagonalization:
If A has n linearly independent eigenvectors, we can write:
\[ \mathbf{A} = \mathbf{V\Lambda V}^{-1} \tag{16.59}\]
where: - V = matrix with eigenvectors as columns - Λ = diagonal matrix with eigenvalues on diagonal
A <- matrix(c(4, 1, 2, 3), nrow = 2, ncol = 2, byrow = TRUE)
eigen_A <- eigen(A)
V <- eigen_A$vectors
Lambda <- diag(eigen_A$values)
cat("Matrix A:\n")Matrix A:print(A) [,1] [,2]
[1,] 4 1
[2,] 2 3cat("\nEigenvector matrix V:\n")
Eigenvector matrix V:print(V) [,1] [,2]
[1,] 0.7071 -0.4472
[2,] 0.7071 0.8944cat("\nEigenvalue matrix Λ:\n")
Eigenvalue matrix Λ:print(Lambda) [,1] [,2]
[1,] 5 0
[2,] 0 2# Reconstruct A
A_reconstructed <- V %*% Lambda %*% solve(V)
cat("\nReconstructed A = VΛV⁻¹:\n")
Reconstructed A = VΛV⁻¹:print(A_reconstructed) [,1] [,2]
[1,] 4 1
[2,] 2 3cat("\nVerify reconstruction:\n")
Verify reconstruction:all.equal(A, A_reconstructed)[1] TRUEMatrix Powers via Eigenvalues:
Computing Ak is easy with diagonalization: \(\mathbf{A}^k = \mathbf{V\Lambda}^k\mathbf{V}^{-1}\)
A <- matrix(c(0.8, 0.2, 0.3, 0.7), nrow = 2, ncol = 2, byrow = TRUE)
cat("Transition matrix A:\n")Transition matrix A:print(A) [,1] [,2]
[1,] 0.8 0.2
[2,] 0.3 0.7# Compute A^10 directly (slow for large k)
A10_direct <- A
for (i in 1:9) A10_direct <- A10_direct %*% A
cat("\nA^10 (direct calculation):\n")
A^10 (direct calculation):print(round(A10_direct, 4)) [,1] [,2]
[1,] 0.6004 0.3996
[2,] 0.5994 0.4006# Compute A^10 via eigendecomposition (fast!)
eigen_A <- eigen(A)
V <- eigen_A$vectors
Lambda <- diag(eigen_A$values)
Lambda10 <- diag(eigen_A$values^10) # Just raise eigenvalues to power 10
A10_eigen <- V %*% Lambda10 %*% solve(V)
cat("\nA^10 (via eigenvalues):\n")
A^10 (via eigenvalues):print(round(A10_eigen, 4)) [,1] [,2]
[1,] 0.6004 0.3996
[2,] 0.5994 0.4006cat("\nVerify both methods agree:\n")
Verify both methods agree:all.equal(A10_direct, A10_eigen)[1] TRUEcat("\nNote: As k → ∞, matrix stabilizes (dominant eigenvalue < 1)\n")
Note: As k → ∞, matrix stabilizes (dominant eigenvalue < 1)
NoteCross-References
Eigenvalues and eigenvectors appear in:
- Week 2: Conceptual introduction
- Week 14: Variance components in genetic evaluation
- Section Section 16.7.2: Special properties for symmetric matrices
- Section Section 16.7.3: Positive definite matrices (all eigenvalues > 0)
- Section Section 16.7.4: Singular value decomposition
16.7.2 Properties for Symmetric Matrices
Symmetric matrices have very special eigenvalue properties that make them particularly important in linear models.
Spectral Theorem for Symmetric Matrices:
If A is a real symmetric matrix (n × n), then:
- All eigenvalues are real (no complex numbers!)
- Eigenvectors corresponding to distinct eigenvalues are orthogonal
- A can be diagonalized by an orthogonal matrix: \(\mathbf{A} = \mathbf{Q\Lambda Q}'\)
where: - Q is orthogonal (\(\mathbf{Q}'\mathbf{Q} = \mathbf{I}\)) - Λ is diagonal with eigenvalues
This is called the spectral decomposition or eigenvalue decomposition.
\[ \mathbf{A} = \mathbf{Q\Lambda Q}' = \sum_{i=1}^{n} \lambda_i \mathbf{q}_i\mathbf{q}_i' \tag{16.60}\]
Why This Matters for Linear Models:
Since \(\mathbf{X}'\mathbf{X}\) is symmetric, it has: - Real eigenvalues only - Orthogonal eigenvectors - Clean spectral decomposition
R Implementation:
# Symmetric matrix
A <- matrix(c(4, 2, 1,
2, 5, 3,
1, 3, 6), nrow = 3, ncol = 3, byrow = TRUE)
cat("Symmetric matrix A:\n")Symmetric matrix A:print(A) [,1] [,2] [,3]
[1,] 4 2 1
[2,] 2 5 3
[3,] 1 3 6# Verify symmetry
cat("\nIs A symmetric?", isTRUE(all.equal(A, t(A))), "\n")
Is A symmetric? TRUE # Eigenvalues and eigenvectors
eigen_A <- eigen(A)
cat("\nEigenvalues (all real!):\n")
Eigenvalues (all real!):print(eigen_A$values)[1] 9.348 3.730 1.921cat("\nEigenvectors Q:\n")
Eigenvectors Q:Q <- eigen_A$vectors
print(round(Q, 4)) [,1] [,2] [,3]
[1,] -0.3651 0.7759 0.5145
[2,] -0.6366 0.1953 -0.7461
[3,] -0.6793 -0.5999 0.4226# Verify Q is orthogonal
cat("\nVerify Q'Q = I:\n")
Verify Q'Q = I:QtQ <- t(Q) %*% Q
print(round(QtQ, 10)) [,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 1 0
[3,] 0 0 1# Verify Q orthogonal
cat("\nIs Q orthogonal?", isTRUE(all.equal(QtQ, diag(3))), "\n")
Is Q orthogonal? TRUE Orthogonality of Eigenvectors:
For symmetric matrices, eigenvectors for different eigenvalues are orthogonal.
# Symmetric matrix
A <- matrix(c(3, 1, 1, 3), nrow = 2, ncol = 2, byrow = TRUE)
cat("Symmetric matrix A:\n")Symmetric matrix A:print(A) [,1] [,2]
[1,] 3 1
[2,] 1 3eigen_A <- eigen(A)
cat("\nEigenvalues:\n")
Eigenvalues:print(eigen_A$values)[1] 4 2v1 <- eigen_A$vectors[, 1]
v2 <- eigen_A$vectors[, 2]
cat("\nEigenvector 1:\n")
Eigenvector 1:print(v1)[1] 0.7071 0.7071cat("\nEigenvector 2:\n")
Eigenvector 2:print(v2)[1] -0.7071 0.7071# Check orthogonality
cat(sprintf("\nv1'v2 = %.10f (should be 0)\n", sum(v1 * v2)))
v1'v2 = 0.0000000000 (should be 0)# Check unit length
cat(sprintf("||v1|| = %.4f\n", sqrt(sum(v1^2))))||v1|| = 1.0000cat(sprintf("||v2|| = %.4f\n", sqrt(sum(v2^2))))||v2|| = 1.0000cat("\nEigenvectors are orthonormal (orthogonal + unit length)\n")
Eigenvectors are orthonormal (orthogonal + unit length)Spectral Decomposition:
\(\mathbf{A} = \mathbf{Q\Lambda Q}'\) where Q’ = Q(-1)
A <- matrix(c(4, 2, 2, 3), nrow = 2, ncol = 2, byrow = TRUE)
cat("Symmetric matrix A:\n")Symmetric matrix A:print(A) [,1] [,2]
[1,] 4 2
[2,] 2 3eigen_A <- eigen(A)
Q <- eigen_A$vectors
Lambda <- diag(eigen_A$values)
cat("\nOrthogonal matrix Q:\n")
Orthogonal matrix Q:print(round(Q, 4)) [,1] [,2]
[1,] -0.7882 0.6154
[2,] -0.6154 -0.7882cat("\nEigenvalue matrix Λ:\n")
Eigenvalue matrix Λ:print(round(Lambda, 4)) [,1] [,2]
[1,] 5.562 0.000
[2,] 0.000 1.438# Reconstruct A using A = QΛQ'
A_reconstructed <- Q %*% Lambda %*% t(Q)
cat("\nReconstructed A = QΛQ':\n")
Reconstructed A = QΛQ':print(round(A_reconstructed, 4)) [,1] [,2]
[1,] 4 2
[2,] 2 3cat("\nVerify reconstruction:\n")
Verify reconstruction:all.equal(A, A_reconstructed)[1] TRUEcat("\nNote: For symmetric matrices, Q' = Q⁻¹ (transpose = inverse!)\n")
Note: For symmetric matrices, Q' = Q⁻¹ (transpose = inverse!)Livestock Example - Covariance Matrix:
Covariance matrices are symmetric, so they have real eigenvalues and orthogonal eigenvectors.
# Broiler data: body weight (kg), breast yield (proportion), leg yield
# Covariance matrix (realistic values)
Sigma <- matrix(c(
0.16, 0.04, 0.03, # Var(BW) = 0.16, Cov(BW, Breast) = 0.04, Cov(BW, Leg) = 0.03
0.04, 0.02, 0.01, # Cov(Breast, BW) = 0.04, Var(Breast) = 0.02, Cov(Breast, Leg) = 0.01
0.03, 0.01, 0.02 # Cov(Leg, BW) = 0.03, Cov(Leg, Breast) = 0.01, Var(Leg) = 0.02
), nrow = 3, ncol = 3, byrow = TRUE)
colnames(Sigma) <- rownames(Sigma) <- c("BodyWt", "Breast", "Leg")
cat("Covariance matrix Σ:\n")Covariance matrix Σ:print(round(Sigma, 4)) BodyWt Breast Leg
BodyWt 0.16 0.04 0.03
Breast 0.04 0.02 0.01
Leg 0.03 0.01 0.02# Eigendecomposition
eigen_Sigma <- eigen(Sigma)
cat("\nEigenvalues (variances of principal components):\n")
Eigenvalues (variances of principal components):print(round(eigen_Sigma$values, 4))[1] 0.1770 0.0144 0.0086cat("\nEigenvectors (loadings of principal components):\n")
Eigenvectors (loadings of principal components):PC_loadings <- eigen_Sigma$vectors
colnames(PC_loadings) <- c("PC1", "PC2", "PC3")
rownames(PC_loadings) <- c("BodyWt", "Breast", "Leg")
print(round(PC_loadings, 4)) PC1 PC2 PC3
BodyWt 0.9469 0.2707 0.1734
Breast 0.2539 -0.2990 -0.9199
Leg 0.1972 -0.9151 0.3518# Proportion of variance explained
prop_var <- eigen_Sigma$values / sum(eigen_Sigma$values)
cat("\nProportion of variance explained:\n")
Proportion of variance explained:cat(sprintf(" PC1: %.2f%%\n", prop_var[1] * 100)) PC1: 88.48%cat(sprintf(" PC2: %.2f%%\n", prop_var[2] * 100)) PC2: 7.20%cat(sprintf(" PC3: %.2f%%\n", prop_var[3] * 100)) PC3: 4.32%cat("\nThis is the basis of Principal Component Analysis (PCA)\n")
This is the basis of Principal Component Analysis (PCA)Application to X’X Matrix:
# Design matrix for simple regression
X <- cbind(1, c(1, 2, 3, 4, 5))
cat("Design matrix X (5×2):\n")Design matrix X (5×2):print(X) [,1] [,2]
[1,] 1 1
[2,] 1 2
[3,] 1 3
[4,] 1 4
[5,] 1 5# Form X'X
XtX <- t(X) %*% X
cat("\nX'X (symmetric):\n")
X'X (symmetric):print(XtX) [,1] [,2]
[1,] 5 15
[2,] 15 55# Eigendecomposition
eigen_XtX <- eigen(XtX)
cat("\nEigenvalues of X'X:\n")
Eigenvalues of X'X:print(round(eigen_XtX$values, 4))[1] 59.1548 0.8452cat("\nBoth eigenvalues > 0 (X'X is positive definite)\n")
Both eigenvalues > 0 (X'X is positive definite)# Condition number (ratio of largest to smallest eigenvalue)
kappa <- max(eigen_XtX$values) / min(eigen_XtX$values)
cat(sprintf("\nCondition number κ(X'X) = %.2f\n", kappa))
Condition number κ(X'X) = 69.99if (kappa < 30) {
cat("Well-conditioned matrix (good numerical stability)\n")
} else if (kappa < 1000) {
cat("Moderately conditioned (acceptable)\n")
} else {
cat("Ill-conditioned (numerical problems likely)\n")
}Moderately conditioned (acceptable)Sum of Outer Products Form:
The spectral decomposition can be written as a sum of rank-1 matrices:
\[ \mathbf{A} = \sum_{i=1}^{n} \lambda_i \mathbf{q}_i\mathbf{q}_i' \tag{16.61}\]
A <- matrix(c(5, 2, 2, 2), nrow = 2, ncol = 2, byrow = TRUE)
cat("Symmetric matrix A:\n")Symmetric matrix A:print(A) [,1] [,2]
[1,] 5 2
[2,] 2 2eigen_A <- eigen(A)
# Reconstruct using sum of outer products
lambda1 <- eigen_A$values[1]
lambda2 <- eigen_A$values[2]
q1 <- eigen_A$vectors[, 1]
q2 <- eigen_A$vectors[, 2]
term1 <- lambda1 * (q1 %*% t(q1))
term2 <- lambda2 * (q2 %*% t(q2))
cat("\nλ₁q₁q₁' (first term):\n")
λ₁q₁q₁' (first term):print(round(term1, 4)) [,1] [,2]
[1,] 4.8 2.4
[2,] 2.4 1.2cat("\nλ₂q₂q₂' (second term):\n")
λ₂q₂q₂' (second term):print(round(term2, 4)) [,1] [,2]
[1,] 0.2 -0.4
[2,] -0.4 0.8A_reconstructed <- term1 + term2
cat("\nA = λ₁q₁q₁' + λ₂q₂q₂':\n")
A = λ₁q₁q₁' + λ₂q₂q₂':print(round(A_reconstructed, 4)) [,1] [,2]
[1,] 5 2
[2,] 2 2cat("\nVerify reconstruction:\n")
Verify reconstruction:all.equal(A, A_reconstructed)[1] TRUENumerical Verification:
# Random symmetric matrix
set.seed(123)
B <- matrix(rnorm(9), nrow = 3)
A <- (B + t(B)) / 2 # Force symmetry
cat("Random symmetric matrix A:\n")Random symmetric matrix A:print(round(A, 4)) [,1] [,2] [,3]
[1,] -0.5605 -0.0798 1.0098
[2,] -0.0798 0.1293 0.2250
[3,] 1.0098 0.2250 -0.6869eigen_A <- eigen(A)
# Check all eigenvalues are real (imaginary part = 0)
cat("\nImaginary parts of eigenvalues (should all be 0):\n")
Imaginary parts of eigenvalues (should all be 0):print(Im(eigen_A$values))[1] 0 0 0cat("\nAll eigenvalues are real ✓\n")
All eigenvalues are real ✓# Check eigenvectors are orthogonal
Q <- eigen_A$vectors
QtQ <- t(Q) %*% Q
cat("\nQ'Q (should be identity):\n")
Q'Q (should be identity):print(round(QtQ, 10)) [,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 1 0
[3,] 0 0 1cat("\nEigenvectors are orthogonal ✓\n")
Eigenvectors are orthogonal ✓# Verify spectral decomposition
Lambda <- diag(eigen_A$values)
A_check <- Q %*% Lambda %*% t(Q)
cat("\nVerify A = QΛQ':\n")
Verify A = QΛQ':all.equal(A, A_check)[1] TRUE
ImportantCritical for X’X in Linear Models
Since \(\mathbf{X}'\mathbf{X}\) is symmetric:
- All eigenvalues are real (no complex numbers to worry about)
- Eigenvectors are orthogonal (clean geometry)
- Spectral decomposition: \(\mathbf{X}'\mathbf{X} = \mathbf{Q\Lambda Q}'\)
- Condition number: \(\kappa = \lambda_{\max}/\lambda_{\min}\) measures numerical stability
- Rank = number of non-zero eigenvalues
If any eigenvalue is zero, \(\mathbf{X}'\mathbf{X}\) is singular (rank deficient).
NoteCross-References
Properties of symmetric matrices are central to:
- Week 2: Understanding structure of \(\mathbf{X}'\mathbf{X}\)
- Week 5: Variance-covariance matrix \(\text{Var}(\mathbf{b}) = (\mathbf{X}'\mathbf{X})^{-1}\sigma^2\)
- Week 11: Condition number and numerical stability
- Section Section 16.7.3: When all eigenvalues > 0
- Section Section 16.11: Numerical considerations for eigenvalue computation
16.7.3 Positive Definite Matrices
Definition:
A symmetric matrix A (n × n) is positive definite if:
\[ \mathbf{x}'\mathbf{Ax} > 0 \quad \text{for all non-zero vectors } \mathbf{x} \tag{16.62}\]
The quadratic form \(\mathbf{x}'\mathbf{Ax}\) is always strictly positive (except when x = 0).
Related Definitions:
- Positive semi-definite: \(\mathbf{x}'\mathbf{Ax} \geq 0\) for all x (allows zero)
- Negative definite: \(\mathbf{x}'\mathbf{Ax} < 0\) for all non-zero x
- Indefinite: \(\mathbf{x}'\mathbf{Ax}\) can be positive or negative depending on x
Equivalent Characterizations:
For a symmetric matrix A, the following are equivalent:
- A is positive definite
- All eigenvalues of A are positive: \(\lambda_i > 0\) for all i
- All leading principal minors are positive (Sylvester’s criterion)
- There exists a non-singular matrix B such that \(\mathbf{A} = \mathbf{B}'\mathbf{B}\)
- A is invertible (det(A) > 0)
Why This Matters for Linear Models:
For full-rank design matrix X, the matrix \(\mathbf{X}'\mathbf{X}\) is positive definite: - All eigenvalues > 0 - Invertible (unique solution exists!) - Numerically stable
R Implementation:
# Positive definite matrix
A <- matrix(c(4, 1, 1, 3), nrow = 2, ncol = 2, byrow = TRUE)
cat("Matrix A:\n")Matrix A:print(A) [,1] [,2]
[1,] 4 1
[2,] 1 3# Check eigenvalues
eigen_A <- eigen(A)
cat("\nEigenvalues:\n")
Eigenvalues:print(eigen_A$values)[1] 4.618 2.382all_positive <- all(eigen_A$values > 0)
cat(sprintf("\nAll eigenvalues > 0? %s\n", all_positive))
All eigenvalues > 0? TRUEif (all_positive) {
cat("A is positive definite!\n")
}A is positive definite!# Test quadratic form for several vectors
test_vectors <- list(
c(1, 0),
c(0, 1),
c(1, 1),
c(1, -1),
c(2, 3)
)
cat("\nQuadratic forms x'Ax:\n")
Quadratic forms x'Ax:for (i in seq_along(test_vectors)) {
x <- test_vectors[[i]]
qf <- t(x) %*% A %*% x
cat(sprintf("x = [%d, %d]: x'Ax = %.4f\n", x[1], x[2], qf[1,1]))
}x = [1, 0]: x'Ax = 4.0000
x = [0, 1]: x'Ax = 3.0000
x = [1, 1]: x'Ax = 9.0000
x = [1, -1]: x'Ax = 5.0000
x = [2, 3]: x'Ax = 55.0000cat("\nAll values > 0 (positive definite) ✓\n")
All values > 0 (positive definite) ✓Cholesky Decomposition:
Every positive definite matrix A can be uniquely factored as:
\[ \mathbf{A} = \mathbf{L}\mathbf{L}' \tag{16.63}\]
where L is lower triangular with positive diagonal elements.
This is the Cholesky decomposition - extremely useful for solving linear systems efficiently.
A <- matrix(c(4, 2, 2, 5), nrow = 2, ncol = 2, byrow = TRUE)
cat("Positive definite matrix A:\n")Positive definite matrix A:print(A) [,1] [,2]
[1,] 4 2
[2,] 2 5# Cholesky decomposition
L <- chol(A) # Note: R's chol() returns UPPER triangular
# So we need to transpose to get lower triangular
L_lower <- t(L) # Lower triangular
cat("\nLower triangular matrix L:\n")
Lower triangular matrix L:print(round(L_lower, 4)) [,1] [,2]
[1,] 2 0
[2,] 1 2# Verify A = LL'
A_reconstructed <- L_lower %*% t(L_lower)
cat("\nReconstructed A = LL':\n")
Reconstructed A = LL':print(round(A_reconstructed, 4)) [,1] [,2]
[1,] 4 2
[2,] 2 5cat("\nVerify reconstruction:\n")
Verify reconstruction:all.equal(A, A_reconstructed)[1] TRUEcat("\nCholesky is fast and numerically stable for positive definite matrices\n")
Cholesky is fast and numerically stable for positive definite matricesTesting Positive Definiteness:
# Function to test positive definiteness
is_positive_definite <- function(A, tol = 1e-8) {
# Check symmetry
if (!isTRUE(all.equal(A, t(A)))) {
cat("Not symmetric!\n")
return(FALSE)
}
# Check eigenvalues
eigenvalues <- eigen(A, symmetric = TRUE, only.values = TRUE)$values
if (all(eigenvalues > tol)) {
return(TRUE)
} else {
return(FALSE)
}
}
# Test various matrices
A1 <- matrix(c(2, 1, 1, 2), nrow = 2, ncol = 2, byrow = TRUE)
A2 <- matrix(c(2, 3, 3, 2), nrow = 2, ncol = 2, byrow = TRUE) # Not PD
A3 <- matrix(c(1, 0, 0, 1), nrow = 2, ncol = 2, byrow = TRUE) # Identity (PD)
A4 <- matrix(c(1, 1, 1, 1), nrow = 2, ncol = 2, byrow = TRUE) # Singular (not PD)
cat("Matrix A1:\n")Matrix A1:print(A1) [,1] [,2]
[1,] 2 1
[2,] 1 2cat("Eigenvalues:", eigen(A1)$values, "\n")Eigenvalues: 3 1 cat("Positive definite?", is_positive_definite(A1), "\n\n")Positive definite? TRUE cat("Matrix A2:\n")Matrix A2:print(A2) [,1] [,2]
[1,] 2 3
[2,] 3 2cat("Eigenvalues:", round(eigen(A2)$values, 4), "\n")Eigenvalues: 5 -1 cat("Positive definite?", is_positive_definite(A2), "\n\n")Positive definite? FALSE cat("Matrix A3 (Identity):\n")Matrix A3 (Identity):print(A3) [,1] [,2]
[1,] 1 0
[2,] 0 1cat("Eigenvalues:", eigen(A3)$values, "\n")Eigenvalues: 1 1 cat("Positive definite?", is_positive_definite(A3), "\n\n")Positive definite? TRUE cat("Matrix A4 (Singular):\n")Matrix A4 (Singular):print(A4) [,1] [,2]
[1,] 1 1
[2,] 1 1cat("Eigenvalues:", eigen(A4)$values, "\n")Eigenvalues: 2 0 cat("Positive definite?", is_positive_definite(A4), "\n")Positive definite? FALSE Positive Semi-Definite:
\(\mathbf{x}'\mathbf{Ax} \geq 0\) (allows zero). Eigenvalues \(\geq\) 0 (some may be zero).
# Positive semi-definite (but not positive definite)
A <- matrix(c(1, 1, 1, 1), nrow = 2, ncol = 2, byrow = TRUE)
cat("Matrix A:\n")Matrix A:print(A) [,1] [,2]
[1,] 1 1
[2,] 1 1eigen_A <- eigen(A)
cat("\nEigenvalues:\n")
Eigenvalues:print(eigen_A$values)[1] 2 0cat("\nOne eigenvalue = 0 (positive semi-definite but not positive definite)\n")
One eigenvalue = 0 (positive semi-definite but not positive definite)cat("This matrix is singular (not invertible)\n")This matrix is singular (not invertible)# Rank
cat(sprintf("Rank: %d (less than 2)\n", qr(A)$rank))Rank: 1 (less than 2)Livestock Example - X’X is Positive Definite:
# Full-rank design matrix
X <- cbind(1, c(1, 2, 3, 4, 5), c(2, 3, 1, 5, 4))
cat("Design matrix X (5×3):\n")Design matrix X (5×3):print(X) [,1] [,2] [,3]
[1,] 1 1 2
[2,] 1 2 3
[3,] 1 3 1
[4,] 1 4 5
[5,] 1 5 4cat(sprintf("\nRank of X: %d (full rank!)\n", qr(X)$rank))
Rank of X: 3 (full rank!)# Form X'X
XtX <- t(X) %*% X
cat("\nX'X (3×3):\n")
X'X (3×3):print(XtX) [,1] [,2] [,3]
[1,] 5 15 15
[2,] 15 55 51
[3,] 15 51 55# Check positive definiteness
eigen_XtX <- eigen(XtX)
cat("\nEigenvalues of X'X:\n")
Eigenvalues of X'X:print(round(eigen_XtX$values, 4))[1] 110.2745 4.0000 0.7255cat("\nAll eigenvalues > 0 ✓\n")
All eigenvalues > 0 ✓cat("X'X is positive definite (because X has full column rank)\n")X'X is positive definite (because X has full column rank)# This guarantees unique solution to normal equations
cat("\nConsequence: Normal equations X'Xb = X'y have unique solution\n")
Consequence: Normal equations X'Xb = X'y have unique solutionCondition Number:
For positive definite matrices, the condition number measures numerical stability:
\[ \kappa(\mathbf{A}) = \frac{\lambda_{\max}}{\lambda_{\min}} \tag{16.64}\]
- \(\kappa = 1\): Perfectly conditioned (e.g., identity matrix)
- \(\kappa < 30\): Well-conditioned
- \(\kappa > 1000\): Ill-conditioned (numerical problems)
# Well-conditioned matrix
A1 <- diag(c(10, 9, 8))
eigen_A1 <- eigen(A1)
kappa1 <- max(eigen_A1$values) / min(eigen_A1$values)
cat("Well-conditioned matrix A1:\n")Well-conditioned matrix A1:print(A1) [,1] [,2] [,3]
[1,] 10 0 0
[2,] 0 9 0
[3,] 0 0 8cat(sprintf("\nCondition number: %.2f (well-conditioned)\n", kappa1))
Condition number: 1.25 (well-conditioned)# Ill-conditioned matrix
A2 <- matrix(c(1, 0.999, 0.999, 1), nrow = 2, ncol = 2, byrow = TRUE)
eigen_A2 <- eigen(A2)
kappa2 <- max(eigen_A2$values) / min(eigen_A2$values)
cat("\n\nIll-conditioned matrix A2:\n")
Ill-conditioned matrix A2:print(A2) [,1] [,2]
[1,] 1.000 0.999
[2,] 0.999 1.000cat(sprintf("\nCondition number: %.2f (ill-conditioned!)\n", kappa2))
Condition number: 1999.00 (ill-conditioned!)cat("\nHigh condition number means:\n")
High condition number means:cat(" - Small changes in data cause large changes in solution\n") - Small changes in data cause large changes in solutioncat(" - Numerical errors magnified\n") - Numerical errors magnifiedcat(" - Avoid if possible (center predictors, remove collinearity)\n") - Avoid if possible (center predictors, remove collinearity)Livestock Example - Multicollinearity:
Highly correlated predictors lead to near-singular \(\mathbf{X}'\mathbf{X}\) (large condition number).
# Swine data: body weight and two highly correlated measures
# x1 = backfat (mm), x2 = backfat measured at different location (highly correlated!)
x1 <- c(10, 12, 11, 13, 14)
x2 <- x1 + rnorm(5, 0, 0.1) # Nearly identical to x1
X <- cbind(1, x1, x2)
cat("Design matrix X with multicollinearity:\n")Design matrix X with multicollinearity:print(round(X, 2)) x1 x2
[1,] 1 10 9.96
[2,] 1 12 12.12
[3,] 1 11 11.04
[4,] 1 13 13.04
[5,] 1 14 14.01cat("\nCorrelation between x1 and x2:\n")
Correlation between x1 and x2:cat(sprintf("r = %.4f (very high!)\n", cor(x1, x2)))r = 0.9994 (very high!)XtX <- t(X) %*% X
cat("\nX'X:\n")
X'X:print(round(XtX, 2)) x1 x2
5.00 60.0 60.16
x1 60.00 730.0 732.09
x2 60.16 732.1 734.21# Check condition number
eigen_XtX <- eigen(XtX)
kappa <- max(eigen_XtX$values) / min(eigen_XtX$values)
cat("\nEigenvalues:\n")
Eigenvalues:print(round(eigen_XtX$values, 4))[1] 1469.1341 0.0694 0.0065cat(sprintf("\nCondition number: %.2f\n", kappa))
Condition number: 226498.60if (kappa > 30) {
cat("WARNING: Ill-conditioned matrix due to multicollinearity!\n")
cat("Solution:\n")
cat(" - Remove one of the highly correlated predictors\n")
cat(" - Use ridge regression\n")
cat(" - Use principal components\n")
}WARNING: Ill-conditioned matrix due to multicollinearity!
Solution:
- Remove one of the highly correlated predictors
- Use ridge regression
- Use principal componentsUsing Cholesky for Solving Linear Systems:
For positive definite A, solve \(\mathbf{Ax = b}\) using Cholesky:
- Factor: \(\mathbf{A = LL}'\)
- Solve \(\mathbf{Ly = b}\) (forward substitution)
- Solve \(\mathbf{L'x = y}\) (backward substitution)
This is faster and more stable than direct inversion.
# Positive definite system
A <- matrix(c(4, 2, 2, 5), nrow = 2, ncol = 2, byrow = TRUE)
b <- c(6, 8)
cat("System Ax = b:\n")System Ax = b:cat("A:\n")A:print(A) [,1] [,2]
[1,] 4 2
[2,] 2 5cat("b:", b, "\n")b: 6 8 # Method 1: Direct inverse (slower, less stable)
x1 <- solve(A) %*% b
cat("\nSolution via A^(-1)b:\n")
Solution via A^(-1)b:print(x1) [,1]
[1,] 0.875
[2,] 1.250# Method 2: Cholesky (faster, more stable)
L <- t(chol(A)) # Lower triangular
# Forward substitution: Ly = b
y <- forwardsolve(L, b)
# Backward substitution: L'x = y
x2 <- backsolve(t(L), y)
cat("\nSolution via Cholesky:\n")
Solution via Cholesky:print(x2)[1] 0.875 1.250cat("\nBoth methods give same result:\n")
Both methods give same result:all.equal(x1, x2, check.attributes = FALSE)[1] "target is matrix, current is numeric"cat("\nBut Cholesky is faster for large systems!\n")
But Cholesky is faster for large systems!Livestock Example - Variance-Covariance Matrix:
Variance-covariance matrices are always positive semi-definite (positive definite if full rank).
# Multi-trait data: 10 broilers, 3 traits
set.seed(456)
n <- 10
traits <- matrix(c(
rnorm(n, 2.5, 0.3), # Body weight (kg)
rnorm(n, 0.85, 0.05), # Breast yield (proportion)
rnorm(n, 0.45, 0.03) # Leg yield (proportion)
), nrow = n, ncol = 3)
colnames(traits) <- c("BodyWt", "Breast", "Leg")
cat("First 5 observations:\n")First 5 observations:print(round(head(traits, 5), 3)) BodyWt Breast Leg
[1,] 2.097 0.804 0.436
[2,] 2.687 0.916 0.398
[3,] 2.740 0.899 0.407
[4,] 2.083 0.933 0.456
[5,] 2.286 0.778 0.449# Covariance matrix
Sigma <- cov(traits)
cat("\nCovariance matrix Σ:\n")
Covariance matrix Σ:print(round(Sigma, 4)) BodyWt Breast Leg
BodyWt 0.0726 0.0087 -0.0017
Breast 0.0087 0.0039 0.0005
Leg -0.0017 0.0005 0.0010# Check positive definiteness
eigen_Sigma <- eigen(Sigma)
cat("\nEigenvalues:\n")
Eigenvalues:print(round(eigen_Sigma$values, 6))[1] 0.073707 0.002969 0.000704cat("\nAll eigenvalues > 0 ✓\n")
All eigenvalues > 0 ✓cat("Σ is positive definite (sample covariance with n > p)\n")Σ is positive definite (sample covariance with n > p)# Cholesky decomposition
L <- t(chol(Sigma))
cat("\nCholesky factor L:\n")
Cholesky factor L:print(round(L, 4)) BodyWt Breast Leg
BodyWt 0.2694 0.0000 0.0000
Breast 0.0325 0.0529 0.0000
Leg -0.0063 0.0124 0.0275cat("\nThis allows us to simulate correlated data: X = LZ where Z ~ N(0, I)\n")
This allows us to simulate correlated data: X = LZ where Z ~ N(0, I)
ImportantX’X and Positive Definiteness
For linear models:
- Full rank X → \(\mathbf{X}'\mathbf{X}\) is positive definite
- All eigenvalues > 0
- Invertible (unique solution exists)
- Use Cholesky for fast, stable solution
- Rank deficient X → \(\mathbf{X}'\mathbf{X}\) is positive semi-definite
- Some eigenvalues = 0
- Not invertible (need generalized inverse)
- Infinite solutions (use constraints)
Rule: Check eigenvalues of \(\mathbf{X}'\mathbf{X}\) to detect rank deficiency!
NoteCross-References
Positive definite matrices appear in:
- Week 2: Understanding when \(\mathbf{X}'\mathbf{X}\) is invertible
- Week 5: Variance-covariance matrix \(\text{Var}(\mathbf{b})\) is positive definite
- Week 11: Condition number for numerical stability
- Week 12: Rank deficiency and positive semi-definite matrices
- Section Section 16.11: Cholesky decomposition for solving systems
16.7.4 Singular Value Decomposition (SVD)
Definition:
Every m × n matrix A (rectangular or square) can be decomposed as:
\[ \mathbf{A} = \mathbf{U\Sigma V}' \tag{16.65}\]
where: - U is m × m orthogonal matrix (left singular vectors) - Σ is m × n diagonal matrix with singular values σ₁ ≥ σ₂ ≥ … ≥ σᵣ ≥ 0 - V is n × n orthogonal matrix (right singular vectors)
Key Properties:
- Always exists (even for non-square, rank-deficient matrices!)
- Singular values: σᵢ² are eigenvalues of \(\mathbf{A}'\mathbf{A}\) (or \(\mathbf{AA}'\))
- Rank: r(A) = number of non-zero singular values
- Condition number: κ(A) = σ₁/σᵣ (ratio of largest to smallest non-zero singular value)
- Moore-Penrose inverse: \(\mathbf{A}^+ = \mathbf{V\Sigma}^+\mathbf{U}'\) where Σ⁺ has 1/σᵢ for non-zero σᵢ
Why SVD Matters for Linear Models:
- Works for any matrix (square, rectangular, full rank, rank deficient)
- Provides most stable way to compute generalized inverses
- Reveals numerical rank of design matrix X
- Used in principal component regression
- Foundation for many modern algorithms
R Implementation:
# Example matrix
A <- matrix(c(4, 2, 2, 3), nrow = 2, ncol = 2, byrow = TRUE)
cat("Matrix A (2×2):\n")Matrix A (2×2):print(A) [,1] [,2]
[1,] 4 2
[2,] 2 3# Singular value decomposition
svd_A <- svd(A)
U <- svd_A$u
Sigma_values <- svd_A$d
V <- svd_A$v
cat("\nLeft singular vectors U (2×2):\n")
Left singular vectors U (2×2):print(round(U, 4)) [,1] [,2]
[1,] -0.7882 -0.6154
[2,] -0.6154 0.7882cat("\nSingular values:\n")
Singular values:print(round(Sigma_values, 4))[1] 5.562 1.438cat("\nRight singular vectors V (2×2):\n")
Right singular vectors V (2×2):print(round(V, 4)) [,1] [,2]
[1,] -0.7882 -0.6154
[2,] -0.6154 0.7882# Reconstruct A
Sigma <- diag(Sigma_values)
A_reconstructed <- U %*% Sigma %*% t(V)
cat("\nReconstructed A = UΣV':\n")
Reconstructed A = UΣV':print(round(A_reconstructed, 4)) [,1] [,2]
[1,] 4 2
[2,] 2 3cat("\nVerify reconstruction:\n")
Verify reconstruction:all.equal(A, A_reconstructed)[1] TRUESVD for Rectangular Matrices:
SVD works perfectly for non-square matrices (unlike eigenvalue decomposition).
# Design matrix (5×3)
X <- matrix(c(
1, 1, 2,
1, 2, 3,
1, 3, 1,
1, 4, 5,
1, 5, 4
), nrow = 5, ncol = 3, byrow = TRUE)
cat("Design matrix X (5×3):\n")Design matrix X (5×3):print(X) [,1] [,2] [,3]
[1,] 1 1 2
[2,] 1 2 3
[3,] 1 3 1
[4,] 1 4 5
[5,] 1 5 4# SVD
svd_X <- svd(X)
cat("\nSingular values:\n")
Singular values:print(round(svd_X$d, 4))[1] 10.5012 2.0000 0.8517cat(sprintf("\nRank: %d (number of non-zero singular values)\n", sum(svd_X$d > 1e-10)))
Rank: 3 (number of non-zero singular values)# U is 5×5, V is 3×3
cat(sprintf("\nDimensions: U is %d×%d, V is %d×%d\n",
nrow(svd_X$u), ncol(svd_X$u),
nrow(svd_X$v), ncol(svd_X$v)))
Dimensions: U is 5×3, V is 3×3Relationship to Eigenvalues:
For symmetric matrix A, SVD and eigenvalue decomposition are closely related.
A <- matrix(c(4, 2, 2, 3), nrow = 2, ncol = 2, byrow = TRUE)
# SVD
svd_A <- svd(A)
cat("Singular values from SVD:\n")Singular values from SVD:print(round(svd_A$d, 4))[1] 5.562 1.438# Eigenvalues
eigen_A <- eigen(A)
cat("\nEigenvalues from eigen():\n")
Eigenvalues from eigen():print(round(eigen_A$values, 4))[1] 5.562 1.438cat("\nFor symmetric matrices, singular values ≈ |eigenvalues|\n")
For symmetric matrices, singular values ≈ |eigenvalues|Computing Moore-Penrose Inverse via SVD:
\(\mathbf{A}^+ = \mathbf{V\Sigma}^+\mathbf{U}'\) where \((\Sigma^+)_{ii} = 1/\sigma_i\) if \(\sigma_i > 0\), else 0.
# Rank-deficient matrix
A <- matrix(c(1, 2, 2, 4), nrow = 2, ncol = 2, byrow = TRUE)
cat("Singular matrix A:\n")Singular matrix A:print(A) [,1] [,2]
[1,] 1 2
[2,] 2 4cat(sprintf("Determinant: %.1f (singular!)\n", det(A)))Determinant: 0.0 (singular!)# SVD
svd_A <- svd(A)
cat("\nSingular values:\n")
Singular values:print(svd_A$d)[1] 5.000e+00 1.986e-16# Moore-Penrose inverse via SVD
tol <- 1e-10
Sigma_plus <- ifelse(svd_A$d > tol, 1/svd_A$d, 0)
A_plus <- svd_A$v %*% diag(Sigma_plus) %*% t(svd_A$u)
cat("\nMoore-Penrose inverse A⁺:\n")
Moore-Penrose inverse A⁺:print(round(A_plus, 4)) [,1] [,2]
[1,] 0.04 0.08
[2,] 0.08 0.16# Verify AA⁺A = A
cat("\nVerify AA⁺A = A:\n")
Verify AA⁺A = A:AAminusA <- A %*% A_plus %*% A
print(round(AAminusA, 10)) [,1] [,2]
[1,] 1 2
[2,] 2 4cat("\nCompare with ginv():\n")
Compare with ginv():library(MASS)
A_ginv <- ginv(A)
print(round(A_ginv, 4)) [,1] [,2]
[1,] 0.04 0.08
[2,] 0.08 0.16cat("\nBoth give Moore-Penrose inverse ✓\n")
Both give Moore-Penrose inverse ✓Condition Number via SVD:
The condition number measures how close a matrix is to being singular.
# Well-conditioned matrix
A1 <- diag(c(10, 9, 8))
svd1 <- svd(A1)
kappa1 <- max(svd1$d) / min(svd1$d)
cat("Well-conditioned matrix A1:\n")Well-conditioned matrix A1:print(A1) [,1] [,2] [,3]
[1,] 10 0 0
[2,] 0 9 0
[3,] 0 0 8cat(sprintf("Condition number: %.2f\n", kappa1))Condition number: 1.25# Ill-conditioned matrix
A2 <- matrix(c(1, 1, 1.001, 1.001), nrow = 2, ncol = 2, byrow = TRUE)
svd2 <- svd(A2)
kappa2 <- max(svd2$d) / min(svd2$d)
cat("\n\nIll-conditioned matrix A2:\n")
Ill-conditioned matrix A2:print(A2) [,1] [,2]
[1,] 1.000 1.000
[2,] 1.001 1.001cat("Singular values:\n")Singular values:print(round(svd2$d, 6))[1] 2.001 0.000cat(sprintf("Condition number: %.2f (very high!)\n", kappa2))Condition number: Inf (very high!)cat("\nSmall singular value indicates near-singularity\n")
Small singular value indicates near-singularityLivestock Example - Detecting Rank Deficiency:
# ANOVA with missing cells: 3 breeds × 2 sexes, but some combinations missing
# breed 1, sex 1: observations 1, 2
# breed 1, sex 2: observation 3
# breed 2, sex 1: observations 4, 5
# breed 2, sex 2: missing!
# breed 3, sex 1: observation 6
# breed 3, sex 2: observations 7, 8
# Cell means model (will be rank deficient due to missing cell)
X <- matrix(0, nrow = 8, ncol = 6)
# Columns: B1S1, B1S2, B2S1, B2S2, B3S1, B3S2
X[1:2, 1] <- 1 # breed 1, sex 1
X[3, 2] <- 1 # breed 1, sex 2
X[4:5, 3] <- 1 # breed 2, sex 1
# Column 4 (B2S2) has no observations!
X[6, 5] <- 1 # breed 3, sex 1
X[7:8, 6] <- 1 # breed 3, sex 2
cat("Design matrix X (8×6) with missing cell:\n")Design matrix X (8×6) with missing cell:print(X) [,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 0 0 0 0 0
[2,] 1 0 0 0 0 0
[3,] 0 1 0 0 0 0
[4,] 0 0 1 0 0 0
[5,] 0 0 1 0 0 0
[6,] 0 0 0 0 1 0
[7,] 0 0 0 0 0 1
[8,] 0 0 0 0 0 1# SVD to detect rank
svd_X <- svd(X)
cat("\nSingular values:\n")
Singular values:print(round(svd_X$d, 6))[1] 1.414 1.414 1.414 1.000 1.000 0.000# Determine numerical rank
tol <- 1e-10
rank_X <- sum(svd_X$d > tol)
cat(sprintf("\nNumerical rank: %d (out of 6 parameters)\n", rank_X))
Numerical rank: 5 (out of 6 parameters)cat("Matrix is rank deficient due to missing cell!\n")Matrix is rank deficient due to missing cell!cat("\nConsequence: Must use generalized inverse or constraints\n")
Consequence: Must use generalized inverse or constraintsTruncated SVD (Low-Rank Approximation):
Keep only largest k singular values to approximate A.
\[ \mathbf{A}_k = \sum_{i=1}^{k} \sigma_i \mathbf{u}_i\mathbf{v}_i' \tag{16.66}\]
# Create noisy data matrix
set.seed(789)
true_signal <- matrix(c(1, 2, 3, 2, 4, 6), nrow = 3, ncol = 2)
noise <- matrix(rnorm(6, 0, 0.1), nrow = 3, ncol = 2)
A <- true_signal + noise
cat("Noisy matrix A (3×2):\n")Noisy matrix A (3×2):print(round(A, 2)) [,1] [,2]
[1,] 1.05 2.02
[2,] 1.77 3.96
[3,] 3.00 5.95# Full SVD
svd_A <- svd(A)
cat("\nSingular values:\n")
Singular values:print(round(svd_A$d, 4))[1] 8.2715 0.1774# Keep only largest singular value (rank-1 approximation)
A1 <- svd_A$d[1] * svd_A$u[, 1] %*% t(svd_A$v[, 1])
cat("\nRank-1 approximation (truncated SVD):\n")
Rank-1 approximation (truncated SVD):print(round(A1, 2)) [,1] [,2]
[1,] 1.00 2.04
[2,] 1.91 3.90
[3,] 2.93 5.99# Error
error_norm <- norm(A - A1, "F")
cat(sprintf("\nFrobenius norm of error: %.4f\n", error_norm))
Frobenius norm of error: 0.1774cat("\nTruncated SVD removes noise, keeps signal\n")
Truncated SVD removes noise, keeps signalLivestock Example - Principal Component Regression:
SVD provides principal components for regression.
# Swine data: highly correlated predictors
# y = average daily gain, X = backfat, loin depth, weight (all correlated)
set.seed(234)
n <- 20
# Create correlated predictors
backfat <- rnorm(n, 15, 2)
loin <- 70 - 2*backfat + rnorm(n, 0, 1) # Negatively correlated
weight <- 100 + 3*backfat + 0.5*loin + rnorm(n, 0, 2)
# Response
adg <- 0.8 + 0.01*backfat - 0.005*loin + 0.002*weight + rnorm(n, 0, 0.05)
# Design matrix (centered)
X <- scale(cbind(backfat, loin, weight), center = TRUE, scale = FALSE)
cat("Correlation matrix of predictors:\n")Correlation matrix of predictors:print(round(cor(X), 3)) backfat loin weight
backfat 1.000 -0.983 0.933
loin -0.983 1.000 -0.883
weight 0.933 -0.883 1.000cat("\nHigh correlations → multicollinearity!\n")
High correlations → multicollinearity!# SVD of X
svd_X <- svd(X)
cat("\nSingular values:\n")
Singular values:print(round(svd_X$d, 4))[1] 28.899 6.779 1.155# Condition number
kappa <- max(svd_X$d) / min(svd_X$d)
cat(sprintf("\nCondition number: %.2f (ill-conditioned)\n", kappa))
Condition number: 25.02 (ill-conditioned)# Principal components
PC <- X %*% svd_X$v
colnames(PC) <- c("PC1", "PC2", "PC3")
cat("\nPrincipal components (first 3 observations):\n")
Principal components (first 3 observations):print(round(head(PC, 3), 3)) PC1 PC2 PC3
[1,] -4.732 -0.984 0.049
[2,] 12.676 -0.159 -0.494
[3,] 6.694 -2.581 0.242cat("\nPCs are uncorrelated (orthogonal):\n")
PCs are uncorrelated (orthogonal):print(round(cor(PC), 6)) PC1 PC2 PC3
PC1 1 0 0
PC2 0 1 0
PC3 0 0 1cat("\nCan regress on PCs instead of original X to avoid multicollinearity\n")
Can regress on PCs instead of original X to avoid multicollinearityComparing Decompositions:
| Method | Matrix Type | Output | Use Case |
|---|---|---|---|
| Eigenvalue | Square only | \(\mathbf{A} = \mathbf{Q\Lambda Q}'\) | Symmetric matrices, \(\mathbf{X}'\mathbf{X}\) |
| SVD | Any (m×n) | \(\mathbf{A} = \mathbf{U\Sigma V}'\) | Rank deficiency, generalized inverse |
| Cholesky | Pos. definite | \(\mathbf{A} = \mathbf{LL}'\) | Fast solving, simulation |
| QR | Any (m×n) | \(\mathbf{A} = \mathbf{QR}\) | Stable LS solution |
A <- matrix(c(4, 2, 2, 5), nrow = 2, ncol = 2, byrow = TRUE)
cat("Symmetric positive definite matrix A:\n")Symmetric positive definite matrix A:print(A) [,1] [,2]
[1,] 4 2
[2,] 2 5# Eigenvalue decomposition
eigen_A <- eigen(A)
cat("\nEigenvalues:", round(eigen_A$values, 4), "\n")
Eigenvalues: 6.562 2.438 # SVD
svd_A <- svd(A)
cat("Singular values:", round(svd_A$d, 4), "\n")Singular values: 6.562 2.438 cat("\nFor symmetric matrices: singular values ≈ |eigenvalues|\n")
For symmetric matrices: singular values ≈ |eigenvalues|# Cholesky
L <- t(chol(A))
cat("\nCholesky factor L:\n")
Cholesky factor L:print(round(L, 4)) [,1] [,2]
[1,] 2 0
[2,] 1 2cat("\nAll decompositions reveal different aspects of same matrix\n")
All decompositions reveal different aspects of same matrix
ImportantSVD is THE Most General Decomposition
SVD works for any matrix: - Square or rectangular - Full rank or rank deficient - Symmetric or non-symmetric
Applications in Linear Models:
- Detect rank deficiency: Count non-zero singular values
- Compute generalized inverse: \(\mathbf{A}^+ = \mathbf{V\Sigma}^+\mathbf{U}'\)
- Assess numerical stability: Condition number = σ₁/σᵣ
- Principal component regression: Use V to transform predictors
- Data compression: Truncated SVD for dimensionality reduction
Computational Note: SVD is more expensive than eigenvalue decomposition but more robust.
NoteCross-References
SVD appears in:
- Week 2: Generalized inverse computation
- Week 11: Detecting numerical problems via condition number
- Week 12: Rank deficiency and generalized inverses
- Week 14: Principal component analysis and regression
- Section Section 16.11: Numerical considerations
16.8 Matrix Calculus for Linear Models
ImportantCritical Section
This section provides the mathematical foundation for deriving normal equations. It receives extra emphasis with detailed step-by-step derivations. Understanding these derivatives is essential for understanding where least squares estimates come from.
Matrix calculus extends ordinary calculus to functions involving vectors and matrices. In linear models, we use matrix derivatives primarily to minimize the sum of squared errors and derive the normal equations.
16.8.1 Vector and Matrix Derivatives
Notation and Conventions
When taking derivatives with respect to vectors, we must be careful about layout conventions. There are two main conventions:
- Numerator layout (preferred in this course): Result has same orientation as numerator
- Denominator layout: Result has same orientation as denominator
We use numerator layout throughout this course.
Scalar Function of a Vector
Let \(f: \mathbb{R}^n \to \mathbb{R}\) be a scalar-valued function of a vector \(\mathbf{x} = [x_1, x_2, \ldots, x_n]'\).
The gradient is:
\[ \frac{\partial f}{\partial \mathbf{x}} = \begin{bmatrix} \frac{\partial f}{\partial x_1} \\ \frac{\partial f}{\partial x_2} \\ \vdots \\ \frac{\partial f}{\partial x_n} \end{bmatrix} \tag{16.67}\]
This is an n × 1 column vector (numerator layout).
Example: If \(f(\mathbf{x}) = x_1^2 + 2x_2\), then:
\[ \frac{\partial f}{\partial \mathbf{x}} = \begin{bmatrix} 2x_1 \\ 2 \end{bmatrix} \]
Dimensions Matter
Always check dimensions: - If \(\mathbf{x}\) is n × 1 and \(f\) is scalar, then \(\frac{\partial f}{\partial \mathbf{x}}\) is n × 1 - If \(\mathbf{y}\) is m × 1 and \(\mathbf{x}\) is n × 1, then \(\frac{\partial \mathbf{y}}{\partial \mathbf{x}}\) is m × n (Jacobian)
Second Derivatives (Hessian Matrix)
The Hessian is the matrix of second partial derivatives:
\[ \frac{\partial^2 f}{\partial \mathbf{x} \partial \mathbf{x}'} = \mathbf{H} = \begin{bmatrix} \frac{\partial^2 f}{\partial x_1^2} & \frac{\partial^2 f}{\partial x_1 \partial x_2} & \cdots \\ \frac{\partial^2 f}{\partial x_2 \partial x_1} & \frac{\partial^2 f}{\partial x_2^2} & \cdots \\ \vdots & \vdots & \ddots \end{bmatrix} \tag{16.68}\]
This is an n × n matrix. If \(f\) has continuous second derivatives, H is symmetric.
NoteCaution: Not the Hat Matrix!
Don’t confuse the Hessian matrix H (from calculus) with the hat matrix H (from projections). Context makes it clear which is meant.
16.8.2 Basic Derivative Rules
Here are the essential matrix derivative rules for linear models:
Rule Table
| Expression | \(\frac{\partial}{\partial \mathbf{x}}\) | Dimensions | Notes |
|---|---|---|---|
| \(\mathbf{a}'\mathbf{x}\) | \(\mathbf{a}\) | n × 1 | a constant n × 1 |
| \(\mathbf{x}'\mathbf{a}\) | \(\mathbf{a}\) | n × 1 | Same as above |
| \(\mathbf{x}'\mathbf{x}\) | \(2\mathbf{x}\) | n × 1 | Quadratic |
| \(\mathbf{x}'\mathbf{A}\mathbf{x}\) | \(2\mathbf{A}\mathbf{x}\) | n × 1 | A symmetric n × n |
| \(\mathbf{x}'\mathbf{A}\mathbf{x}\) | \((\mathbf{A} + \mathbf{A}')\mathbf{x}\) | n × 1 | A not symmetric |
| \(\mathbf{A}\mathbf{x}\) | \(\mathbf{A}\) | m × n | A is m × n |
| \(\mathbf{x}'\mathbf{A}\) | \(\mathbf{A}'\) | n × m | Result w.r.t. x |
Most important for linear models: \(\frac{\partial}{\partial \boldsymbol{\beta}}[\mathbf{y}'\mathbf{X}\boldsymbol{\beta}] = \mathbf{X}'\mathbf{y}\)
where: - \(\mathbf{y}\) is n × 1 (data, constant w.r.t. \(\boldsymbol{\beta}\)) - \(\mathbf{X}\) is n × p (design matrix, constant) - \(\boldsymbol{\beta}\) is p × 1 (parameters, variable) - Result is p × 1
Detailed Derivations
1. Linear form: \(f(\mathbf{x}) = \mathbf{a}'\mathbf{x}\)
\[ f(\mathbf{x}) = a_1 x_1 + a_2 x_2 + \cdots + a_n x_n \]
\[ \frac{\partial f}{\partial \mathbf{x}} = \begin{bmatrix} a_1 \\ a_2 \\ \vdots \\ a_n \end{bmatrix} = \mathbf{a} \tag{16.69}\]
2. Quadratic form: \(f(\mathbf{x}) = \mathbf{x}'\mathbf{x}\)
\[ f(\mathbf{x}) = x_1^2 + x_2^2 + \cdots + x_n^2 \]
\[ \frac{\partial f}{\partial \mathbf{x}} = \begin{bmatrix} 2x_1 \\ 2x_2 \\ \vdots \\ 2x_n \end{bmatrix} = 2\mathbf{x} \tag{16.70}\]
3. Quadratic form with matrix: \(f(\mathbf{x}) = \mathbf{x}'\mathbf{A}\mathbf{x}\) where A** symmetric**
First, note that: \[ f(\mathbf{x}) = \sum_{i=1}^n \sum_{j=1}^n a_{ij} x_i x_j \]
Taking derivative with respect to \(x_k\): \[ \frac{\partial f}{\partial x_k} = \sum_{i=1}^n a_{ik} x_i + \sum_{j=1}^n a_{kj} x_j \]
Since A is symmetric (\(a_{ij} = a_{ji}\)): \[ \frac{\partial f}{\partial x_k} = 2\sum_{i=1}^n a_{ki} x_i = 2[\mathbf{A}\mathbf{x}]_k \]
Therefore: \[ \frac{\partial (\mathbf{x}'\mathbf{A}\mathbf{x})}{\partial \mathbf{x}} = 2\mathbf{A}\mathbf{x} \tag{16.71}\]
4. Product rule for \(\mathbf{y}'\mathbf{X}\boldsymbol{\beta}\) with respect to \(\boldsymbol{\beta}\)
Treating y and X as constants: \[ \mathbf{y}'\mathbf{X}\boldsymbol{\beta} = \sum_{i=1}^n \sum_{j=1}^p y_i X_{ij} \beta_j = \sum_{j=1}^p \left(\sum_{i=1}^n y_i X_{ij}\right) \beta_j \]
This is linear in \(\boldsymbol{\beta}\), so: \[ \frac{\partial (\mathbf{y}'\mathbf{X}\boldsymbol{\beta})}{\partial \boldsymbol{\beta}} = \begin{bmatrix} \sum_{i=1}^n y_i X_{i1} \\ \sum_{i=1}^n y_i X_{i2} \\ \vdots \\ \sum_{i=1}^n y_i X_{ip} \end{bmatrix} = \mathbf{X}'\mathbf{y} \tag{16.72}\]
R Verification with Numerical Derivatives
# Verify derivative rules numerically using finite differences
# Function to compute numerical gradient
numerical_gradient <- function(f, x, h = 1e-8) {
n <- length(x)
grad <- numeric(n)
for (i in 1:n) {
x_plus <- x
x_plus[i] <- x[i] + h
x_minus <- x
x_minus[i] <- x[i] - h
grad[i] <- (f(x_plus) - f(x_minus)) / (2 * h)
}
return(grad)
}
# Example 1: f(x) = a'x
a <- c(2, 3, 4)
f1 <- function(x) sum(a * x)
x0 <- c(1, 2, 3)
analytical1 <- a
numerical1 <- numerical_gradient(f1, x0)
cat("Example 1: f(x) = a'x\n")Example 1: f(x) = a'xcat("Analytical gradient:", analytical1, "\n")Analytical gradient: 2 3 4 cat("Numerical gradient:", numerical1, "\n")Numerical gradient: 2 3 4 cat("Agreement:", all.equal(analytical1, numerical1), "\n\n")Agreement: Mean relative difference: 3.298e-08 # Example 2: f(x) = x'x
f2 <- function(x) sum(x^2)
analytical2 <- 2 * x0
numerical2 <- numerical_gradient(f2, x0)
cat("Example 2: f(x) = x'x\n")Example 2: f(x) = x'xcat("Analytical gradient:", analytical2, "\n")Analytical gradient: 2 4 6 cat("Numerical gradient:", numerical2, "\n")Numerical gradient: 2 4 6 cat("Agreement:", all.equal(analytical2, numerical2), "\n\n")Agreement: TRUE # Example 3: f(x) = x'Ax with A symmetric
A <- matrix(c(2, 1, 1, 3), 2, 2) # 2x2 symmetric
f3 <- function(x) c(t(x) %*% A %*% x)
x0_2 <- c(1, 2)
analytical3 <- 2 * A %*% x0_2
numerical3 <- numerical_gradient(f3, x0_2)
cat("Example 3: f(x) = x'Ax (A symmetric)\n")Example 3: f(x) = x'Ax (A symmetric)cat("Analytical gradient:", analytical3, "\n")Analytical gradient: 8 14 cat("Numerical gradient:", numerical3, "\n")Numerical gradient: 8 14 cat("Agreement:", all.equal(c(analytical3), numerical3), "\n")Agreement: TRUE 16.8.3 Deriving Normal Equations
This is THE fundamental derivation in linear models. We’ll go step-by-step from minimizing sum of squared errors to the normal equations.
Setup
Given: - Response vector \(\mathbf{y}\): n × 1 (observed data) - Design matrix \(\mathbf{X}\): n × p (predictors, full rank) - Parameter vector \(\boldsymbol{\beta}\): p × 1 (unknown) - Model: \(\mathbf{y} = \mathbf{X}\boldsymbol{\beta} + \boldsymbol{\epsilon}\)
Goal: Find \(\boldsymbol{\beta}\) that minimizes sum of squared errors.
Step 1: Define the Sum of Squares Function
The residual vector is: \[ \mathbf{e} = \mathbf{y} - \mathbf{X}\boldsymbol{\beta} \tag{16.73}\]
The sum of squared errors is: \[ S(\boldsymbol{\beta}) = \mathbf{e}'\mathbf{e} = (\mathbf{y} - \mathbf{X}\boldsymbol{\beta})'(\mathbf{y} - \mathbf{X}\boldsymbol{\beta}) \tag{16.74}\]
This is a scalar-valued function of the p × 1 vector \(\boldsymbol{\beta}\).
Step 2: Expand the Sum of Squares
Expand using \((\mathbf{a} - \mathbf{b})'(\mathbf{a} - \mathbf{b}) = \mathbf{a}'\mathbf{a} - 2\mathbf{a}'\mathbf{b} + \mathbf{b}'\mathbf{b}\):
\[ \begin{align} S(\boldsymbol{\beta}) &= (\mathbf{y} - \mathbf{X}\boldsymbol{\beta})'(\mathbf{y} - \mathbf{X}\boldsymbol{\beta}) \\ &= \mathbf{y}'\mathbf{y} - \mathbf{y}'\mathbf{X}\boldsymbol{\beta} - \boldsymbol{\beta}'\mathbf{X}'\mathbf{y} + \boldsymbol{\beta}'\mathbf{X}'\mathbf{X}\boldsymbol{\beta} \end{align} \]
Since \(\mathbf{y}'\mathbf{X}\boldsymbol{\beta}\) is a scalar, it equals its transpose: \[ \mathbf{y}'\mathbf{X}\boldsymbol{\beta} = (\mathbf{y}'\mathbf{X}\boldsymbol{\beta})' = \boldsymbol{\beta}'\mathbf{X}'\mathbf{y} \]
Therefore: \[ S(\boldsymbol{\beta}) = \mathbf{y}'\mathbf{y} - 2\boldsymbol{\beta}'\mathbf{X}'\mathbf{y} + \boldsymbol{\beta}'\mathbf{X}'\mathbf{X}\boldsymbol{\beta} \tag{16.75}\]
Step 3: Take the Derivative with Respect to \(\boldsymbol{\beta}\)
Apply derivative rules to each term:
\(\frac{\partial}{\partial \boldsymbol{\beta}}[\mathbf{y}'\mathbf{y}] = \mathbf{0}\) (constant)
\(\frac{\partial}{\partial \boldsymbol{\beta}}[-2\boldsymbol{\beta}'\mathbf{X}'\mathbf{y}] = -2\mathbf{X}'\mathbf{y}\) (linear in \(\boldsymbol{\beta}\))
\(\frac{\partial}{\partial \boldsymbol{\beta}}[\boldsymbol{\beta}'\mathbf{X}'\mathbf{X}\boldsymbol{\beta}] = 2\mathbf{X}'\mathbf{X}\boldsymbol{\beta}\) (quadratic, \(\mathbf{X}'\mathbf{X}\) is symmetric)
Combining: \[ \frac{\partial S(\boldsymbol{\beta})}{\partial \boldsymbol{\beta}} = \mathbf{0} - 2\mathbf{X}'\mathbf{y} + 2\mathbf{X}'\mathbf{X}\boldsymbol{\beta} = -2\mathbf{X}'\mathbf{y} + 2\mathbf{X}'\mathbf{X}\boldsymbol{\beta} \tag{16.76}\]
Step 4: Set Derivative to Zero
For a minimum, set the gradient to zero: \[ -2\mathbf{X}'\mathbf{y} + 2\mathbf{X}'\mathbf{X}\boldsymbol{\beta} = \mathbf{0} \]
Divide by 2: \[ -\mathbf{X}'\mathbf{y} + \mathbf{X}'\mathbf{X}\boldsymbol{\beta} = \mathbf{0} \]
Rearrange: \[ \mathbf{X}'\mathbf{X}\boldsymbol{\beta} = \mathbf{X}'\mathbf{y} \tag{16.77}\]
These are the normal equations!
Step 5: Solve for \(\boldsymbol{\beta}\)
If \(\mathbf{X}'\mathbf{X}\) is invertible (i.e., X has full column rank): \[ \mathbf{b} = (\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}'\mathbf{y} \tag{16.78}\]
This is the least squares estimator.
Step 6: Verify it’s a Minimum (Second Derivative Test)
The Hessian (matrix of second derivatives) is: \[ \frac{\partial^2 S(\boldsymbol{\beta})}{\partial \boldsymbol{\beta} \partial \boldsymbol{\beta}'} = 2\mathbf{X}'\mathbf{X} \tag{16.79}\]
For a minimum, the Hessian must be positive definite. Since \(\mathbf{X}'\mathbf{X}\) is: - Symmetric (always) - Positive semi-definite (always): For any \(\mathbf{v}\), \(\mathbf{v}'\mathbf{X}'\mathbf{X}\mathbf{v} = (\mathbf{X}\mathbf{v})'(\mathbf{X}\mathbf{v}) = ||\mathbf{X}\mathbf{v}||^2 \geq 0\) - Positive definite if X has full rank: \(\mathbf{v}'\mathbf{X}'\mathbf{X}\mathbf{v} > 0\) for all \(\mathbf{v} \neq \mathbf{0}\)
Therefore, \(S(\boldsymbol{\beta})\) is convex and has a unique global minimum at \(\mathbf{b} = (\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}'\mathbf{y}\).
ImportantKey Result
The normal equations \(\mathbf{X}'\mathbf{X}\boldsymbol{\beta} = \mathbf{X}'\mathbf{y}\) are derived by:
- Minimizing \(S(\boldsymbol{\beta}) = (\mathbf{y} - \mathbf{X}\boldsymbol{\beta})'(\mathbf{y} - \mathbf{X}\boldsymbol{\beta})\)
- Taking derivative with respect to \(\boldsymbol{\beta}\)
- Setting to zero: \(\frac{\partial S}{\partial \boldsymbol{\beta}} = \mathbf{0}\)
This is the foundation of least squares estimation!
Complete Example: Simple Regression
# Simple regression: y = β₀ + β₁x + e
# Derive normal equations step-by-step
# Data: Broiler weight (kg) vs age (days)
age <- c(21, 28, 35, 42, 49)
weight <- c(0.5, 0.9, 1.4, 1.9, 2.3)
n <- length(age)
# Design matrix
X <- cbind(1, age)
y <- weight
p <- ncol(X)
cat("Step 1: Set up\n")Step 1: Set upcat("y:", y, "\n")y: 0.5 0.9 1.4 1.9 2.3 cat("X:\n")X:print(X) age
[1,] 1 21
[2,] 1 28
[3,] 1 35
[4,] 1 42
[5,] 1 49# Step 2: Define S(β) = (y - Xβ)'(y - Xβ)
# We'll evaluate S at several β values to visualize
# For visualization, use grid of β values
beta0_seq <- seq(-2, 2, length = 50)
beta1_seq <- seq(0, 0.08, length = 50)
S_grid <- matrix(NA, length(beta0_seq), length(beta1_seq))
for (i in 1:length(beta0_seq)) {
for (j in 1:length(beta1_seq)) {
beta <- c(beta0_seq[i], beta1_seq[j])
e <- y - X %*% beta
S_grid[i, j] <- sum(e^2)
}
}
cat("\n\nStep 3: Compute X'X and X'y\n")
Step 3: Compute X'X and X'yXtX <- t(X) %*% X
Xty <- t(X) %*% y
cat("X'X =\n")X'X =print(XtX) age
5 175
age 175 6615cat("\nX'y =\n")
X'y =print(Xty) [,1]
7.0
age 277.2cat("\n\nStep 4: Solve normal equations X'Xb = X'y\n")
Step 4: Solve normal equations X'Xb = X'yb <- solve(XtX) %*% Xty
cat("b = (X'X)^(-1) X'y =\n")b = (X'X)^(-1) X'y =print(b) [,1]
-0.90000
age 0.06571cat("\n\nStep 5: Verify this minimizes S(β)\n")
Step 5: Verify this minimizes S(β)e <- y - X %*% b
SSE <- sum(e^2)
cat("SSE at b:", SSE, "\n")SSE at b: 0.004 # Check derivative at solution is zero
grad_at_b <- -2 * Xty + 2 * XtX %*% b
cat("\nGradient at b (should be 0):\n")
Gradient at b (should be 0):print(grad_at_b) [,1]
1.954e-14
age 5.684e-13cat("Max absolute value:", max(abs(grad_at_b)), "\n")Max absolute value: 5.684e-13 # Verify second derivative is positive definite
hess <- 2 * XtX
cat("\nHessian = 2X'X =\n")
Hessian = 2X'X =print(hess) age
10 350
age 350 13230cat("Eigenvalues (should be > 0):", eigen(hess)$values, "\n")Eigenvalues (should be > 0): 13239 0.7402 # Compare with lm()
fit <- lm(weight ~ age)
cat("\n\nComparison with lm():\n")
Comparison with lm():cat("Our b:", c(b), "\n")Our b: -0.9 0.06571 cat("lm() coefficients:", coef(fit), "\n")lm() coefficients: -0.9 0.06571 cat("Agreement:", all.equal(c(b), unname(coef(fit))), "\n")Agreement: TRUE Numerical Verification: Gradient is Zero at Solution
# Define S(β) as a function
S_function <- function(beta, X, y) {
e <- y - X %*% beta
return(sum(e^2))
}
# Compute numerical gradient at solution
h <- 1e-8
grad_numerical <- numeric(p)
for (i in 1:p) {
b_plus <- b
b_plus[i] <- b[i] + h
b_minus <- b
b_minus[i] <- b[i] - h
grad_numerical[i] <- (S_function(b_plus, X, y) - S_function(b_minus, X, y)) / (2*h)
}
cat("Numerical gradient at b:", grad_numerical, "\n")Numerical gradient at b: 4.337e-10 -1.344e-09 cat("Should be approximately zero\n")Should be approximately zerocat("Max absolute value:", max(abs(grad_numerical)), "\n")Max absolute value: 1.344e-09 # Analytical gradient at solution (should be exactly 0)
grad_analytical <- -2 * t(X) %*% y + 2 * t(X) %*% X %*% b
cat("\nAnalytical gradient:", c(grad_analytical), "\n")
Analytical gradient: 1.954e-14 5.684e-13
TipUnderstanding the Derivation
The normal equations emerge from three fundamental calculus steps:
- Express the objective: \(S(\boldsymbol{\beta}) = (\mathbf{y} - \mathbf{X}\boldsymbol{\beta})'(\mathbf{y} - \mathbf{X}\boldsymbol{\beta})\)
- Take the gradient: \(\nabla S = -2\mathbf{X}'\mathbf{y} + 2\mathbf{X}'\mathbf{X}\boldsymbol{\beta}\)
- Set to zero: \(\mathbf{X}'\mathbf{X}\boldsymbol{\beta} = \mathbf{X}'\mathbf{y}\)
This is why least squares “works” - it’s a direct application of calculus to find the minimum of a convex function.
16.8.4 Useful Identities Table
Here are additional matrix calculus identities useful in linear models:
General Identities
| Expression | Derivative w.r.t. \(\mathbf{x}\) | Notes |
|---|---|---|
| \(\mathbf{c}\) | \(\mathbf{0}\) | Constant vector |
| \(\mathbf{A}\mathbf{x}\) | \(\mathbf{A}\) | A constant m × n |
| \(\mathbf{x}'\mathbf{A}\) | \(\mathbf{A}'\) | A constant |
| \(\mathbf{a}'\mathbf{x}\) | \(\mathbf{a}\) | Linear |
| \(\mathbf{x}'\mathbf{A}\mathbf{x}\) | \((\mathbf{A} + \mathbf{A}')\mathbf{x}\) | General A |
| \(\mathbf{x}'\mathbf{A}\mathbf{x}\) | \(2\mathbf{A}\mathbf{x}\) | A symmetric |
| \((\mathbf{A}\mathbf{x})'\mathbf{B}\mathbf{x}\) | \(\mathbf{A}'\mathbf{B}\mathbf{x} + \mathbf{B}'\mathbf{A}\mathbf{x}\) | Product rule |
| \(\mathbf{x}'\mathbf{A}\mathbf{x}\mathbf{b}\) | \(2\mathbf{A}\mathbf{x}\mathbf{b}'\) | Outer product |
Specific to Least Squares
| Quantity | Formula | Derivative w.r.t. \(\boldsymbol{\beta}\) |
|---|---|---|
| \(\mathbf{e}\) | \(\mathbf{y} - \mathbf{X}\boldsymbol{\beta}\) | \(-\mathbf{X}\) |
| \(\mathbf{e}'\mathbf{e}\) | SSE | \(-2\mathbf{X}'\mathbf{e} = -2\mathbf{X}'\mathbf{y} + 2\mathbf{X}'\mathbf{X}\boldsymbol{\beta}\) |
| \(\hat{\mathbf{y}}\) | \(\mathbf{X}\boldsymbol{\beta}\) | \(\mathbf{X}\) |
| \(\mathbf{y}'\mathbf{X}\boldsymbol{\beta}\) | Linear in \(\boldsymbol{\beta}\) | \(\mathbf{X}'\mathbf{y}\) |
| \(\boldsymbol{\beta}'\mathbf{X}'\mathbf{X}\boldsymbol{\beta}\) | Quadratic in \(\boldsymbol{\beta}\) | \(2\mathbf{X}'\mathbf{X}\boldsymbol{\beta}\) |
Chain Rule
If \(\mathbf{u} = \mathbf{u}(\mathbf{x})\) and \(f = f(\mathbf{u})\), then:
\[ \frac{\partial f}{\partial \mathbf{x}} = \frac{\partial \mathbf{u}}{\partial \mathbf{x}} \frac{\partial f}{\partial \mathbf{u}} \]
where \(\frac{\partial \mathbf{u}}{\partial \mathbf{x}}\) is the Jacobian matrix.
Example: If \(f = \mathbf{e}'\mathbf{e}\) where \(\mathbf{e} = \mathbf{y} - \mathbf{X}\boldsymbol{\beta}\):
\[ \frac{\partial f}{\partial \boldsymbol{\beta}} = \frac{\partial \mathbf{e}}{\partial \boldsymbol{\beta}} \frac{\partial (\mathbf{e}'\mathbf{e})}{\partial \mathbf{e}} = (-\mathbf{X})' (2\mathbf{e}) = -2\mathbf{X}'\mathbf{e} \]
NoteCross-References
- Week 5: Least Squares Theory - Uses these derivatives extensively
- Week 6: Multiple Regression - Applies to multiple predictors
- Week 8: Contrasts - Derivatives of contrast functions
ImportantSummary: Matrix Calculus Essentials
The three key results for linear models are:
- \(\frac{\partial}{\partial \boldsymbol{\beta}}[\mathbf{a}'\boldsymbol{\beta}] = \mathbf{a}\) - Linear terms
- \(\frac{\partial}{\partial \boldsymbol{\beta}}[\boldsymbol{\beta}'\mathbf{A}\boldsymbol{\beta}] = 2\mathbf{A}\boldsymbol{\beta}\) - Quadratic terms (A symmetric)
- \(\frac{\partial}{\partial \boldsymbol{\beta}}[(\mathbf{y} - \mathbf{X}\boldsymbol{\beta})'(\mathbf{y} - \mathbf{X}\boldsymbol{\beta})] = -2\mathbf{X}'\mathbf{y} + 2\mathbf{X}'\mathbf{X}\boldsymbol{\beta}\) - Normal equations
Master these three, and you understand the calculus foundation of linear models!
16.9 Kronecker Products
NoteFoundation for Advanced Topics
This section prepares you for Animal models and multi-trait analysis covered in future courses. Kronecker products provide the mathematical structure for variance-covariance matrices in multi-trait genetic evaluations.
16.9.1 Definition and Basic Properties
Definition:
The Kronecker product (also called direct product or tensor product) of matrix A (m × n) and matrix B (p × q) is:
\[ \mathbf{A} \otimes \mathbf{B} = \begin{bmatrix} a_{11}\mathbf{B} & a_{12}\mathbf{B} & \cdots & a_{1n}\mathbf{B} \\ a_{21}\mathbf{B} & a_{22}\mathbf{B} & \cdots & a_{2n}\mathbf{B} \\ \vdots & \vdots & \ddots & \vdots \\ a_{m1}\mathbf{B} & a_{m2}\mathbf{B} & \cdots & a_{mn}\mathbf{B} \end{bmatrix} \tag{16.80}\]
The result is an (mp) × (nq) matrix formed by replacing each element aij of A with the block aijB.
Simple Example:
\[ \begin{bmatrix} a_{11} & a_{12} \\ a_{21} & a_{22} \end{bmatrix} \otimes \begin{bmatrix} b_{11} & b_{12} \\ b_{21} & b_{22} \end{bmatrix} = \begin{bmatrix} a_{11}b_{11} & a_{11}b_{12} & a_{12}b_{11} & a_{12}b_{12} \\ a_{11}b_{21} & a_{11}b_{22} & a_{12}b_{21} & a_{12}b_{22} \\ a_{21}b_{11} & a_{21}b_{12} & a_{22}b_{11} & a_{22}b_{12} \\ a_{21}b_{21} & a_{21}b_{22} & a_{22}b_{21} & a_{22}b_{22} \end{bmatrix} \tag{16.81}\]
Basic Properties:
- Dimension: If A is m × n and B is p × q, then \(\mathbf{A} \otimes \mathbf{B}\) is (mp) × (nq)
- NOT commutative: \(\mathbf{A} \otimes \mathbf{B} \neq \mathbf{B} \otimes \mathbf{A}\) (generally)
- Associative: \((\mathbf{A} \otimes \mathbf{B}) \otimes \mathbf{C} = \mathbf{A} \otimes (\mathbf{B} \otimes \mathbf{C})\)
- Distributive: \((\mathbf{A} + \mathbf{B}) \otimes \mathbf{C} = \mathbf{A} \otimes \mathbf{C} + \mathbf{B} \otimes \mathbf{C}\)
R Implementation:
# Simple 2×2 matrices
A <- matrix(c(1, 2, 3, 4), nrow = 2, ncol = 2, byrow = TRUE)
B <- matrix(c(5, 6, 7, 8), nrow = 2, ncol = 2, byrow = TRUE)
cat("Matrix A (2×2):\n")Matrix A (2×2):print(A) [,1] [,2]
[1,] 1 2
[2,] 3 4cat("\nMatrix B (2×2):\n")
Matrix B (2×2):print(B) [,1] [,2]
[1,] 5 6
[2,] 7 8# Kronecker product
C <- kronecker(A, B) # or A %x% B
cat("\nA ⊗ B (4×4):\n")
A ⊗ B (4×4):print(C) [,1] [,2] [,3] [,4]
[1,] 5 6 10 12
[2,] 7 8 14 16
[3,] 15 18 20 24
[4,] 21 24 28 32cat(sprintf("\nDimension: %d×%d matrix (A is 2×2, B is 2×2 → product is 4×4)\n",
nrow(C), ncol(C)))
Dimension: 4×4 matrix (A is 2×2, B is 2×2 → product is 4×4)Non-Commutativity:
# A ⊗ B
AkronB <- A %x% B
# B ⊗ A
BkronA <- B %x% A
cat("A ⊗ B:\n")A ⊗ B:print(AkronB) [,1] [,2] [,3] [,4]
[1,] 5 6 10 12
[2,] 7 8 14 16
[3,] 15 18 20 24
[4,] 21 24 28 32cat("\nB ⊗ A:\n")
B ⊗ A:print(BkronA) [,1] [,2] [,3] [,4]
[1,] 5 10 6 12
[2,] 15 20 18 24
[3,] 7 14 8 16
[4,] 21 28 24 32cat("\nA ⊗ B ≠ B ⊗ A (not commutative!)\n")
A ⊗ B ≠ B ⊗ A (not commutative!)Kronecker Product with Vectors:
a <- c(1, 2)
b <- c(10, 20, 30)
# Kronecker product of vectors
c <- kronecker(a, b)
cat("Vector a:", a, "\n")Vector a: 1 2 cat("Vector b:", b, "\n")Vector b: 10 20 30 cat("\na ⊗ b:", c, "\n")
a ⊗ b: 10 20 30 20 40 60 cat("\nResult is a vector of length 2 × 3 = 6\n")
Result is a vector of length 2 × 3 = 6cat("Interpretation: [1*10, 1*20, 1*30, 2*10, 2*20, 2*30]\n")Interpretation: [1*10, 1*20, 1*30, 2*10, 2*20, 2*30]Identity Property:
\(\mathbf{I}_m \otimes \mathbf{I}_n = \mathbf{I}_{mn}\)
I2 <- diag(2)
I3 <- diag(3)
I_kron <- I2 %x% I3
cat("I₂ ⊗ I₃:\n")I₂ ⊗ I₃:print(I_kron) [,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 0 0 0 0 0
[2,] 0 1 0 0 0 0
[3,] 0 0 1 0 0 0
[4,] 0 0 0 1 0 0
[5,] 0 0 0 0 1 0
[6,] 0 0 0 0 0 1cat("\nResult is I₆ (6×6 identity matrix)\n")
Result is I₆ (6×6 identity matrix)all.equal(I_kron, diag(6))[1] TRUE16.9.2 Kronecker Product Rules
The Kronecker product has many useful algebraic properties that simplify calculations in multi-trait models.
Comprehensive Property Table:
| Property | Rule | Condition |
|---|---|---|
| Transpose | \((\mathbf{A} \otimes \mathbf{B})' = \mathbf{A}' \otimes \mathbf{B}'\) | Always |
| Product | \((\mathbf{A} \otimes \mathbf{B})(\mathbf{C} \otimes \mathbf{D}) = (\mathbf{AC}) \otimes (\mathbf{BD})\) | Dimensions compatible |
| Sum | \((\mathbf{A} + \mathbf{B}) \otimes \mathbf{C} = \mathbf{A} \otimes \mathbf{C} + \mathbf{B} \otimes \mathbf{C}\) | A, B same size |
| Scalar | \((c\mathbf{A}) \otimes \mathbf{B} = \mathbf{A} \otimes (c\mathbf{B}) = c(\mathbf{A} \otimes \mathbf{B})\) | Always |
| Inverse | \((\mathbf{A} \otimes \mathbf{B})^{-1} = \mathbf{A}^{-1} \otimes \mathbf{B}^{-1}\) | A, B invertible |
| Trace | \(\text{tr}(\mathbf{A} \otimes \mathbf{B}) = \text{tr}(\mathbf{A}) \cdot \text{tr}(\mathbf{B})\) | A, B square |
| Determinant | \(\det(\mathbf{A} \otimes \mathbf{B}) = \det(\mathbf{A})^q \cdot \det(\mathbf{B})^m\) | A (m×m), B (q×q) |
| Rank | \(r(\mathbf{A} \otimes \mathbf{B}) = r(\mathbf{A}) \cdot r(\mathbf{B})\) | Always |
| Eigenvalues | If λ eigenvalue of A, μ eigenvalue of B, then λμ eigenvalue of A ⊗ B | A, B square |
Verification of Key Properties:
A <- matrix(c(2, 1, 1, 2), nrow = 2, ncol = 2, byrow = TRUE)
B <- matrix(c(3, 0, 0, 1), nrow = 2, ncol = 2, byrow = TRUE)
cat("Matrix A (2×2):\n")Matrix A (2×2):print(A) [,1] [,2]
[1,] 2 1
[2,] 1 2cat("\nMatrix B (2×2):\n")
Matrix B (2×2):print(B) [,1] [,2]
[1,] 3 0
[2,] 0 1# Property 1: Transpose
AkronB <- A %x% B
trans_AkronB <- t(A %x% B)
A_trans_kron_B_trans <- t(A) %x% t(B)
cat("\n1. Transpose property:\n")
1. Transpose property:cat("(A ⊗ B)' equals A' ⊗ B'?", all.equal(trans_AkronB, A_trans_kron_B_trans), "\n")(A ⊗ B)' equals A' ⊗ B'? TRUE # Property 2: Trace
tr_AkronB <- sum(diag(A %x% B))
tr_A_times_tr_B <- sum(diag(A)) * sum(diag(B))
cat("\n2. Trace property:\n")
2. Trace property:cat(sprintf("tr(A ⊗ B) = %.1f\n", tr_AkronB))tr(A ⊗ B) = 16.0cat(sprintf("tr(A) × tr(B) = %.1f × %.1f = %.1f\n",
sum(diag(A)), sum(diag(B)), tr_A_times_tr_B))tr(A) × tr(B) = 4.0 × 4.0 = 16.0cat("Equal?", all.equal(tr_AkronB, tr_A_times_tr_B), "\n")Equal? TRUE # Property 3: Determinant
det_AkronB <- det(A %x% B)
det_formula <- det(A)^2 * det(B)^2 # A is 2×2, B is 2×2
cat("\n3. Determinant property:\n")
3. Determinant property:cat(sprintf("det(A ⊗ B) = %.1f\n", det_AkronB))det(A ⊗ B) = 81.0cat(sprintf("det(A)² × det(B)² = %.1f² × %.1f² = %.1f\n",
det(A), det(B), det_formula))det(A)² × det(B)² = 3.0² × 3.0² = 81.0cat("Equal?", all.equal(det_AkronB, det_formula), "\n")Equal? TRUE # Property 4: Rank
rank_AkronB <- qr(A %x% B)$rank
rank_product <- qr(A)$rank * qr(B)$rank
cat("\n4. Rank property:\n")
4. Rank property:cat(sprintf("r(A ⊗ B) = %d\n", rank_AkronB))r(A ⊗ B) = 4cat(sprintf("r(A) × r(B) = %d × %d = %d\n",
qr(A)$rank, qr(B)$rank, rank_product))r(A) × r(B) = 2 × 2 = 4cat("Equal?", rank_AkronB == rank_product, "\n")Equal? TRUE Inverse Property (Most Important!):
A <- matrix(c(4, 1, 1, 3), nrow = 2, ncol = 2, byrow = TRUE)
B <- matrix(c(2, 0, 0, 5), nrow = 2, ncol = 2, byrow = TRUE)
cat("Invertible matrix A:\n")Invertible matrix A:print(A) [,1] [,2]
[1,] 4 1
[2,] 1 3cat("\nInvertible matrix B:\n")
Invertible matrix B:print(B) [,1] [,2]
[1,] 2 0
[2,] 0 5# Form A ⊗ B
AkronB <- A %x% B
# Inverse of A ⊗ B (direct calculation)
AkronB_inv <- solve(A %x% B)
# Using property: (A ⊗ B)^(-1) = A^(-1) ⊗ B^(-1)
Ainv_kron_Binv <- solve(A) %x% solve(B)
cat("\n(A ⊗ B)^(-1) computed directly:\n")
(A ⊗ B)^(-1) computed directly:print(round(AkronB_inv, 4)) [,1] [,2] [,3] [,4]
[1,] 0.1364 0.0000 -0.0455 0.0000
[2,] 0.0000 0.0545 0.0000 -0.0182
[3,] -0.0455 0.0000 0.1818 0.0000
[4,] 0.0000 -0.0182 0.0000 0.0727cat("\nA^(-1) ⊗ B^(-1):\n")
A^(-1) ⊗ B^(-1):print(round(Ainv_kron_Binv, 4)) [,1] [,2] [,3] [,4]
[1,] 0.1364 0.0000 -0.0455 0.0000
[2,] 0.0000 0.0545 0.0000 -0.0182
[3,] -0.0455 0.0000 0.1818 0.0000
[4,] 0.0000 -0.0182 0.0000 0.0727cat("\nVerify they're equal:\n")
Verify they're equal:all.equal(AkronB_inv, Ainv_kron_Binv)[1] TRUEcat("\nThis property is CRUCIAL for inverting multi-trait covariance matrices!\n")
This property is CRUCIAL for inverting multi-trait covariance matrices!Product Rule (Mixed-Product Property):
\((\mathbf{A} \otimes \mathbf{B})(\mathbf{C} \otimes \mathbf{D}) = (\mathbf{AC}) \otimes (\mathbf{BD})\)
A <- matrix(c(1, 2, 3, 4), nrow = 2, ncol = 2, byrow = TRUE)
B <- matrix(c(5, 6, 7, 8), nrow = 2, ncol = 2, byrow = TRUE)
C <- matrix(c(2, 0, 0, 1), nrow = 2, ncol = 2, byrow = TRUE)
D <- matrix(c(1, 1, 1, 1), nrow = 2, ncol = 2, byrow = TRUE)
# Left side: (A ⊗ B)(C ⊗ D)
left_side <- (A %x% B) %*% (C %x% D)
# Right side: (AC) ⊗ (BD)
right_side <- (A %*% C) %x% (B %*% D)
cat("(A ⊗ B)(C ⊗ D) equals (AC) ⊗ (BD)?\n")(A ⊗ B)(C ⊗ D) equals (AC) ⊗ (BD)?all.equal(left_side, right_side)[1] TRUEcat("\nThis property simplifies matrix multiplications dramatically!\n")
This property simplifies matrix multiplications dramatically!Eigenvalue Property:
A <- matrix(c(3, 1, 1, 3), nrow = 2, ncol = 2, byrow = TRUE)
B <- matrix(c(2, 0, 0, 5), nrow = 2, ncol = 2, byrow = TRUE)
# Eigenvalues of A and B
eigen_A <- eigen(A)$values
eigen_B <- eigen(B)$values
cat("Eigenvalues of A:", round(eigen_A, 4), "\n")Eigenvalues of A: 4 2 cat("Eigenvalues of B:", round(eigen_B, 4), "\n")Eigenvalues of B: 5 2 # Eigenvalues of A ⊗ B should be all products λ_i * μ_j
AkronB <- A %x% B
eigen_AkronB <- eigen(AkronB)$values
cat("\nEigenvalues of A ⊗ B:\n")
Eigenvalues of A ⊗ B:print(round(sort(eigen_AkronB, decreasing = TRUE), 4))[1] 20 10 8 4# All products
all_products <- sort(c(outer(eigen_A, eigen_B)), decreasing = TRUE)
cat("\nAll products λ_i × μ_j:\n")
All products λ_i × μ_j:print(round(all_products, 4))[1] 20 10 8 4cat("\nThey match! ✓\n")
They match! ✓Vec Operator Property:
The vec operator stacks matrix columns into a vector. Key property:
\(\text{vec}(\mathbf{ABC}) = (\mathbf{C}' \otimes \mathbf{A})\text{vec}(\mathbf{B})\)
# Small example
A <- matrix(c(1, 2, 3, 4), nrow = 2, ncol = 2, byrow = TRUE)
B <- matrix(c(5, 6, 7, 8), nrow = 2, ncol = 2, byrow = TRUE)
C <- matrix(c(2, 0, 0, 1), nrow = 2, ncol = 2, byrow = TRUE)
# Compute ABC
ABC <- A %*% B %*% C
# vec(ABC) - stack columns
vec_ABC <- c(ABC)
cat("Matrix ABC:\n")Matrix ABC:print(ABC) [,1] [,2]
[1,] 38 22
[2,] 86 50cat("\nvec(ABC) (stacking columns):\n")
vec(ABC) (stacking columns):print(vec_ABC)[1] 38 86 22 50# Using property: vec(ABC) = (C' ⊗ A) vec(B)
vec_B <- c(B)
result <- (t(C) %x% A) %*% vec_B
cat("\n(C' ⊗ A) vec(B):\n")
(C' ⊗ A) vec(B):print(result) [,1]
[1,] 38
[2,] 86
[3,] 22
[4,] 50cat("\nVerify they're equal:\n")
Verify they're equal:all.equal(vec_ABC, c(result))[1] TRUEcat("\nThis property is used in vectorizing matrix equations\n")
This property is used in vectorizing matrix equations
TipKey Properties for Linear Models
The most important properties for linear models are:
- Inverse property: \((\mathbf{A} \otimes \mathbf{B})^{-1} = \mathbf{A}^{-1} \otimes \mathbf{B}^{-1}\)
- Used for inverting multi-trait covariance matrices
- Mixed-product property: \((\mathbf{A} \otimes \mathbf{B})(\mathbf{C} \otimes \mathbf{D}) = (\mathbf{AC}) \otimes (\mathbf{BD})\)
- Simplifies matrix multiplications in mixed model equations
- Vec operator: \(\text{vec}(\mathbf{ABC}) = (\mathbf{C}' \otimes \mathbf{A})\text{vec}(\mathbf{B})\)
- Used in derivative calculations and equation manipulation
16.9.3 Applications in Linear Models
Kronecker products are essential for structuring variance-covariance matrices in advanced linear models.
1. Multi-Trait Genetic Evaluation:
For t traits measured on n animals, the variance-covariance structure is often:
\[ \mathbf{Var}(\mathbf{y}) = \mathbf{G} \otimes \mathbf{A} \tag{16.82}\]
where: - G is t × t genetic covariance matrix between traits - A is n × n additive relationship matrix between animals - Result is (nt) × (nt) covariance matrix
# Simple example: 2 traits, 3 animals
# Genetic covariance matrix (2×2)
G <- matrix(c(
10, 3, # Var(trait1) = 10, Cov(trait1, trait2) = 3
3, 5 # Var(trait2) = 5
), nrow = 2, ncol = 2, byrow = TRUE)
# Relationship matrix (3×3) - simplified
A <- matrix(c(
1.0, 0.5, 0.0, # Animal 1 related to itself (1.0) and animal 2 (0.5)
0.5, 1.0, 0.25, # Animal 2 related to animals 1, 2, 3
0.0, 0.25, 1.0 # Animal 3
), nrow = 3, ncol = 3, byrow = TRUE)
cat("Genetic covariance matrix G (2×2):\n")Genetic covariance matrix G (2×2):print(G) [,1] [,2]
[1,] 10 3
[2,] 3 5cat("\nRelationship matrix A (3×3):\n")
Relationship matrix A (3×3):print(A) [,1] [,2] [,3]
[1,] 1.0 0.50 0.00
[2,] 0.5 1.00 0.25
[3,] 0.0 0.25 1.00# Full variance-covariance matrix
V <- G %x% A
cat("\nFull covariance matrix V = G ⊗ A (6×6):\n")
Full covariance matrix V = G ⊗ A (6×6):print(round(V, 2)) [,1] [,2] [,3] [,4] [,5] [,6]
[1,] 10.0 5.00 0.00 3.0 1.50 0.00
[2,] 5.0 10.00 2.50 1.5 3.00 0.75
[3,] 0.0 2.50 10.00 0.0 0.75 3.00
[4,] 3.0 1.50 0.00 5.0 2.50 0.00
[5,] 1.5 3.00 0.75 2.5 5.00 1.25
[6,] 0.0 0.75 3.00 0.0 1.25 5.00cat("\nInterpretation:\n")
Interpretation:cat(" - 6×6 matrix for 3 animals × 2 traits\n") - 6×6 matrix for 3 animals × 2 traitscat(" - Block structure reflects genetic correlations\n") - Block structure reflects genetic correlationscat(" - Animals related by pedigree have correlated breeding values\n") - Animals related by pedigree have correlated breeding values2. Repeated Measures / Longitudinal Data:
For measurements repeated over time, the covariance structure might be:
\[ \mathbf{Var}(\mathbf{y}) = \mathbf{I}_n \otimes \mathbf{\Sigma}_t \tag{16.83}\]
where: - In is n × n identity (animals are independent) - Σt is t × t covariance matrix across time points
# 4 animals, 3 time points each
n_animals <- 4
n_times <- 3
# Time covariance (AR(1) structure: correlation decreases with time)
rho <- 0.7 # Autocorrelation
Sigma_t <- matrix(c(
1.0, rho, rho^2,
rho, 1.0, rho,
rho^2, rho, 1.0
), nrow = 3, ncol = 3, byrow = TRUE)
cat("Time covariance matrix Σ_t (3×3):\n")Time covariance matrix Σ_t (3×3):print(round(Sigma_t, 3)) [,1] [,2] [,3]
[1,] 1.00 0.7 0.49
[2,] 0.70 1.0 0.70
[3,] 0.49 0.7 1.00# Full covariance: animals independent, but measurements within animal correlated
V <- diag(n_animals) %x% Sigma_t
cat("\nFull covariance V = I_4 ⊗ Σ_t (12×12):\n")
Full covariance V = I_4 ⊗ Σ_t (12×12):cat("(Showing first 6×6 block)\n")(Showing first 6×6 block)print(round(V[1:6, 1:6], 3)) [,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1.00 0.7 0.49 0.00 0.0 0.00
[2,] 0.70 1.0 0.70 0.00 0.0 0.00
[3,] 0.49 0.7 1.00 0.00 0.0 0.00
[4,] 0.00 0.0 0.00 1.00 0.7 0.49
[5,] 0.00 0.0 0.00 0.70 1.0 0.70
[6,] 0.00 0.0 0.00 0.49 0.7 1.00cat("\nBlock-diagonal structure: each 3×3 block is Σ_t for one animal\n")
Block-diagonal structure: each 3×3 block is Σ_t for one animal3. Multi-Trait Animal Model Preview:
The mixed model equations for multi-trait evaluation are:
\[ \begin{bmatrix} \mathbf{X}'(\mathbf{R} \otimes \mathbf{I})^{-1}\mathbf{X} & \mathbf{X}'(\mathbf{R} \otimes \mathbf{I})^{-1}\mathbf{Z} \\ \mathbf{Z}'(\mathbf{R} \otimes \mathbf{I})^{-1}\mathbf{X} & \mathbf{Z}'(\mathbf{R} \otimes \mathbf{I})^{-1}\mathbf{Z} + (\mathbf{G} \otimes \mathbf{A})^{-1} \end{bmatrix} \begin{bmatrix} \hat{\mathbf{b}} \\ \hat{\mathbf{u}} \end{bmatrix} = \begin{bmatrix} \mathbf{X}'(\mathbf{R} \otimes \mathbf{I})^{-1}\mathbf{y} \\ \mathbf{Z}'(\mathbf{R} \otimes \mathbf{I})^{-1}\mathbf{y} \end{bmatrix} \tag{16.84}\]
The inverse property is crucial: \((\mathbf{G} \otimes \mathbf{A})^{-1} = \mathbf{G}^{-1} \otimes \mathbf{A}^{-1}\)
# Simplified example: 2 traits, 4 animals
# Genetic covariance
G <- matrix(c(10, 3, 3, 5), nrow = 2, ncol = 2, byrow = TRUE)
# Relationship matrix (4 animals)
A <- matrix(c(
1.00, 0.50, 0.25, 0.00,
0.50, 1.00, 0.50, 0.25,
0.25, 0.50, 1.00, 0.50,
0.00, 0.25, 0.50, 1.00
), nrow = 4, ncol = 4, byrow = TRUE)
cat("G (2×2 genetic covariance):\n")G (2×2 genetic covariance):print(G) [,1] [,2]
[1,] 10 3
[2,] 3 5cat("\nA (4×4 relationship matrix):\n")
A (4×4 relationship matrix):print(A) [,1] [,2] [,3] [,4]
[1,] 1.00 0.50 0.25 0.00
[2,] 0.50 1.00 0.50 0.25
[3,] 0.25 0.50 1.00 0.50
[4,] 0.00 0.25 0.50 1.00# Form G ⊗ A
G_kron_A <- G %x% A
cat("\nG ⊗ A (8×8):\n")
G ⊗ A (8×8):cat("(Showing first 4×4 block)\n")(Showing first 4×4 block)print(round(G_kron_A[1:4, 1:4], 2)) [,1] [,2] [,3] [,4]
[1,] 10.0 5.0 2.5 0.0
[2,] 5.0 10.0 5.0 2.5
[3,] 2.5 5.0 10.0 5.0
[4,] 0.0 2.5 5.0 10.0# Inverse using property
G_inv <- solve(G)
A_inv <- solve(A)
inv_direct <- solve(G_kron_A)
inv_property <- G_inv %x% A_inv
cat("\nVerify (G ⊗ A)^(-1) = G^(-1) ⊗ A^(-1):\n")
Verify (G ⊗ A)^(-1) = G^(-1) ⊗ A^(-1):cat("Max difference:", max(abs(inv_direct - inv_property)), "\n")Max difference: 2.22e-16 cat("\nThis property makes inversion computationally feasible!\n")
This property makes inversion computationally feasible!cat("Instead of inverting 8×8, we invert 2×2 and 4×4 separately.\n")Instead of inverting 8×8, we invert 2×2 and 4×4 separately.4. Residual Covariance Structure:
For heterogeneous residual variances across traits:
\[ \mathbf{R} = \mathbf{R}_0 \otimes \mathbf{I}_n \tag{16.85}\]
where R0 is the residual covariance between traits.
# 3 traits with different residual variances and covariances
R0 <- matrix(c(
4.0, 0.5, 0.2, # Trait 1: var = 4.0
0.5, 2.0, 0.3, # Trait 2: var = 2.0
0.2, 0.3, 3.0 # Trait 3: var = 3.0
), nrow = 3, ncol = 3, byrow = TRUE)
n <- 5 # 5 animals
cat("Residual covariance between traits R₀ (3×3):\n")Residual covariance between traits R₀ (3×3):print(R0) [,1] [,2] [,3]
[1,] 4.0 0.5 0.2
[2,] 0.5 2.0 0.3
[3,] 0.2 0.3 3.0# Full residual covariance
R <- R0 %x% diag(n)
cat("\nFull residual covariance R = R₀ ⊗ I₅ (15×15):\n")
Full residual covariance R = R₀ ⊗ I₅ (15×15):cat("(Showing first 6×6 block)\n")(Showing first 6×6 block)print(round(R[1:6, 1:6], 2)) [,1] [,2] [,3] [,4] [,5] [,6]
[1,] 4.0 0 0 0 0 0.5
[2,] 0.0 4 0 0 0 0.0
[3,] 0.0 0 4 0 0 0.0
[4,] 0.0 0 0 4 0 0.0
[5,] 0.0 0 0 0 4 0.0
[6,] 0.5 0 0 0 0 2.0cat("\nStructure: Traits are correlated, but residuals across animals are independent\n")
Structure: Traits are correlated, but residuals across animals are independent5. Kronecker Structure in Design Matrices:
For factorial designs, the design matrix can often be written using Kronecker products.
# 2×3 factorial: 2 levels of factor A, 3 levels of factor B
# 2 replicates per cell
# Factor A design (2 levels)
X_A <- matrix(c(1, 0,
0, 1), nrow = 2, ncol = 2, byrow = TRUE)
# Factor B design (3 levels)
X_B <- matrix(c(1, 0, 0,
0, 1, 0,
0, 0, 1), nrow = 3, ncol = 3, byrow = TRUE)
cat("Factor A design:\n")Factor A design:print(X_A) [,1] [,2]
[1,] 1 0
[2,] 0 1cat("\nFactor B design:\n")
Factor B design:print(X_B) [,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 1 0
[3,] 0 0 1# Full factorial design (one observation per cell)
X_full <- X_A %x% X_B
cat("\nFull factorial design X_A ⊗ X_B (6×6):\n")
Full factorial design X_A ⊗ X_B (6×6):print(X_full) [,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 0 0 0 0 0
[2,] 0 1 0 0 0 0
[3,] 0 0 1 0 0 0
[4,] 0 0 0 1 0 0
[5,] 0 0 0 0 1 0
[6,] 0 0 0 0 0 1cat("\nEach row represents one cell in the 2×3 factorial\n")
Each row represents one cell in the 2×3 factorialLivestock Example - Multi-Trait Dairy Evaluation:
# Simplified dairy evaluation: 2 traits (milk yield, fat %), 6 cows
n_cows <- 6
n_traits <- 2
# Genetic covariance matrix
# Milk and fat % are genetically correlated
G <- matrix(c(
100, -5, # Var(milk) = 100, Cov = -5 (negative: higher milk → lower fat %)
-5, 4 # Var(fat%) = 4
), nrow = 2, ncol = 2, byrow = TRUE)
# Pedigree relationship (6 cows, 3 half-sib families)
A <- matrix(c(
1.00, 0.00, 0.00, 0.25, 0.25, 0.00,
0.00, 1.00, 0.50, 0.25, 0.25, 0.00,
0.00, 0.50, 1.00, 0.25, 0.25, 0.00,
0.25, 0.25, 0.25, 1.00, 0.50, 0.50,
0.25, 0.25, 0.25, 0.50, 1.00, 0.50,
0.00, 0.00, 0.00, 0.50, 0.50, 1.00
), nrow = 6, ncol = 6, byrow = TRUE)
cat("Genetic covariance G:\n")Genetic covariance G:print(G) [,1] [,2]
[1,] 100 -5
[2,] -5 4cat("\nAdditive relationship matrix A (6 cows):\n")
Additive relationship matrix A (6 cows):print(round(A, 2)) [,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1.00 0.00 0.00 0.25 0.25 0.0
[2,] 0.00 1.00 0.50 0.25 0.25 0.0
[3,] 0.00 0.50 1.00 0.25 0.25 0.0
[4,] 0.25 0.25 0.25 1.00 0.50 0.5
[5,] 0.25 0.25 0.25 0.50 1.00 0.5
[6,] 0.00 0.00 0.00 0.50 0.50 1.0# Variance of breeding values
Var_u <- G %x% A
cat("\nVariance of breeding values (12×12):\n")
Variance of breeding values (12×12):cat("(Showing correlation structure for first 4 observations)\n")(Showing correlation structure for first 4 observations)# Convert to correlation for easier interpretation
D <- diag(1/sqrt(diag(Var_u)))
Cor_u <- D %*% Var_u %*% D
print(round(Cor_u[1:4, 1:4], 3)) [,1] [,2] [,3] [,4]
[1,] 1.00 0.00 0.00 0.25
[2,] 0.00 1.00 0.50 0.25
[3,] 0.00 0.50 1.00 0.25
[4,] 0.25 0.25 0.25 1.00cat("\nInterpretation:\n")
Interpretation:cat(" - Breeding values for same cow's traits are correlated (genetic correlation)\n") - Breeding values for same cow's traits are correlated (genetic correlation)cat(" - Breeding values for related cows are correlated (pedigree)\n") - Breeding values for related cows are correlated (pedigree)cat(" - Kronecker structure captures both effects simultaneously\n") - Kronecker structure captures both effects simultaneously
ImportantWhy Kronecker Products Matter
In advanced linear models, Kronecker products:
- Provide compact notation for complex covariance structures
- Enable efficient inversion: \((\mathbf{A} \otimes \mathbf{B})^{-1} = \mathbf{A}^{-1} \otimes \mathbf{B}^{-1}\)
- Simplify mixed model equations for multi-trait analysis
- Extend naturally to Animal models and genetic evaluation
- Reduce storage requirements through structured sparsity
Without Kronecker products, multi-trait genetic evaluation would be computationally infeasible!
NoteCross-References
Kronecker products are foundational for:
- Week 14: Preview of mixed models with random effects
- Future courses: Multi-trait Animal models
- Future courses: Genomic selection with multiple traits
- Section Section 16.11: Efficient computation with Kronecker structure
16.9.4 Computational Considerations
CRITICAL RULE: Never Form Kronecker Products Explicitly!
For large matrices, explicitly computing \(\mathbf{A} \otimes \mathbf{B}\) is: - Memory intensive: (m×n) ⊗ (p×q) creates (mp) × (nq) matrix - Computationally expensive: O(mnpq) operations - Usually unnecessary: Can work implicitly using properties
Example of the Problem:
# Small matrices
A <- diag(100) # 100×100
B <- diag(50) # 50×50
# Their Kronecker product
# Would be 5000×5000 = 25 million elements!
cat(sprintf("A: %d×%d = %s elements\n",
nrow(A), ncol(A), format(nrow(A)*ncol(A), big.mark=",")))A: 100×100 = 10,000 elementscat(sprintf("B: %d×%d = %s elements\n",
nrow(B), ncol(B), format(nrow(B)*ncol(B), big.mark=",")))B: 50×50 = 2,500 elementscat(sprintf("A ⊗ B: %d×%d = %s elements!\n",
nrow(A)*nrow(B), ncol(A)*ncol(B),
format(nrow(A)*nrow(B)*ncol(A)*ncol(B), big.mark=",")))A ⊗ B: 5000×5000 = 25,000,000 elements!cat("\nForming explicitly would use excessive memory and time.\n")
Forming explicitly would use excessive memory and time.cat("Solution: Use implicit operations!\n")Solution: Use implicit operations!Strategy 1: Implicit Matrix-Vector Multiplication
Instead of forming \(\mathbf{C} = \mathbf{A} \otimes \mathbf{B}\) and computing \(\mathbf{Cx}\), use:
\[ (\mathbf{A} \otimes \mathbf{B})\mathbf{x} = \text{vec}(\mathbf{BXA}') \tag{16.86}\]
where X is the matrix formed by “unvectorizing” x.
# Smaller example for demonstration
A <- matrix(c(2, 1, 1, 3), nrow = 2, ncol = 2, byrow = TRUE)
B <- matrix(c(1, 2, 3, 4), nrow = 2, ncol = 2, byrow = TRUE)
x <- c(1, 2, 3, 4) # Vector to multiply
# Method 1: Explicit (bad for large matrices!)
C_explicit <- A %x% B
result_explicit <- C_explicit %*% x
cat("Explicit method result:\n")Explicit method result:print(result_explicit) [,1]
[1,] 21
[2,] 47
[3,] 38
[4,] 86# Method 2: Implicit (efficient!)
X <- matrix(x, nrow = nrow(B), ncol = nrow(A)) # Reshape x
result_implicit <- c(B %*% X %*% t(A)) # vec(BXA')
cat("\nImplicit method result:\n")
Implicit method result:print(result_implicit)[1] 21 47 38 86cat("\nVerify they're equal:\n")
Verify they're equal:all.equal(c(result_explicit), result_implicit)[1] TRUEcat("\nImplicit method avoids forming the 4×4 matrix A ⊗ B!\n")
Implicit method avoids forming the 4×4 matrix A ⊗ B!Strategy 2: Exploit Inverse Property
Instead of forming \((\mathbf{A} \otimes \mathbf{B})^{-1}\), use:
\[ (\mathbf{A} \otimes \mathbf{B})^{-1} = \mathbf{A}^{-1} \otimes \mathbf{B}^{-1} \tag{16.87}\]
Invert A and B separately (much cheaper!).
A <- matrix(c(4, 1, 1, 3), nrow = 2, ncol = 2, byrow = TRUE)
B <- matrix(c(5, 2, 2, 2), nrow = 2, ncol = 2, byrow = TRUE)
cat("Size comparison:\n")Size comparison:cat(sprintf("Inverting A (2×2): ~%d operations\n", 2^3))Inverting A (2×2): ~8 operationscat(sprintf("Inverting B (2×2): ~%d operations\n", 2^3))Inverting B (2×2): ~8 operationscat(sprintf("Total for A^(-1) ⊗ B^(-1): ~%d operations\n", 2^3 + 2^3))Total for A^(-1) ⊗ B^(-1): ~16 operationscat(sprintf("\nInverting A ⊗ B (4×4) directly: ~%d operations\n", 4^3))
Inverting A ⊗ B (4×4) directly: ~64 operationscat("\nSavings factor: ", 4^3 / (2^3 + 2^3), "×\n")
Savings factor: 4 ×# For larger matrices, savings are enormous
n_A <- 100
n_B <- 50
n_kron <- n_A * n_B
cat(sprintf("\nFor 100×100 and 50×50 matrices:\n"))
For 100×100 and 50×50 matrices:cat(sprintf("Direct inversion of %d×%d: ~%s operations\n",
n_kron, n_kron, format(n_kron^3, big.mark=",")))Direct inversion of 5000×5000: ~1.25e+11 operationscat(sprintf("Separate inversions: ~%s operations\n",
format(n_A^3 + n_B^3, big.mark=",")))Separate inversions: ~1,125,000 operationscat(sprintf("Savings: %.0f×\n", n_kron^3 / (n_A^3 + n_B^3)))Savings: 111111×Strategy 3: Solving Linear Systems
To solve \((\mathbf{A} \otimes \mathbf{B})\mathbf{x} = \mathbf{b}\):
- Reshape b into matrix B_mat
- Solve \(\mathbf{BYA}' = \mathbf{B_{mat}}\) for Y (use Sylvester equation solvers)
- Vectorize Y to get x
library(MASS) # For ginv if needed
# Small example
A <- matrix(c(2, 1, 1, 2), nrow = 2, ncol = 2, byrow = TRUE)
B <- matrix(c(3, 1, 1, 3), nrow = 2, ncol = 2, byrow = TRUE)
b <- c(1, 2, 3, 4)
# Method 1: Explicit (form A ⊗ B and solve)
AkronB <- A %x% B
x_explicit <- solve(AkronB, b)
cat("Explicit solution:\n")Explicit solution:print(x_explicit)[1] -0.12500 0.04167 0.37500 0.54167# Method 2: Using inverse property
Ainv <- solve(A)
Binv <- solve(B)
B_mat <- matrix(b, nrow = nrow(B), ncol = nrow(A))
Y <- Binv %*% B_mat %*% t(Ainv)
x_implicit <- c(Y)
cat("\nImplicit solution:\n")
Implicit solution:print(x_implicit)[1] -0.12500 0.04167 0.37500 0.54167cat("\nVerify they're equal:\n")
Verify they're equal:all.equal(x_explicit, x_implicit)[1] TRUEStrategy 4: Sparse Kronecker Products
If A or B is sparse, the Kronecker product is also sparse. Use sparse matrix representations.
library(Matrix) # For sparse matrices
# Sparse matrices (diagonal)
A_sparse <- Diagonal(n = 100, x = 1:100)
B_sparse <- Diagonal(n = 50, x = 1:50)
cat("Sparse matrix A:\n")Sparse matrix A:cat(sprintf(" Dimension: %d×%d\n", nrow(A_sparse), ncol(A_sparse))) Dimension: 100×100cat(sprintf(" Non-zero elements: %d (out of %s)\n",
length(A_sparse@x), format(nrow(A_sparse)^2, big.mark=","))) Non-zero elements: 100 (out of 10,000)cat("\nSparse matrix B:\n")
Sparse matrix B:cat(sprintf(" Dimension: %d×%d\n", nrow(B_sparse), ncol(B_sparse))) Dimension: 50×50cat(sprintf(" Non-zero elements: %d (out of %s)\n",
length(B_sparse@x), format(nrow(B_sparse)^2, big.mark=","))) Non-zero elements: 50 (out of 2,500)# Kronecker product of sparse matrices is sparse!
# (But still don't form explicitly unless necessary)
cat("\nA ⊗ B would be:\n")
A ⊗ B would be:cat(sprintf(" Dimension: %d×%d\n",
nrow(A_sparse)*nrow(B_sparse), ncol(A_sparse)*ncol(B_sparse))) Dimension: 5000×5000cat(sprintf(" Non-zero elements: ~%s (sparse!)\n",
format(length(A_sparse@x) * length(B_sparse@x), big.mark=","))) Non-zero elements: ~5,000 (sparse!)cat(sprintf(" Total elements: %s\n",
format(nrow(A_sparse)*nrow(B_sparse)*ncol(A_sparse)*ncol(B_sparse),
big.mark=","))) Total elements: 25,000,000cat(sprintf(" Sparsity: %.6f%%\n",
100 * length(A_sparse@x) * length(B_sparse@x) /
(nrow(A_sparse)*nrow(B_sparse)*ncol(A_sparse)*ncol(B_sparse)))) Sparsity: 0.020000%Strategy 5: Block Operations
When you must work with Kronecker products, exploit block structure:
\[ \mathbf{A} \otimes \mathbf{B} = \begin{bmatrix} a_{11}\mathbf{B} & a_{12}\mathbf{B} & \cdots \\ a_{21}\mathbf{B} & a_{22}\mathbf{B} & \cdots \\ \vdots & \vdots & \ddots \end{bmatrix} \tag{16.88}\]
Work with blocks aijB rather than individual elements.
# Example: Extract specific block
A <- matrix(1:4, nrow = 2, ncol = 2, byrow = TRUE)
B <- matrix(5:8, nrow = 2, ncol = 2, byrow = TRUE)
cat("Matrix A:\n")Matrix A:print(A) [,1] [,2]
[1,] 1 2
[2,] 3 4cat("\nMatrix B:\n")
Matrix B:print(B) [,1] [,2]
[1,] 5 6
[2,] 7 8# Don't form A ⊗ B
# Instead, if we need block (i,j), compute a_ij * B directly
i <- 1 # Row block
j <- 2 # Column block
# Block (1,2) of A ⊗ B = a_12 * B
block_12 <- A[i, j] * B
cat(sprintf("\nBlock (%d,%d) of A ⊗ B:\n", i, j))
Block (1,2) of A ⊗ B:print(block_12) [,1] [,2]
[1,] 10 12
[2,] 14 16# Verify by forming explicitly (for small example only!)
AkronB <- A %x% B
block_rows <- ((i-1)*nrow(B) + 1):(i*nrow(B))
block_cols <- ((j-1)*ncol(B) + 1):(j*ncol(B))
cat("\nVerify by extracting from explicit A ⊗ B:\n")
Verify by extracting from explicit A ⊗ B:print(AkronB[block_rows, block_cols]) [,1] [,2]
[1,] 10 12
[2,] 14 16cat("\nSame result, but block method avoids forming full matrix!\n")
Same result, but block method avoids forming full matrix!Livestock Example - Multi-Trait Mixed Model Equations:
# Realistic scenario: 2 traits, 1000 animals
n_traits <- 2
n_animals <- 1000
# Genetic covariance (2×2)
G <- matrix(c(10, 3, 3, 5), nrow = 2, ncol = 2, byrow = TRUE)
# We need (G ⊗ A)^(-1) where A is 1000×1000
# NEVER form the 2000×2000 matrix explicitly!
# Instead, use: (G ⊗ A)^(-1) = G^(-1) ⊗ A^(-1)
G_inv <- solve(G)
cat("Genetic covariance G (2×2):\n")Genetic covariance G (2×2):print(G) [,1] [,2]
[1,] 10 3
[2,] 3 5cat("\nG^(-1) (2×2):\n")
G^(-1) (2×2):print(round(G_inv, 4)) [,1] [,2]
[1,] 0.1220 -0.0732
[2,] -0.0732 0.2439cat(sprintf("\nFor mixed model equations with %d traits and %d animals:\n",
n_traits, n_animals))
For mixed model equations with 2 traits and 1000 animals:cat(sprintf(" - (G ⊗ A)^(-1) would be %d×%d matrix\n",
n_traits*n_animals, n_traits*n_animals)) - (G ⊗ A)^(-1) would be 2000×2000 matrixcat(sprintf(" - Storing explicitly: %.1f GB (at 8 bytes/element)\n",
(n_traits*n_animals)^2 * 8 / 1e9)) - Storing explicitly: 0.0 GB (at 8 bytes/element)cat("\nInstead:\n")
Instead:cat(sprintf(" - Store G^(-1): %d elements\n", n_traits^2)) - Store G^(-1): 4 elementscat(sprintf(" - Store A^(-1): %d elements (sparse!)\n", n_animals^2)) - Store A^(-1): 1000000 elements (sparse!)cat(" - Use implicit operations: vec(G^(-1) * A^(-1) * X)\n") - Use implicit operations: vec(G^(-1) * A^(-1) * X)cat("\nThis makes large-scale genetic evaluation computationally feasible!\n")
This makes large-scale genetic evaluation computationally feasible!Summary of Computational Best Practices:
cat("Kronecker Product Computational Best Practices:\n\n")Kronecker Product Computational Best Practices:cat("✓ DO:\n")✓ DO:cat(" 1. Use inverse property: (A ⊗ B)^(-1) = A^(-1) ⊗ B^(-1)\n") 1. Use inverse property: (A ⊗ B)^(-1) = A^(-1) ⊗ B^(-1)cat(" 2. Use implicit matrix-vector products: (A ⊗ B)x = vec(BXA')\n") 2. Use implicit matrix-vector products: (A ⊗ B)x = vec(BXA')cat(" 3. Exploit sparsity when A or B is sparse\n") 3. Exploit sparsity when A or B is sparsecat(" 4. Work with blocks: a_ij * B instead of full matrix\n") 4. Work with blocks: a_ij * B instead of full matrixcat(" 5. Use specialized solvers for Sylvester equations\n\n") 5. Use specialized solvers for Sylvester equationscat("✗ DON'T:\n")✗ DON'T:cat(" 1. Form A ⊗ B explicitly for large matrices\n") 1. Form A ⊗ B explicitly for large matricescat(" 2. Invert A ⊗ B directly - use the inverse property\n") 2. Invert A ⊗ B directly - use the inverse propertycat(" 3. Store full dense Kronecker products\n") 3. Store full dense Kronecker productscat(" 4. Ignore block structure\n\n") 4. Ignore block structurecat("Key insight: Kronecker structure is for NOTATION and THEORY.\n")Key insight: Kronecker structure is for NOTATION and THEORY.cat("For COMPUTATION, exploit the structure without forming the product!\n")For COMPUTATION, exploit the structure without forming the product!
WarningNever Form Large Kronecker Products Explicitly!
For G (2×2) and A (10,000×10,000): - G ⊗ A would be 20,000 × 20,000 = 400 million elements - At 8 bytes per element: 3.2 GB of memory! - And that’s just for storage - operations would be even worse
Solution: Use properties to avoid explicit formation: - Inverse: \((\mathbf{G} \otimes \mathbf{A})^{-1} = \mathbf{G}^{-1} \otimes \mathbf{A}^{-1}\) - Matrix-vector: \((\mathbf{G} \otimes \mathbf{A})\mathbf{x} = \text{vec}(\mathbf{AXG}')\) - Exploit sparsity of A
This is why modern genetic evaluation software can handle millions of animals!
NoteCross-References
Computational considerations appear in:
- Week 11: Numerical stability and efficient algorithms
- Week 12: Sparse matrix methods for large systems
- Section Section 16.11: General computational best practices
- Future courses: Sparse matrix methods in genomic evaluation
16.10 Matrix Identities for Linear Models
16.10.1 Identities for X, H, and Projections
This section provides a comprehensive reference table of matrix identities frequently used in linear models. These identities are essential for deriving least squares properties (Week 5), understanding ANOVA decompositions (Weeks 7-9), and working with rank-deficient models (Week 12).
NoteWhy These Identities Matter
These identities allow you to:
- Simplify complex matrix expressions
- Prove properties of least squares estimators
- Derive variance formulas without tedious algebra
- Verify computational results
Pro tip: Keep this table handy during theoretical derivations!
Key Projection Matrix Identities
Let \(\mathbf{X}\) be an \(n \times p\) design matrix with full column rank, \(\mathbf{H} = \mathbf{X}(\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}'\) be the hat matrix, and \(\mathbf{M} = \mathbf{I}_n - \mathbf{H}\) be the residual maker.
Table of Fundamental Identities:
| Identity | Name/Description | Reference |
|---|---|---|
| \(\mathbf{H}' = \mathbf{H}\) | \(\mathbf{H}\) is symmetric | Section 16.6.1 |
| \(\mathbf{H}^2 = \mathbf{H}\) | \(\mathbf{H}\) is idempotent | Section 16.6.1 |
| \(\mathbf{H}\mathbf{X} = \mathbf{X}\) | Projects \(\mathbf{X}\) onto itself | Section 16.6.1 |
| \(\mathbf{M}' = \mathbf{M}\) | \(\mathbf{M}\) is symmetric | Section 16.6.1 |
| \(\mathbf{M}^2 = \mathbf{M}\) | \(\mathbf{M}\) is idempotent | Section 16.6.1 |
| \(\mathbf{M}\mathbf{X} = \mathbf{0}\) | Residuals orthogonal to \(\mathbf{X}\) | Week 5 |
| \(\mathbf{H}\mathbf{M} = \mathbf{0}\) | Orthogonal projections | Section 16.6.1 |
| \(\mathbf{M}\mathbf{H} = \mathbf{0}\) | Orthogonal projections | Section 16.6.1 |
| \(\text{tr}(\mathbf{H}) = p\) | Trace equals rank | Section 16.4.2 |
| \(\text{tr}(\mathbf{M}) = n - p\) | Trace equals error df | Section 16.4.2 |
| \(\mathbf{H} + \mathbf{M} = \mathbf{I}_n\) | Partition of identity | Section 16.6.1 |
| \(r(\mathbf{H}) = p\) | Rank of hat matrix | Section 16.4.1 |
| \(r(\mathbf{M}) = n - p\) | Rank of residual maker | Section 16.4.1 |
Identities Involving Normal Equations
For \(\mathbf{X}'\mathbf{X}\mathbf{b} = \mathbf{X}'\mathbf{y}\):
| Identity | Interpretation | When Used |
|---|---|---|
| \(\mathbf{b} = (\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}'\mathbf{y}\) | LS solution | Week 4, 5, 6 |
| \(\hat{\mathbf{y}} = \mathbf{X}\mathbf{b} = \mathbf{H}\mathbf{y}\) | Fitted values are projection | Week 5 |
| \(\mathbf{e} = \mathbf{y} - \hat{\mathbf{y}} = \mathbf{M}\mathbf{y}\) | Residuals are projection | Week 5 |
| \(\mathbf{X}'\mathbf{e} = \mathbf{0}\) | Normal equations satisfied | Week 5 |
| \(\mathbf{X}'\hat{\mathbf{y}} = \mathbf{X}'\mathbf{y}\) | Key orthogonality | Week 5 |
| \(\hat{\mathbf{y}}'\mathbf{e} = \mathbf{0}\) | Fitted values ⊥ residuals | Week 5 |
Rank Identities
These are critical for understanding non-full rank models (Week 12):
| Identity | Condition | Reference |
|---|---|---|
| \(r(\mathbf{X}'\mathbf{X}) = r(\mathbf{X})\) | Always | Section 16.4.1 |
| \(r(\mathbf{X}'\mathbf{X}) \leq \min(n, p)\) | Always | Section 16.4.1 |
| \(r(\mathbf{AB}) \leq \min(r(\mathbf{A}), r(\mathbf{B}))\) | General rule | Section 16.4.1 |
| \(r(\mathbf{A} + \mathbf{B}) \leq r(\mathbf{A}) + r(\mathbf{B})\) | Sum of matrices | Section 16.4.1 |
| \(r(\mathbf{A}'\mathbf{A}) = r(\mathbf{A})\) | Gram matrix | Section 16.4.1 |
R Code to Verify Identities
# Simple regression example: Broiler weight vs. age
age <- c(21, 28, 35, 42, 49, 56) # days
weight <- c(0.5, 0.9, 1.4, 1.9, 2.5, 3.0) # kg
n <- length(weight)
X <- cbind(1, age) # Design matrix
p <- ncol(X)
# Compute projection matrices
XtX <- t(X) %*% X
XtX_inv <- solve(XtX)
H <- X %*% XtX_inv %*% t(X)
M <- diag(n) - H
# Verify symmetry
cat("H is symmetric:", all.equal(H, t(H)), "\n")H is symmetric: TRUE cat("M is symmetric:", all.equal(M, t(M)), "\n")M is symmetric: TRUE # Verify idempotence
cat("H is idempotent:", all.equal(H %*% H, H), "\n")H is idempotent: TRUE cat("M is idempotent:", all.equal(M %*% M, M), "\n")M is idempotent: TRUE # Verify orthogonality
cat("HM = 0:", all.equal(H %*% M, matrix(0, n, n), check.attributes = FALSE), "\n")HM = 0: TRUE cat("MH = 0:", all.equal(M %*% H, matrix(0, n, n), check.attributes = FALSE), "\n")MH = 0: TRUE # Verify trace properties
cat("tr(H) =", sum(diag(H)), "(should be", p, ")\n")tr(H) = 2 (should be 2 )cat("tr(M) =", sum(diag(M)), "(should be", n - p, ")\n")tr(M) = 4 (should be 4 )# Verify partition of identity
cat("H + M = I:", all.equal(H + M, diag(n)), "\n")H + M = I: TRUE # Verify rank (using tolerance for numerical issues)
cat("r(H) =", qr(H)$rank, "(should be", p, ")\n")r(H) = 2 (should be 2 )cat("r(M) =", qr(M)$rank, "(should be", n - p, ")\n")r(M) = 4 (should be 4 )# Verify MX = 0
cat("MX = 0:", all.equal(M %*% X, matrix(0, n, p), check.attributes = FALSE), "\n")MX = 0: TRUE # Verify HX = X
cat("HX = X:", all.equal(H %*% X, X), "\n")HX = X: TRUE Practical Application: Verifying Orthogonality
Example: Dairy cow milk yield regression on days in milk.
# Simulated data: n=8 Holstein cows
dim <- c(30, 60, 90, 120, 150, 180, 210, 240) # Days in milk
milk <- c(35, 38, 36, 33, 30, 27, 24, 21) # kg/day (lactation curve)
# Fit model
X <- cbind(1, dim)
y <- milk
n <- length(y)
# Solve normal equations
b <- solve(t(X) %*% X) %*% t(X) %*% y
# Compute fitted values and residuals
y_hat <- X %*% b
e <- y - y_hat
# Verify key identities
cat("X'e should be zero:\n")X'e should be zero:print(t(X) %*% e) [,1]
9.237e-14
dim 1.057e-11cat("\ny_hat'e should be zero:", t(y_hat) %*% e, "\n")
y_hat'e should be zero: 2.952e-12 cat("\nX'y_hat should equal X'y:\n")
X'y_hat should equal X'y:cat("X'y_hat:\n")X'y_hat:print(t(X) %*% y_hat) [,1]
244
dim 29970cat("X'y:\n")X'y:print(t(X) %*% y) [,1]
244
dim 29970cat("Equal?", all.equal(t(X) %*% y_hat, t(X) %*% y), "\n")Equal? TRUE
WarningNumerical Precision
When verifying identities computationally, use all.equal() instead of == because:
- Floating-point arithmetic introduces small errors
- Matrix operations accumulate rounding errors
all.equal()uses tolerance (default: \(1.5 \times 10^{-8}\))
Example of what NOT to do:
# BAD - Too strict!
if (sum(t(X) %*% e) == 0) {
cat("X'e is zero\n") # Might fail due to rounding
}
# GOOD - Tolerant comparison
if (all.equal(t(X) %*% e, matrix(0, 2, 1), check.attributes = FALSE)) {
cat("X'e is zero (within tolerance)\n")
}Useful Compound Identities
These appear frequently in variance derivations (see Section 16.10.2):
| Identity | Expanded Form | Used For |
|---|---|---|
| \(\mathbf{y}'\mathbf{H}\mathbf{y}\) | \(\mathbf{b}'\mathbf{X}'\mathbf{y}\) | SSR (model sum of squares) |
| \(\mathbf{y}'\mathbf{M}\mathbf{y}\) | \(\mathbf{y}'\mathbf{y} - \mathbf{b}'\mathbf{X}'\mathbf{y}\) | SSE (error sum of squares) |
| \(\mathbf{y}'(\mathbf{H} + \mathbf{M})\mathbf{y}\) | \(\mathbf{y}'\mathbf{y}\) | Total sum of squares |
| \(\text{E}(\mathbf{y}'\mathbf{H}\mathbf{y})\) | \(\mathbf{X}\boldsymbol{\beta})'\mathbf{H}(\mathbf{X}\boldsymbol{\beta}) + \sigma^2 p\) | Expected SSR |
| \(\text{E}(\mathbf{y}'\mathbf{M}\mathbf{y})\) | \(\sigma^2(n-p)\) | Expected SSE |
Derivation example (Expected SSE):
\[ \begin{align} \text{E}(\mathbf{y}'\mathbf{M}\mathbf{y}) &= \text{E}[(\mathbf{X}\boldsymbol{\beta} + \mathbf{e})'\mathbf{M}(\mathbf{X}\boldsymbol{\beta} + \mathbf{e})] \\ &= \text{E}[\mathbf{e}'\mathbf{M}\mathbf{e}] \quad \text{(since } \mathbf{M}\mathbf{X} = \mathbf{0}) \\ &= \text{E}[\text{tr}(\mathbf{e}'\mathbf{M}\mathbf{e})] \\ &= \text{E}[\text{tr}(\mathbf{M}\mathbf{e}\mathbf{e}')] \quad \text{(trace is cyclic)} \\ &= \text{tr}(\mathbf{M} \cdot \text{E}[\mathbf{e}\mathbf{e}']) \\ &= \text{tr}(\mathbf{M} \cdot \sigma^2\mathbf{I}_n) \\ &= \sigma^2 \text{tr}(\mathbf{M}) \\ &= \sigma^2(n - p) \end{align} \]
This derivation appears in Week 5 when proving that \(\hat{\sigma}^2 = \text{SSE}/(n-p)\) is unbiased.
16.10.2 Variance and Covariance Formulas
This section presents key variance and covariance formulas for linear models. These formulas are derived in Week 5 and used throughout the course for constructing confidence intervals (Week 6), testing contrasts (Week 8), and understanding precision of estimates.
General Variance Formula
For a linear model \(\mathbf{y} \sim N(\mathbf{X}\boldsymbol{\beta}, \sigma^2\mathbf{I}_n)\), and any matrix \(\mathbf{A}\):
\[ \text{Var}(\mathbf{Ay}) = \mathbf{A} \cdot \text{Var}(\mathbf{y}) \cdot \mathbf{A}' = \mathbf{A} \cdot \sigma^2\mathbf{I}_n \cdot \mathbf{A}' = \sigma^2 \mathbf{A}\mathbf{A}' \]
This single formula generates all variance formulas below!
TipMemory Aid
To find the variance of ANY linear combination \(\mathbf{Ay}\):
- Write down \(\mathbf{A}\)
- Compute \(\mathbf{A}\mathbf{A}'\)
- Multiply by \(\sigma^2\)
That’s it!
Variance of Least Squares Estimator
For \(\mathbf{b} = (\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}'\mathbf{y}\):
\[ \begin{align} \text{Var}(\mathbf{b}) &= \text{Var}[(\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}'\mathbf{y}] \\ &= (\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}' \cdot \sigma^2\mathbf{I}_n \cdot \mathbf{X}(\mathbf{X}'\mathbf{X})^{-1} \\ &= \sigma^2 (\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}'\mathbf{X}(\mathbf{X}'\mathbf{X})^{-1} \\ &= \sigma^2 (\mathbf{X}'\mathbf{X})^{-1} \end{align} \]
Key properties:
- Standard errors: \(\text{se}(b_j) = \sqrt{\hat{\sigma}^2 [(\mathbf{X}'\mathbf{X})^{-1}]_{jj}}\)
- Diagonal elements of \((\mathbf{X}'\mathbf{X})^{-1}\) give variances
- Off-diagonal elements give covariances between estimates
Variance of Fitted Values
For \(\hat{\mathbf{y}} = \mathbf{H}\mathbf{y}\):
\[ \text{Var}(\hat{\mathbf{y}}) = \text{Var}(\mathbf{H}\mathbf{y}) = \sigma^2 \mathbf{H}\mathbf{H}' = \sigma^2 \mathbf{H} \]
(using \(\mathbf{H}' = \mathbf{H}\) and \(\mathbf{H}^2 = \mathbf{H}\))
For a specific fitted value \(\hat{y}_i\):
\[ \text{Var}(\hat{y}_i) = \sigma^2 h_{ii} \]
where \(h_{ii}\) is the \(i\)-th diagonal element of \(\mathbf{H}\) (the “leverage” of observation \(i\)).
Variance of Residuals
For \(\mathbf{e} = \mathbf{M}\mathbf{y}\):
\[ \text{Var}(\mathbf{e}) = \text{Var}(\mathbf{M}\mathbf{y}) = \sigma^2 \mathbf{M}\mathbf{M}' = \sigma^2 \mathbf{M} \]
For a specific residual \(e_i\):
\[ \text{Var}(e_i) = \sigma^2 (1 - h_{ii}) \]
Note: Residuals have different variances (heteroscedastic), even though errors are homoscedastic!
Variance of Predictions
For a new observation with predictor values \(\mathbf{x}_0\) (a \(p \times 1\) vector):
\[ \hat{y}_0 = \mathbf{x}_0'\mathbf{b} \]
Variance:
\[ \text{Var}(\hat{y}_0) = \text{Var}(\mathbf{x}_0'\mathbf{b}) = \mathbf{x}_0' \cdot \text{Var}(\mathbf{b}) \cdot \mathbf{x}_0 = \sigma^2 \mathbf{x}_0'(\mathbf{X}'\mathbf{X})^{-1}\mathbf{x}_0 \]
Prediction interval accounts for both estimation uncertainty AND observation error:
\[ \text{Var}(y_0 - \hat{y}_0) = \sigma^2 [1 + \mathbf{x}_0'(\mathbf{X}'\mathbf{X})^{-1}\mathbf{x}_0] \]
NoteConfidence Interval vs. Prediction Interval
- Confidence interval for \(\text{E}(y_0)\): Uses \(\text{Var}(\hat{y}_0) = \sigma^2 \mathbf{x}_0'(\mathbf{X}'\mathbf{X})^{-1}\mathbf{x}_0\)
- Prediction interval for new observation \(y_0\): Adds \(\sigma^2\) for observation error
Prediction intervals are ALWAYS wider!
Variance of Linear Contrasts
For a contrast \(\mathbf{c}'\boldsymbol{\beta}\) estimated by \(\mathbf{c}'\mathbf{b}\) (Week 8):
\[ \text{Var}(\mathbf{c}'\mathbf{b}) = \mathbf{c}' \cdot \text{Var}(\mathbf{b}) \cdot \mathbf{c} = \sigma^2 \mathbf{c}'(\mathbf{X}'\mathbf{X})^{-1}\mathbf{c} \]
Standard error:
\[ \text{se}(\mathbf{c}'\mathbf{b}) = \sqrt{\hat{\sigma}^2 \mathbf{c}'(\mathbf{X}'\mathbf{X})^{-1}\mathbf{c}} \]
Covariance Properties
Key covariances:
| Quantity 1 | Quantity 2 | Covariance | Interpretation |
|---|---|---|---|
| \(\mathbf{b}\) | \(\mathbf{e}\) | \(\mathbf{0}\) | Estimates independent of residuals |
| \(\hat{\mathbf{y}}\) | \(\mathbf{e}\) | \(\mathbf{0}\) | Fitted values independent of residuals |
| \(b_j\) | \(b_k\) | \(\sigma^2 [(\mathbf{X}'\mathbf{X})^{-1}]_{jk}\) | Estimates may be correlated |
Proof that \(\text{Cov}(\mathbf{b}, \mathbf{e}) = \mathbf{0}\):
\[ \begin{align} \text{Cov}(\mathbf{b}, \mathbf{e}) &= \text{Cov}[(\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}'\mathbf{y}, \mathbf{M}\mathbf{y}] \\ &= (\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}' \cdot \text{Var}(\mathbf{y}) \cdot \mathbf{M}' \\ &= \sigma^2 (\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}'\mathbf{M} \\ &= \sigma^2 (\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}'(\mathbf{I} - \mathbf{H}) \\ &= \sigma^2 (\mathbf{X}'\mathbf{X})^{-1}(\mathbf{X}' - \mathbf{X}'\mathbf{H}) \\ &= \sigma^2 (\mathbf{X}'\mathbf{X})^{-1}(\mathbf{X}' - \mathbf{X}') \\ &= \mathbf{0} \end{align} \]
(using \(\mathbf{X}'\mathbf{H} = \mathbf{X}'\))
R Implementation: Computing Variances
Example: Swine litter size regression on parity number.
# Data: n=10 sows
parity <- c(1, 1, 2, 2, 3, 3, 4, 4, 5, 5) # Parity number
litter_size <- c(9, 10, 11, 12, 12, 13, 13, 14, 14, 15) # Piglets born alive
n <- length(litter_size)
X <- cbind(1, parity)
y <- litter_size
p <- ncol(X)
# Solve for estimates
XtX <- t(X) %*% X
XtX_inv <- solve(XtX)
b <- XtX_inv %*% t(X) %*% y
# Compute residuals and variance estimate
y_hat <- X %*% b
e <- y - y_hat
SSE <- sum(e^2)
sigma2_hat <- SSE / (n - p)
# Variance-covariance matrix of b
Var_b <- sigma2_hat * XtX_inv
cat("Var(b):\n")Var(b):print(Var_b) parity
0.22688 -0.06188
parity -0.06188 0.02063# Standard errors of coefficients
se_b <- sqrt(diag(Var_b))
cat("\nStandard errors:\n")
Standard errors:cat("se(b0) =", se_b[1], "\n")se(b0) = 0.4763 cat("se(b1) =", se_b[2], "\n")se(b1) = 0.1436 # Compare with lm()
fit <- lm(litter_size ~ parity)
cat("\nlm() standard errors:\n")
lm() standard errors:print(summary(fit)$coefficients[, "Std. Error"])(Intercept) parity
0.4763 0.1436 # Variance of fitted values
H <- X %*% XtX_inv %*% t(X)
Var_y_hat <- sigma2_hat * H
cat("\nVariance of fitted values (diagonal of Var(y_hat)):\n")
Variance of fitted values (diagonal of Var(y_hat)):print(diag(Var_y_hat)) [1] 0.12375 0.12375 0.06188 0.06188 0.04125 0.04125 0.06188 0.06188 0.12375
[10] 0.12375# Leverage values
h <- diag(H)
cat("\nLeverage values (h_ii):\n")
Leverage values (h_ii):print(h) [1] 0.30 0.30 0.15 0.15 0.10 0.10 0.15 0.15 0.30 0.30# Variance of residuals
Var_e <- sigma2_hat * (diag(n) - H)
cat("\nVariance of residuals (diagonal of Var(e)):\n")
Variance of residuals (diagonal of Var(e)):print(diag(Var_e)) [1] 0.2887 0.2887 0.3506 0.3506 0.3712 0.3712 0.3506 0.3506 0.2887 0.2887# Verify: Var(e_i) = sigma2 * (1 - h_ii)
cat("\nVerify Var(e_i) = sigma2 * (1 - h_ii):\n")
Verify Var(e_i) = sigma2 * (1 - h_ii):print(sigma2_hat * (1 - h)) [1] 0.2887 0.2887 0.3506 0.3506 0.3712 0.3712 0.3506 0.3506 0.2887 0.2887Prediction Example: Predicting Future Litter Size
# Predict litter size for parity 6
x0 <- c(1, 6) # Intercept and parity=6
# Point prediction
y0_hat <- t(x0) %*% b
cat("Predicted litter size at parity 6:", y0_hat, "\n")Predicted litter size at parity 6: 15.9 # Variance of prediction (for mean response)
var_pred_mean <- sigma2_hat * t(x0) %*% XtX_inv %*% x0
se_pred_mean <- sqrt(var_pred_mean)
cat("SE for mean response:", se_pred_mean, "\n")SE for mean response: 0.4763 # Variance of prediction (for new observation)
var_pred_obs <- sigma2_hat * (1 + t(x0) %*% XtX_inv %*% x0)
se_pred_obs <- sqrt(var_pred_obs)
cat("SE for new observation:", se_pred_obs, "\n")SE for new observation: 0.7996 # 95% confidence interval for mean response
t_crit <- qt(0.975, df = n - p)
ci_lower <- y0_hat - t_crit * se_pred_mean
ci_upper <- y0_hat + t_crit * se_pred_mean
cat("\n95% CI for mean at parity 6: [", ci_lower, ",", ci_upper, "]\n")
95% CI for mean at parity 6: [ 14.8 , 17 ]# 95% prediction interval for new observation
pi_lower <- y0_hat - t_crit * se_pred_obs
pi_upper <- y0_hat + t_crit * se_pred_obs
cat("95% PI for new obs at parity 6: [", pi_lower, ",", pi_upper, "]\n")95% PI for new obs at parity 6: [ 14.06 , 17.74 ]# Compare with predict()
cat("\nCompare with predict():\n")
Compare with predict():new_data <- data.frame(parity = 6)
pred_mean <- predict(fit, newdata = new_data, interval = "confidence", level = 0.95)
pred_obs <- predict(fit, newdata = new_data, interval = "prediction", level = 0.95)
print(pred_mean) fit lwr upr
1 15.9 14.8 17print(pred_obs) fit lwr upr
1 15.9 14.06 17.74Contrast Example: Comparing Two Parities
# Contrast: difference between parity 4 and parity 2
# E(y|parity=4) - E(y|parity=2) = (β0 + 4β1) - (β0 + 2β1) = 2β1
c <- c(0, 2) # Contrast vector
# Estimate
contrast_est <- t(c) %*% b
cat("Estimated difference (parity 4 - parity 2):", contrast_est, "\n")Estimated difference (parity 4 - parity 2): 2.4 # Variance
var_contrast <- sigma2_hat * t(c) %*% XtX_inv %*% c
se_contrast <- sqrt(var_contrast)
cat("SE of difference:", se_contrast, "\n")SE of difference: 0.2872 # Test H0: no difference
t_stat <- contrast_est / se_contrast
p_value <- 2 * pt(abs(t_stat), df = n - p, lower.tail = FALSE)
cat("t-statistic:", t_stat, "\n")t-statistic: 8.356 cat("p-value:", p_value, "\n")p-value: 3.188e-05 # 95% CI
ci_lower_c <- contrast_est - t_crit * se_contrast
ci_upper_c <- contrast_est + t_crit * se_contrast
cat("95% CI for difference: [", ci_lower_c, ",", ci_upper_c, "]\n")95% CI for difference: [ 1.738 , 3.062 ]
TipPractical Insight: Variance Depends on X
All these variances depend on \((\mathbf{X}'\mathbf{X})^{-1}\), which means:
- More data (larger \(n\)) → smaller variance
- Better spread in \(x\) values → smaller variance
- Collinearity (ill-conditioned \(\mathbf{X}'\mathbf{X}\)) → larger variance
- Predictions far from \(\bar{x}\) → larger variance
This explains why: - Balanced designs are efficient - Extreme extrapolation is risky - Collinearity inflates standard errors
Summary Table of Key Variance Formulas
| Quantity | Formula | Dimensions | Used In |
|---|---|---|---|
| \(\text{Var}(\mathbf{b})\) | \(\sigma^2(\mathbf{X}'\mathbf{X})^{-1}\) | \(p \times p\) | Week 5, 6, 8 |
| \(\text{Var}(\hat{\mathbf{y}})\) | \(\sigma^2\mathbf{H}\) | \(n \times n\) | Week 5, 11 |
| \(\text{Var}(\mathbf{e})\) | \(\sigma^2\mathbf{M}\) | \(n \times n\) | Week 5, 11 |
| \(\text{Var}(\hat{y}_i)\) | \(\sigma^2 h_{ii}\) | scalar | Week 11 (diagnostics) |
| \(\text{Var}(e_i)\) | \(\sigma^2(1 - h_{ii})\) | scalar | Week 11 (diagnostics) |
| \(\text{Var}(\hat{y}_0)\) | \(\sigma^2\mathbf{x}_0'(\mathbf{X}'\mathbf{X})^{-1}\mathbf{x}_0\) | scalar | Week 6 (prediction) |
| \(\text{Var}(y_0 - \hat{y}_0)\) | \(\sigma^2[1 + \mathbf{x}_0'(\mathbf{X}'\mathbf{X})^{-1}\mathbf{x}_0]\) | scalar | Week 6 (prediction) |
| \(\text{Var}(\mathbf{c}'\mathbf{b})\) | \(\sigma^2\mathbf{c}'(\mathbf{X}'\mathbf{X})^{-1}\mathbf{c}\) | scalar | Week 8 (contrasts) |
16.10.3 Sum of Squares Identities
Sum of squares decompositions are the foundation of ANOVA (Weeks 7-9) and regression analysis (Weeks 4-6). This section presents the key identities in matrix form.
Basic Decomposition: SST = SSM + SSE
For the linear model \(\mathbf{y} = \mathbf{X}\boldsymbol{\beta} + \mathbf{e}\):
\[ \underbrace{\sum_{i=1}^n (y_i - \bar{y})^2}_{\text{SST}} = \underbrace{\sum_{i=1}^n (\hat{y}_i - \bar{y})^2}_{\text{SSM}} + \underbrace{\sum_{i=1}^n (y_i - \hat{y}_i)^2}_{\text{SSE}} \]
Matrix form:
\[ \mathbf{y}'\mathbf{C}\mathbf{y} = \mathbf{b}'\mathbf{X}'\mathbf{C}\mathbf{y} + \mathbf{e}'\mathbf{e} \]
where \(\mathbf{C} = \mathbf{I}_n - n^{-1}\mathbf{1}_n\mathbf{1}_n'\) is the centering matrix.
NoteAlternative Matrix Formulations
There are several equivalent ways to write sum of squares:
SST (Total Sum of Squares): \[ \text{SST} = \mathbf{y}'\mathbf{C}\mathbf{y} = \mathbf{y}'\mathbf{y} - n\bar{y}^2 = \sum_{i=1}^n y_i^2 - \frac{(\sum_{i=1}^n y_i)^2}{n} \]
SSM (Model Sum of Squares): \[ \text{SSM} = \hat{\mathbf{y}}'\mathbf{C}\hat{\mathbf{y}} = \mathbf{b}'\mathbf{X}'\mathbf{y} - n\bar{y}^2 = \mathbf{y}'\mathbf{H}\mathbf{C}\mathbf{y} \]
SSE (Error Sum of Squares): \[ \text{SSE} = \mathbf{e}'\mathbf{e} = \mathbf{y}'\mathbf{y} - \mathbf{b}'\mathbf{X}'\mathbf{y} = \mathbf{y}'\mathbf{M}\mathbf{y} \]
Proof of Orthogonal Decomposition
Key insight: The decomposition works because \(\hat{\mathbf{y}}'\mathbf{e} = \mathbf{0}\) (orthogonality).
\[ \begin{align} \mathbf{y}'\mathbf{y} &= (\hat{\mathbf{y}} + \mathbf{e})'(\hat{\mathbf{y}} + \mathbf{e}) \\ &= \hat{\mathbf{y}}'\hat{\mathbf{y}} + 2\hat{\mathbf{y}}'\mathbf{e} + \mathbf{e}'\mathbf{e} \\ &= \hat{\mathbf{y}}'\hat{\mathbf{y}} + \mathbf{e}'\mathbf{e} \quad \text{(since } \hat{\mathbf{y}}'\mathbf{e} = \mathbf{0}) \end{align} \]
Subtracting \(n\bar{y}^2\) from both sides:
\[ \mathbf{y}'\mathbf{y} - n\bar{y}^2 = (\hat{\mathbf{y}}'\hat{\mathbf{y}} - n\bar{y}^2) + \mathbf{e}'\mathbf{e} \]
\[ \text{SST} = \text{SSM} + \text{SSE} \]
Projection Matrix Form
Using \(\mathbf{H}\) and \(\mathbf{M}\):
| Sum of Squares | Formula 1 | Formula 2 | Formula 3 |
|---|---|---|---|
| SST | \(\mathbf{y}'\mathbf{C}\mathbf{y}\) | \(\mathbf{y}'(\mathbf{I} - n^{-1}\mathbf{J})\mathbf{y}\) | \(\mathbf{y}'\mathbf{y} - n\bar{y}^2\) |
| SSM | \(\mathbf{y}'\mathbf{H}\mathbf{C}\mathbf{y}\) | \(\mathbf{b}'\mathbf{X}'\mathbf{y} - n\bar{y}^2\) | \(\hat{\mathbf{y}}'\mathbf{C}\hat{\mathbf{y}}\) |
| SSE | \(\mathbf{y}'\mathbf{M}\mathbf{y}\) | \(\mathbf{y}'\mathbf{y} - \mathbf{b}'\mathbf{X}'\mathbf{y}\) | \(\mathbf{e}'\mathbf{e}\) |
where \(\mathbf{J} = \mathbf{1}_n\mathbf{1}_n'\) (matrix of all ones).
Degrees of Freedom
Each sum of squares has associated degrees of freedom equal to the rank of its projection matrix:
| Source | Sum of Squares | df | Projection Matrix | Rank |
|---|---|---|---|---|
| Total | SST | \(n-1\) | \(\mathbf{C}\) | \(r(\mathbf{C}) = n-1\) |
| Model | SSM | \(p-1\) | \(\mathbf{H}\mathbf{C}\) | \(r(\mathbf{H}\mathbf{C}) = p-1\) |
| Error | SSE | \(n-p\) | \(\mathbf{M}\) | \(r(\mathbf{M}) = n-p\) |
Key property: \((n-1) = (p-1) + (n-p)\) (df add up!)
Identities for Sums of Squares
Computational shortcuts:
| Identity | Why It’s Useful |
|---|---|
| \(\mathbf{b}'\mathbf{X}'\mathbf{y} = \hat{\mathbf{y}}'\mathbf{y}\) | Avoids computing \(\hat{\mathbf{y}}\) explicitly |
| \(\text{SSE} = \mathbf{y}'\mathbf{y} - \mathbf{b}'\mathbf{X}'\mathbf{y}\) | Compute SSE without residuals |
| \(\mathbf{e}'\mathbf{e} = (\mathbf{y} - \mathbf{X}\mathbf{b})'(\mathbf{y} - \mathbf{X}\mathbf{b})\) | Alternative for SSE |
| \(\text{SST} = \mathbf{y}'\mathbf{y} - n\bar{y}^2\) | Correction for the mean |
Verification identities:
| Identity | Check |
|---|---|
| \(\text{SST} = \text{SSM} + \text{SSE}\) | Always true (orthogonal decomposition) |
| \(\text{SSM} = \mathbf{b}'(\mathbf{X}'\mathbf{y} - n\bar{y}\mathbf{1}_p)\) | Alternative computation |
| \(R^2 = \text{SSM}/\text{SST} = 1 - \text{SSE}/\text{SST}\) | Both should give same \(R^2\) |
Multi-Factor ANOVA Decompositions
For two-way ANOVA (Week 9), the sum of squares partition extends:
\[ \text{SST} = \text{SS(A)} + \text{SS(B)} + \text{SS(AB)} + \text{SSE} \]
Matrix representation: Each source corresponds to a projection matrix.
For model \(\mathbf{y} = \mathbf{X}_A\boldsymbol{\alpha} + \mathbf{X}_B\boldsymbol{\beta} + \mathbf{X}_{AB}\boldsymbol{\gamma} + \mathbf{e}\):
- \(\text{SS(A)} = \mathbf{y}'(\mathbf{H}_A - \mathbf{H}_\mu)\mathbf{y}\)
- \(\text{SS(B)} = \mathbf{y}'(\mathbf{H}_B - \mathbf{H}_\mu)\mathbf{y}\)
- \(\text{SS(AB)} = \mathbf{y}'(\mathbf{H}_{full} - \mathbf{H}_A - \mathbf{H}_B + \mathbf{H}_\mu)\mathbf{y}\)
- \(\text{SSE} = \mathbf{y}'(\mathbf{I} - \mathbf{H}_{full})\mathbf{y}\)
where: - \(\mathbf{H}_\mu\) = projection onto intercept only - \(\mathbf{H}_A\) = projection onto intercept + A - \(\mathbf{H}_B\) = projection onto intercept + B - \(\mathbf{H}_{full}\) = projection onto full model
WarningType I vs. Type III Sums of Squares
The formulas above give Type III SS (each effect adjusted for all others).
Type I SS (sequential) depend on the order: - \(\text{SS(A|}\mu) = \mathbf{y}'(\mathbf{H}_A - \mathbf{H}_\mu)\mathbf{y}\) - \(\text{SS(B|}\mu, A) = \mathbf{y}'(\mathbf{H}_{AB} - \mathbf{H}_A)\mathbf{y}\)
For balanced designs, Type I = Type III. For unbalanced designs, they differ!
R Implementation: Sum of Squares Computations
Example: Beef cattle weight gain (ADG) by breed.
# One-way ANOVA: ADG by breed (3 breeds, n=4 per breed)
breed <- factor(rep(c("Angus", "Hereford", "Charolais"), each = 4))
adg <- c(1.2, 1.3, 1.1, 1.4, # Angus
1.1, 1.2, 1.0, 1.3, # Hereford
1.5, 1.6, 1.4, 1.7) # Charolais
n <- length(adg)
y <- adg
# Design matrix (cell means model)
X <- model.matrix(~ breed - 1)
p <- ncol(X)
# Solve normal equations
b <- solve(t(X) %*% X) %*% t(X) %*% y
y_hat <- X %*% b
e <- y - y_hat
# Method 1: Using formulas
y_bar <- mean(y)
SST <- sum((y - y_bar)^2)
SSM <- sum((y_hat - y_bar)^2)
SSE <- sum(e^2)
cat("Method 1 (direct computation):\n")Method 1 (direct computation):cat("SST =", SST, "\n")SST = 0.4967 cat("SSM =", SSM, "\n")SSM = 0.3467 cat("SSE =", SSE, "\n")SSE = 0.15 cat("SSM + SSE =", SSM + SSE, "(should equal SST)\n\n")SSM + SSE = 0.4967 (should equal SST)# Method 2: Matrix formulas
SST_mat <- t(y) %*% y - n * y_bar^2
SSM_mat <- t(b) %*% t(X) %*% y - n * y_bar^2
SSE_mat <- t(y) %*% y - t(b) %*% t(X) %*% y
cat("Method 2 (matrix formulas):\n")Method 2 (matrix formulas):cat("SST =", SST_mat, "\n")SST = 0.4967 cat("SSM =", SSM_mat, "\n")SSM = 0.3467 cat("SSE =", SSE_mat, "\n\n")SSE = 0.15 # Method 3: Using projection matrices
C <- diag(n) - (1/n) * matrix(1, n, n) # Centering matrix
H <- X %*% solve(t(X) %*% X) %*% t(X)
M <- diag(n) - H
SST_proj <- t(y) %*% C %*% y
SSM_proj <- t(y) %*% H %*% C %*% y
SSE_proj <- t(y) %*% M %*% y
cat("Method 3 (projection matrices):\n")Method 3 (projection matrices):cat("SST =", SST_proj, "\n")SST = 0.4967 cat("SSM =", SSM_proj, "\n")SSM = 0.3467 cat("SSE =", SSE_proj, "\n\n")SSE = 0.15 # Degrees of freedom
df_total <- n - 1
df_model <- p - 1
df_error <- n - p
cat("Degrees of freedom:\n")Degrees of freedom:cat("df(Total) =", df_total, "\n")df(Total) = 11 cat("df(Model) =", df_model, "\n")df(Model) = 2 cat("df(Error) =", df_error, "\n")df(Error) = 9 cat("Check:", df_model + df_error, "= df(Total)\n\n")Check: 11 = df(Total)# Mean squares and F-statistic
MSM <- SSM / df_model
MSE <- SSE / df_error
F_stat <- MSM / MSE
p_value <- pf(F_stat, df_model, df_error, lower.tail = FALSE)
# ANOVA table
cat("ANOVA Table:\n")ANOVA Table:cat("Source df SS MS F p-value\n")Source df SS MS F p-valuecat("-------------------------------------------------------\n")-------------------------------------------------------cat(sprintf("Model %2d %.4f %.4f %.4f %.4f\n",
df_model, SSM, MSM, F_stat, p_value))Model 2 0.3467 0.1733 10.4000 0.0046cat(sprintf("Error %2d %.4f %.4f\n", df_error, SSE, MSE))Error 9 0.1500 0.0167cat(sprintf("Total %2d %.4f\n", df_total, SST))Total 11 0.4967# Compare with lm()
cat("\n\nCompare with lm():\n")
Compare with lm():fit <- lm(adg ~ breed)
print(anova(fit))Analysis of Variance Table
Response: adg
Df Sum Sq Mean Sq F value Pr(>F)
breed 2 0.347 0.1733 10.4 0.0046 **
Residuals 9 0.150 0.0167
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# R-squared
R2 <- SSM / SST
cat("\nR-squared:", R2, "\n")
R-squared: 0.698 Two-Way ANOVA Example
Example: Dairy milk yield by breed and farm.
# Balanced 2×3 factorial: 2 breeds, 3 farms, n=2 per cell
breed <- factor(rep(c("Holstein", "Jersey"), each = 6))
farm <- factor(rep(rep(c("A", "B", "C"), each = 2), 2))
milk <- c(32, 33, # Holstein, Farm A
30, 31, # Holstein, Farm B
28, 29, # Holstein, Farm C
25, 26, # Jersey, Farm A
24, 25, # Jersey, Farm B
22, 23) # Jersey, Farm C
y <- milk
n <- length(y)
y_bar <- mean(y)
# Fit models
fit_null <- lm(milk ~ 1)
fit_breed <- lm(milk ~ breed)
fit_farm <- lm(milk ~ farm)
fit_full <- lm(milk ~ breed + farm + breed:farm)
# Extract SS using anova()
cat("Type I (Sequential) SS:\n")Type I (Sequential) SS:anova_seq <- anova(fit_full)
print(anova_seq)Analysis of Variance Table
Response: milk
Df Sum Sq Mean Sq F value Pr(>F)
breed 1 120.3 120.3 240.67 4.5e-06 ***
farm 2 24.7 12.3 24.67 0.0013 **
breed:farm 2 0.7 0.3 0.67 0.5477
Residuals 6 3.0 0.5
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Type III SS (using car package)
library(car)
cat("\n\nType III SS:\n")
Type III SS:anova_type3 <- Anova(fit_full, type = 3)
print(anova_type3)Anova Table (Type III tests)
Response: milk
Sum Sq Df F value Pr(>F)
(Intercept) 2113 1 4225.00 8.9e-10 ***
breed 49 1 98.00 6.1e-05 ***
farm 16 2 16.00 0.0039 **
breed:farm 1 2 0.67 0.5477
Residuals 3 6
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Manual computation of Type III SS
# SS(Breed | everything else)
fit_no_breed <- lm(milk ~ farm + breed:farm)
SS_breed_III <- sum(residuals(fit_no_breed)^2) - sum(residuals(fit_full)^2)
# SS(Farm | everything else)
fit_no_farm <- lm(milk ~ breed + breed:farm)
SS_farm_III <- sum(residuals(fit_no_farm)^2) - sum(residuals(fit_full)^2)
# SS(Interaction | everything else)
fit_no_int <- lm(milk ~ breed + farm)
SS_int_III <- sum(residuals(fit_no_int)^2) - sum(residuals(fit_full)^2)
cat("\n\nManual Type III SS:\n")
Manual Type III SS:cat("SS(Breed | Farm, Interaction) =", SS_breed_III, "\n")SS(Breed | Farm, Interaction) = 5.329e-15 cat("SS(Farm | Breed, Interaction) =", SS_farm_III, "\n")SS(Farm | Breed, Interaction) = 4.441e-16 cat("SS(Interaction | Breed, Farm) =", SS_int_III, "\n")SS(Interaction | Breed, Farm) = 0.6667
TipComputational Strategy
For efficiency:
- Never form projection matrices explicitly for large \(n\)
- Use \(\mathbf{b}'\mathbf{X}'\mathbf{y}\) instead of \(\hat{\mathbf{y}}'\hat{\mathbf{y}}\)
- Compute SSE as \(\mathbf{y}'\mathbf{y} - \mathbf{b}'\mathbf{X}'\mathbf{y}\) (avoids residual vector)
- Use incremental SS: \(\text{SS(Full)} - \text{SS(Reduced)}\)
Example:
# Efficient
SSE <- t(y) %*% y - t(b) %*% t(X) %*% y
# Inefficient (for large n)
y_hat <- X %*% b
SSE <- t(y - y_hat) %*% (y - y_hat)Identity Summary
Key sum of squares identities:
| Identity | Formula | Usage |
|---|---|---|
| Decomposition | \(\text{SST} = \text{SSM} + \text{SSE}\) | Always holds |
| SST | \(\mathbf{y}'\mathbf{y} - n\bar{y}^2\) | Correction for mean |
| SSM | \(\mathbf{b}'\mathbf{X}'\mathbf{y} - n\bar{y}^2\) | Model SS |
| SSE | \(\mathbf{y}'\mathbf{y} - \mathbf{b}'\mathbf{X}'\mathbf{y}\) | Error SS |
| \(R^2\) | \(\text{SSM}/\text{SST} = 1 - \text{SSE}/\text{SST}\) | Goodness of fit |
| Incremental SS | \(\text{SS(Full)} - \text{SS(Reduced)}\) | Testing nested models |
| Orthogonality | \(\hat{\mathbf{y}}'\mathbf{e} = \mathbf{0}\) | Key to decomposition |
16.10.4 Computational Shortcuts
R provides specialized functions that are faster and more numerically stable than explicit matrix operations. This section shows you how to write efficient code for linear models computations.
ImportantWhy Computational Efficiency Matters
For large datasets (n > 10,000 or p > 1,000):
- Naive implementations can be 100× slower
- Memory usage can explode
- Numerical errors accumulate
Learning efficient coding now will pay dividends when you work with real breeding datasets!
Efficient Cross-Product Functions
Instead of t(X) %*% X, use crossprod(X):
| Operation | Slow (Don’t Use) | Fast (Use This) | Speedup |
|---|---|---|---|
| \(\mathbf{X}'\mathbf{X}\) | t(X) %*% X |
crossprod(X) |
~2× |
| \(\mathbf{X}'\mathbf{y}\) | t(X) %*% y |
crossprod(X, y) |
~2× |
| \(\mathbf{X}\mathbf{X}'\) | X %*% t(X) |
tcrossprod(X) |
~2× |
| \(\mathbf{X}\mathbf{y}'\) | X %*% t(y) |
tcrossprod(X, y) |
~2× |
Why faster?
- No explicit transpose created (saves memory and time)
- Optimized BLAS routines called directly
- Better cache utilization
Example:
# Generate larger dataset
set.seed(123)
n <- 5000
p <- 10
X <- matrix(rnorm(n * p), n, p)
y <- rnorm(n)
# Method 1: Slow
system.time({
XtX_slow <- t(X) %*% X
Xty_slow <- t(X) %*% y
}) user system elapsed
0.001 0.000 0.001 # Method 2: Fast
system.time({
XtX_fast <- crossprod(X)
Xty_fast <- crossprod(X, y)
}) user system elapsed
0.001 0.000 0.001 # Verify same result
cat("Results identical?", all.equal(XtX_slow, XtX_fast), "\n")Results identical? TRUE cat("Results identical?", all.equal(Xty_slow, Xty_fast), "\n")Results identical? TRUE Solving Normal Equations Efficiently
Three methods, ranked by efficiency:
- QR decomposition (best for most cases)
- Cholesky decomposition (if you know \(\mathbf{X}'\mathbf{X}\) is well-conditioned)
- Direct inverse (avoid if possible!)
# Setup
X <- matrix(rnorm(100 * 5), 100, 5)
y <- rnorm(100)
# Method 1: Direct inverse (AVOID!)
XtX <- t(X) %*% X
Xty <- t(X) %*% y
b1 <- solve(XtX) %*% Xty # Slow and unstable
# Method 2: Solve without forming inverse (BETTER)
XtX <- crossprod(X)
Xty <- crossprod(X, y)
b2 <- solve(XtX, Xty) # Faster, more stable
# Method 3: Cholesky (GOOD for well-conditioned X'X)
XtX <- crossprod(X)
Xty <- crossprod(X, y)
R <- chol(XtX) # Upper triangular
b3 <- backsolve(R, forwardsolve(t(R), Xty)) # Two triangular solves
# Method 4: QR decomposition (BEST)
qr_decomp <- qr(X)
b4 <- qr.coef(qr_decomp, y) # Uses QR, most stable
# Method 5: Using lm.fit (EASIEST, nearly as fast as QR)
b5 <- lm.fit(X, y)$coefficients
cat("Method 1 (inverse):", b1[1:3], "\n")Method 1 (inverse): 0.002055 -0.1507 0.1348 cat("Method 2 (solve):", b2[1:3], "\n")Method 2 (solve): 0.002055 -0.1507 0.1348 cat("Method 3 (Cholesky):", b3[1:3], "\n")Method 3 (Cholesky): 0.002055 -0.1507 0.1348 cat("Method 4 (QR):", b4[1:3], "\n")Method 4 (QR): 0.002055 -0.1507 0.1348 cat("Method 5 (lm.fit):", b5[1:3], "\n")Method 5 (lm.fit): 0.002055 -0.1507 0.1348 Vectorized Operations
Avoid loops when possible. Use vectorized functions:
| Task | Slow (Loop) | Fast (Vectorized) |
|---|---|---|
| Column sums | apply(X, 2, sum) |
colSums(X) |
| Row sums | apply(X, 1, sum) |
rowSums(X) |
| Column means | apply(X, 2, mean) |
colMeans(X) |
| Row means | apply(X, 1, mean) |
rowMeans(X) |
Example:
X <- matrix(rnorm(1000 * 50), 1000, 50)
# Slow
system.time({
col_sums_slow <- apply(X, 2, sum)
}) user system elapsed
0.001 0.000 0.000 # Fast
system.time({
col_sums_fast <- colSums(X)
}) user system elapsed
0.001 0.000 0.000 cat("Speedup:",
system.time(apply(X, 2, sum))[3] / system.time(colSums(X))[3], "×\n")Speedup: NaN ×Centering and Scaling with sweep()
Task: Center columns of X (subtract column means).
X <- matrix(rnorm(100 * 5), 100, 5)
# Method 1: Manual (slow)
X_centered1 <- X
for (j in 1:ncol(X)) {
X_centered1[, j] <- X[, j] - mean(X[, j])
}
# Method 2: Using sweep (fast)
X_centered2 <- sweep(X, 2, colMeans(X), "-")
# Method 3: Using scale (easiest for centering/scaling)
X_centered3 <- scale(X, center = TRUE, scale = FALSE)
# Verify
cat("Method 1 = Method 2?", all.equal(X_centered1, X_centered2), "\n")Method 1 = Method 2? TRUE cat("Method 2 = Method 3?",
all.equal(X_centered2, as.matrix(X_centered3), check.attributes = FALSE), "\n")Method 2 = Method 3? TRUE # Column means should be ~0
cat("Column means after centering:", colMeans(X_centered2), "\n")Column means after centering: -2.429e-18 -1.527e-18 2.817e-17 8.119e-18 -2.637e-18 Computing Fitted Values Efficiently
Don’t form the hat matrix \(\mathbf{H} = \mathbf{X}(\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}'\) explicitly!
n <- 1000
p <- 10
X <- matrix(rnorm(n * p), n, p)
y <- rnorm(n)
# NEVER do this (forms n×n matrix!)
# H <- X %*% solve(t(X) %*% X) %*% t(X)
# y_hat <- H %*% y
# Method 1: Solve and multiply (good)
b <- solve(crossprod(X), crossprod(X, y))
y_hat1 <- X %*% b
# Method 2: Using QR (better)
qr_decomp <- qr(X)
y_hat2 <- qr.fitted(qr_decomp, y)
# Method 3: Using lm.fit (easiest)
fit <- lm.fit(X, y)
y_hat3 <- fit$fitted.values
cat("All methods agree?",
isTRUE(all.equal(y_hat1, y_hat2)) && isTRUE(all.equal(y_hat2, y_hat3)), "\n")All methods agree? FALSE Quadratic Forms: \(\mathbf{y}'\mathbf{A}\mathbf{y}\)
Efficient computation without forming full matrix product:
n <- 500
A <- matrix(rnorm(n * n), n, n)
A <- A + t(A) # Make symmetric
y <- rnorm(n)
# Method 1: Naive (forms n-vector twice)
quad1 <- t(y) %*% A %*% y
# Method 2: One multiplication (faster)
quad2 <- t(y) %*% (A %*% y)
# Method 3: Avoid transpose (fastest)
quad3 <- sum(y * (A %*% y))
# Method 4: If A is sparse, use Matrix package
library(Matrix)
A_sparse <- as(A, "dgCMatrix")
quad4 <- sum(y * (A_sparse %*% y))
cat("Method 1:", quad1, "\n")Method 1: -48.68 cat("Method 2:", quad2, "\n")Method 2: -48.68 cat("Method 3:", quad3, "\n")Method 3: -48.68 cat("All equal?",
isTRUE(all.equal(as.numeric(quad1), quad2)) && isTRUE(all.equal(quad2, quad3)), "\n")All equal? FALSE Livestock Example: Efficient Solver for Large Dataset
Scenario: Beef cattle dataset with n=5000 animals, p=20 fixed effects.
# Simulate realistic beef cattle dataset
set.seed(42)
n <- 5000
p <- 20
# Design matrix: breed, sex, age, farm, pen effects, etc.
X <- matrix(rnorm(n * p), n, p)
X[, 1] <- 1 # Intercept
y <- rnorm(n, mean = 350, sd = 50) # Carcass weight, kg
# Efficient normal equations solver
system.time({
XtX <- crossprod(X) # X'X
Xty <- crossprod(X, y) # X'y
b <- solve(XtX, Xty) # Solve X'Xb = X'y
y_hat <- X %*% b # Fitted values
SSE <- sum((y - y_hat)^2) # Error SS
sigma2_hat <- SSE / (n - p) # Variance estimate
# Standard errors
Var_b <- solve(XtX) * sigma2_hat
se_b <- sqrt(diag(Var_b))
}) user system elapsed
0.003 0.000 0.003 cat("\nFirst 5 estimates:\n")
First 5 estimates:print(b[1:5])[1] 349.2454 -0.3738 0.5285 0.9589 -0.4790cat("\nFirst 5 standard errors:\n")
First 5 standard errors:print(se_b[1:5])[1] 0.7050 0.7003 0.7033 0.6962 0.6949# Compare with lm()
cat("\nVerify against lm():\n")
Verify against lm():system.time({
fit_lm <- lm(y ~ X - 1) # -1 to use X as-is
}) user system elapsed
0.006 0.000 0.006 cat("Coefficients match?",
all.equal(as.numeric(b), coef(fit_lm), check.attributes = FALSE), "\n")Coefficients match? TRUE Memory-Efficient Computations
For very large datasets, avoid creating unnecessary copies:
# BAD: Creates many temporary objects
XtX <- t(X) %*% X
XtX_inv <- solve(XtX)
Xty <- t(X) %*% y
b <- XtX_inv %*% Xty
y_hat <- X %*% b
e <- y - y_hat
SSE <- t(e) %*% e
# GOOD: Minimizes temporaries, uses efficient functions
XtX <- crossprod(X)
Xty <- crossprod(X, y)
b <- solve(XtX, Xty) # Don't form inverse!
SSE <- sum(y^2) - sum(Xty * b) # Compute SSE without forming residualsBenchmark Summary
Rules of thumb (for modern computers):
| Operation | Slow | Fast | Speedup |
|---|---|---|---|
| \(\mathbf{X}'\mathbf{X}\) | t(X) %*% X |
crossprod(X) |
~2× |
| Solve \(\mathbf{Ab} = \mathbf{c}\) | solve(A) %*% c |
solve(A, c) |
~3× |
| Column sums | apply(X, 2, sum) |
colSums(X) |
~50× |
| Centering | for loop |
sweep() or scale() |
~10× |
| Normal equations | Form \((\mathbf{X}'\mathbf{X})^{-1}\) | Use solve() or QR |
~5× |
For very large problems (n > 100,000 or p > 10,000): - Use sparse matrix methods (Matrix package) - Consider iterative solvers - Use parallel computing (parallel package) - Stream data from disk if doesn’t fit in RAM
Best Practices Summary
TipEfficient Coding Checklist
Always: - ✅ Use crossprod() instead of t(X) %*% X - ✅ Use solve(A, b) instead of solve(A) %*% b - ✅ Use vectorized functions (colSums, rowSums, etc.) - ✅ Use sweep() or scale() for centering/scaling - ✅ Use lm.fit() or QR decomposition for solving
Never: - ❌ Form \((\mathbf{X}'\mathbf{X})^{-1}\) explicitly unless you need it - ❌ Form hat matrix \(\mathbf{H}\) for large \(n\) - ❌ Use loops where vectorization works - ❌ Create unnecessary copies of large matrices - ❌ Use apply() when specialized functions exist
Profile your code with system.time() or microbenchmark package!
Quick Reference Card
# Efficient normal equations solution
XtX <- crossprod(X) # X'X
Xty <- crossprod(X, y) # X'y
b <- solve(XtX, Xty) # Solve (don't invert!)
y_hat <- X %*% b # Fitted values
SSE <- sum(y^2) - sum(Xty * b) # SSE without forming residuals
sigma2 <- SSE / (n - p) # Variance
Var_b <- solve(XtX) * sigma2 # Var(b) - only if you need SE
se_b <- sqrt(diag(Var_b)) # Standard errors
# Even better: use lm.fit() for production code
fit <- lm.fit(X, y)
b <- fit$coefficients
y_hat <- fit$fitted.values
SSE <- sum(fit$residuals^2)16.11 Computational Considerations
This section addresses the practical realities of computer arithmetic. Even mathematically correct formulas can produce incorrect results due to rounding errors and numerical instability.
Warning
##Why This Matters
Just because the math is correct doesn’t mean the computer will get it right!
Ill-conditioned problems, poor algorithms, and rounding errors can produce: - Wrong parameter estimates - Negative variances (!!) - Failed convergence - Nonsensical results
Learning these issues NOW will save you hours of debugging later.
16.11.1 Numerical Stability
Numerical stability refers to how sensitive a computation is to rounding errors. An algorithm is numerically stable if small errors in input produce small errors in output.
Condition Numbers
The condition number of a matrix \(\mathbf{A}\) measures how sensitive \(\mathbf{A}^{-1}\) is to perturbations:
\[ \kappa(\mathbf{A}) = \|\mathbf{A}\| \cdot \|\mathbf{A}^{-1}\| \]
For symmetric positive definite matrices:
\[ \kappa(\mathbf{A}) = \frac{\lambda_{\max}(\mathbf{A})}{\lambda_{\min}(\mathbf{A})} \]
Interpretation:
| Condition Number | Matrix Status | Inversion Accuracy |
|---|---|---|
| \(\kappa < 10\) | Well-conditioned | Excellent |
| \(10 \leq \kappa < 10^3\) | Moderate | Good |
| \(10^3 \leq \kappa < 10^6\) | Ill-conditioned | Poor, use caution |
| \(\kappa \geq 10^6\) | Severely ill-conditioned | Unreliable, avoid if possible |
Rule of thumb: You lose about \(\log_{10}(\kappa)\) digits of precision.
NoteExample: Collinearity Creates Ill-Conditioning
In linear models, collinearity makes \(\mathbf{X}'\mathbf{X}\) ill-conditioned:
- If predictors are highly correlated, \(\mathbf{X}'\mathbf{X}\) has small eigenvalues
- Small eigenvalues → large condition number → unstable inversion
- Result: Huge standard errors, unstable estimates
Computing Condition Numbers in R
# Well-conditioned matrix
A_good <- matrix(c(4, 1, 1, 3), 2, 2)
kappa_good <- kappa(A_good)
cat("Well-conditioned matrix:\n")Well-conditioned matrix:print(A_good) [,1] [,2]
[1,] 4 1
[2,] 1 3cat("Condition number:", kappa_good, "\n\n")Condition number: 1.917 # Ill-conditioned matrix (high collinearity)
A_bad <- matrix(c(1.0, 0.99,
0.99, 1.0), 2, 2, byrow = TRUE)
kappa_bad <- kappa(A_bad)
cat("Ill-conditioned matrix:\n")Ill-conditioned matrix:print(A_bad) [,1] [,2]
[1,] 1.00 0.99
[2,] 0.99 1.00cat("Condition number:", kappa_bad, "\n\n")Condition number: 200 # Severely ill-conditioned (nearly singular)
A_terrible <- matrix(c(1.0, 0.9999,
0.9999, 1.0), 2, 2, byrow = TRUE)
kappa_terrible <- kappa(A_terrible)
cat("Severely ill-conditioned matrix:\n")Severely ill-conditioned matrix:print(A_terrible) [,1] [,2]
[1,] 1.0000 0.9999
[2,] 0.9999 1.0000cat("Condition number:", kappa_terrible, "\n\n")Condition number: 20000 # For design matrix X'X
set.seed(123)
n <- 100
x1 <- rnorm(n)
x2 <- x1 + rnorm(n, sd = 0.01) # Highly correlated!
X <- cbind(1, x1, x2)
XtX <- crossprod(X)
kappa_XtX <- kappa(XtX)
cat("X'X with collinearity:\n")X'X with collinearity:cat("Condition number:", kappa_XtX, "\n")Condition number: 42730 cat("Correlation between x1 and x2:", cor(x1, x2), "\n")Correlation between x1 and x2: 0.9999 Sources of Numerical Instability
1. Subtracting Nearly Equal Numbers
# Computing variance: Var(x) = E(x²) - [E(x)]²
# Two formulas, mathematically equivalent
x <- rnorm(100, mean = 1e8, sd = 1) # Large mean, small variance
# Formula 1: Textbook (UNSTABLE for large mean)
mean_x <- mean(x)
var1 <- mean(x^2) - mean_x^2
cat("Method 1 (textbook, unstable):", var1, "\n")Method 1 (textbook, unstable): 0 # Formula 2: Deviations from mean (STABLE)
var2 <- mean((x - mean_x)^2)
cat("Method 2 (deviations, stable):", var2, "\n")Method 2 (deviations, stable): 0.8932 # R's built-in (uses stable algorithm)
var3 <- var(x) * (length(x) - 1) / length(x) # Adjust for n vs n-1
cat("Method 3 (R's var()):", var3, "\n")Method 3 (R's var()): 0.8932 cat("\nTrue variance (from simulation):", 1, "\n")
True variance (from simulation): 1 2. Forming \((\mathbf{X}'\mathbf{X})^{-1}\) Explicitly
# Generate X'X with moderate collinearity
set.seed(456)
n <- 100
p <- 5
X <- matrix(rnorm(n * p), n, p)
X[, 2] <- X[, 1] + rnorm(n, sd = 0.1) # Collinear columns
y <- rnorm(n)
XtX <- crossprod(X)
Xty <- crossprod(X, y)
# Method 1: Explicit inverse (potentially unstable)
XtX_inv <- solve(XtX)
b1 <- XtX_inv %*% Xty
# Method 2: Solve directly (more stable)
b2 <- solve(XtX, Xty)
cat("Estimates match?", all.equal(b1, b2), "\n")Estimates match? TRUE cat("Condition number of X'X:", kappa(XtX), "\n")Condition number of X'X: 293.9 # Check: how well do we solve X'X * b = X'y?
residual1 <- XtX %*% b1 - Xty
residual2 <- XtX %*% b2 - Xty
cat("||X'Xb - X'y|| using inverse:", sqrt(sum(residual1^2)), "\n")||X'Xb - X'y|| using inverse: 6.319e-14 cat("||X'Xb - X'y|| using solve():", sqrt(sum(residual2^2)), "\n")||X'Xb - X'y|| using solve(): 9.125e-15 3. Large Range in Data Values
# Predictors with vastly different scales
n <- 50
age_days <- sample(200:400, n, replace = TRUE) # Scale: O(100)
weight_mg <- runif(n, 5000, 8000) # Scale: O(1000)
y <- rnorm(n)
X_unscaled <- cbind(1, age_days, weight_mg)
# Condition number without scaling
kappa_unscaled <- kappa(crossprod(X_unscaled))
cat("Condition number (unscaled):", kappa_unscaled, "\n")Condition number (unscaled): 4.288e+09 # Scale predictors (mean 0, sd 1)
X_scaled <- scale(X_unscaled[, -1]) # Don't scale intercept
X_scaled <- cbind(1, X_scaled)
kappa_scaled <- kappa(crossprod(X_scaled))
cat("Condition number (scaled):", kappa_scaled, "\n")Condition number (scaled): 1.263 cat("Improvement:", kappa_unscaled / kappa_scaled, "×\n")Improvement: 3.394e+09 ×Remedies for Numerical Instability
TipStrategies to Improve Numerical Stability
1. Center and Scale Predictors
X_centered <- scale(X, center = TRUE, scale = TRUE)2. Use Stable Algorithms - QR decomposition instead of normal equations - Cholesky instead of explicit inverse (if well-conditioned) - SVD for rank-deficient problems
3. Avoid Explicit Matrix Inversion
# BAD
b <- solve(XtX) %*% Xty
# GOOD
b <- solve(XtX, Xty)4. Check Condition Numbers
if (kappa(XtX) > 1e6) {
warning("X'X is severely ill-conditioned!")
}5. Ridge Regression for Collinearity
# Add small value to diagonal
lambda <- 0.01
XtX_ridge <- XtX + lambda * diag(ncol(XtX))
b_ridge <- solve(XtX_ridge, Xty)6. Use QR Decomposition
qr_obj <- qr(X)
b <- qr.coef(qr_obj, y) # Most numerically stableLivestock Example: Collinearity in Dairy Data
Scenario: Predicting milk yield from fat%, protein%, and lactose% (highly correlated).
# Simulated dairy data
set.seed(789)
n <- 50
# These are compositionally constrained (sum to ~100%)
fat_pct <- runif(n, 3.5, 4.5)
protein_pct <- runif(n, 3.0, 3.5)
lactose_pct <- 100 - fat_pct - protein_pct - runif(n, 85, 89) # Highly constrained!
milk_yield <- 30 + 2*fat_pct - 1*protein_pct + 3*lactose_pct + rnorm(n, sd = 2)
# Check correlations
comp <- cbind(fat_pct, protein_pct, lactose_pct)
cat("Correlation matrix:\n")Correlation matrix:print(cor(comp)) fat_pct protein_pct lactose_pct
fat_pct 1.0000 -0.12782 -0.18836
protein_pct -0.1278 1.00000 0.07922
lactose_pct -0.1884 0.07922 1.00000# Design matrix
X <- cbind(1, fat_pct, protein_pct, lactose_pct)
XtX <- crossprod(X)
# Check condition number
kappa_comp <- kappa(XtX)
cat("\nCondition number:", kappa_comp, "\n")
Condition number: 44267 if (kappa_comp > 1000) {
cat("WARNING: X'X is ill-conditioned due to collinearity!\n")
}WARNING: X'X is ill-conditioned due to collinearity!# Fit model anyway
b <- solve(XtX, crossprod(X, milk_yield))
Var_b <- solve(XtX) * (sum((milk_yield - X %*% b)^2) / (n - 4))
se_b <- sqrt(diag(Var_b))
cat("\nEstimates and SE:\n")
Estimates and SE:results <- data.frame(
Parameter = c("Intercept", "Fat %", "Protein %", "Lactose %"),
Estimate = b,
SE = se_b
)
print(results) Parameter Estimate SE
Intercept 29.00842 8.9849
fat_pct Fat % 1.10194 1.2282
protein_pct Protein % -0.02917 2.0826
lactose_pct Lactose % 3.22353 0.2685cat("\nNote the HUGE standard errors due to collinearity!\n")
Note the HUGE standard errors due to collinearity!# VIF (Variance Inflation Factor)
library(car)
fit <- lm(milk_yield ~ fat_pct + protein_pct + lactose_pct)
vif_values <- vif(fit)
cat("\nVIF (>10 indicates severe collinearity):\n")
VIF (>10 indicates severe collinearity):print(vif_values) fat_pct protein_pct lactose_pct
1.051 1.020 1.040 Detecting Numerical Problems
Warning signs:
- Huge standard errors (compared to estimates)
- Estimates change drastically when you add/remove observations
- Opposite signs from what you expect biologically
solve()fails with “system is computationally singular”- VIF > 10 for any predictor
- Condition number > 10^6
Diagnostic checklist:
# 1. Check condition number
kappa_value <- kappa(XtX)
if (kappa_value > 1e6) warning("Severely ill-conditioned!")
# 2. Check correlations
cor_matrix <- cor(X[, -1]) # Exclude intercept
if (any(abs(cor_matrix[upper.tri(cor_matrix)]) > 0.95)) {
warning("High correlations detected!")
}
# 3. Check VIF
library(car)
fit <- lm(y ~ X - 1)
vif_values <- vif(fit)
if (any(vif_values > 10)) warning("High VIF detected!")
# 4. Check eigenvalues
eigenvalues <- eigen(XtX)$values
if (min(eigenvalues) < 1e-10) warning("Near-zero eigenvalue!")
# 5. Examine SE/estimate ratios
se_ratio <- se_b / abs(b)
if (any(se_ratio > 1, na.rm = TRUE)) {
warning("Standard error exceeds estimate!")
}
WarningWhen in Doubt, Use QR Decomposition
The QR decomposition is numerically stable even for ill-conditioned problems:
qr_obj <- qr(X)
b <- qr.coef(qr_obj, y)Why QR is better: - Avoids forming \(\mathbf{X}'\mathbf{X}\) (condition number squared!) - Uses orthogonal transformations (preserve lengths, numerically stable) - Automatic detection of rank deficiency - Used by lm() under the hood
16.11.2 Efficient Computation
Choosing the right algorithm can make the difference between a computation taking seconds versus hours. This section presents the best algorithms for common linear models tasks.
Algorithm Comparison: Solving \(\mathbf{X}'\mathbf{X}\mathbf{b} = \mathbf{X}'\mathbf{y}\)
Five methods, ranked by numerical stability and speed:
| Method | Operation Count | Stability | When to Use |
|---|---|---|---|
| QR decomposition | \(O(np^2)\) | Excellent | Default choice |
| Cholesky | \(O(p^3/3)\) | Good (if well-conditioned) | X’X already computed, well-conditioned |
| solve(XtX, Xty) | \(O(p^3)\) | Good | Simple, readable code |
| SVD | \(O(np^2 + p^3)\) | Excellent | Rank-deficient, collinear |
| Direct inverse | \(O(p^3)\) | Poor | AVOID |
Method 1: QR Decomposition (Recommended)
Factorization: \(\mathbf{X} = \mathbf{QR}\) where \(\mathbf{Q}' \mathbf{Q} = \mathbf{I}\) and \(\mathbf{R}\) is upper triangular.
Solution: \[ \mathbf{X}'\mathbf{X}\mathbf{b} = \mathbf{X}'\mathbf{y} \implies \mathbf{R}'\mathbf{R}\mathbf{b} = \mathbf{R}'\mathbf{Q}'\mathbf{y} \implies \mathbf{R}\mathbf{b} = \mathbf{Q}'\mathbf{y} \]
Solve by back-substitution (fast and stable).
Advantages: - Never forms \(\mathbf{X}'\mathbf{X}\) (avoids squaring condition number) - Detects rank deficiency automatically - Used by lm() in R - Most numerically stable
R Implementation:
set.seed(100)
n <- 100
p <- 5
X <- matrix(rnorm(n * p), n, p)
y <- rnorm(n)
# QR decomposition
qr_obj <- qr(X)
# Extract Q and R (for illustration)
Q <- qr.Q(qr_obj)
R <- qr.R(qr_obj)
# Verify X = QR
cat("X = QR?", all.equal(X, Q %*% R), "\n")X = QR? TRUE # Verify Q'Q = I
cat("Q'Q = I?", all.equal(crossprod(Q), diag(ncol(Q))), "\n")Q'Q = I? TRUE # Solve for b
b_qr <- qr.coef(qr_obj, y)
# Get fitted values and residuals
y_hat_qr <- qr.fitted(qr_obj, y)
resid_qr <- qr.resid(qr_obj, y)
cat("\nFirst 3 coefficients:", b_qr[1:3], "\n")
First 3 coefficients: -0.05373 -0.00965 -0.1087 # Compare with lm()
fit_lm <- lm(y ~ X - 1)
cat("Match lm()?", all.equal(as.numeric(b_qr), coef(fit_lm)), "\n")Match lm()? names for current but not for target Method 2: Cholesky Decomposition
Factorization: \(\mathbf{X}'\mathbf{X} = \mathbf{L}\mathbf{L}'\) where \(\mathbf{L}\) is lower triangular (or \(\mathbf{R}\mathbf{R}'\) with \(\mathbf{R}\) upper triangular).
Solution: 1. Compute \(\mathbf{X}'\mathbf{X}\) and \(\mathbf{X}'\mathbf{y}\) 2. Factor: \(\mathbf{X}'\mathbf{X} = \mathbf{R}'\mathbf{R}\) 3. Solve \(\mathbf{R}'\mathbf{w} = \mathbf{X}'\mathbf{y}\) (forward substitution) 4. Solve \(\mathbf{R}\mathbf{b} = \mathbf{w}\) (back substitution)
Advantages: - Faster than QR if \(p \ll n\) - Exploits symmetry and positive definiteness - Good for repeated solves with same \(\mathbf{X}'\mathbf{X}\)
Disadvantages: - Requires \(\mathbf{X}'\mathbf{X}\) to be positive definite - Less stable than QR for ill-conditioned matrices
R Implementation:
# Same data as above
XtX <- crossprod(X)
Xty <- crossprod(X, y)
# Cholesky factorization
R_chol <- chol(XtX) # Upper triangular
# Verify X'X = R'R
cat("X'X = R'R?", all.equal(XtX, t(R_chol) %*% R_chol), "\n")X'X = R'R? TRUE # Solve R'w = X'y
w <- forwardsolve(t(R_chol), Xty)
# Solve Rb = w
b_chol <- backsolve(R_chol, w)
cat("QR = Cholesky?", all.equal(b_qr, b_chol), "\n")QR = Cholesky? Attributes: < target is NULL, current is list > target is numeric, current is matrix # Shortcut: chol2inv() to get (X'X)^(-1)
XtX_inv <- chol2inv(R_chol)
b_chol2 <- XtX_inv %*% Xty
cat("Alternative Cholesky:", all.equal(b_chol, b_chol2), "\n")Alternative Cholesky: TRUE Method 3: Direct solve()
R’s solve() uses LU decomposition with partial pivoting.
# Method 1: Form inverse (BAD!)
XtX_inv_bad <- solve(XtX)
b_bad <- XtX_inv_bad %*% Xty
# Method 2: Solve directly (GOOD!)
b_solve <- solve(XtX, Xty)
cat("Both methods agree:", all.equal(b_bad, b_solve), "\n")Both methods agree: TRUE # But Method 2 is faster and more accurate
# Benchmark
library(microbenchmark)
mbm <- microbenchmark(
inverse = solve(XtX) %*% Xty,
direct = solve(XtX, Xty),
times = 100
)
print(summary(mbm)[, c("expr", "median")]) expr median
1 inverse 23.38
2 direct 15.00Method 4: SVD (for rank-deficient problems)
Singular Value Decomposition: \(\mathbf{X} = \mathbf{U}\mathbf{D}\mathbf{V}'\)
- \(\mathbf{U}\): \(n \times p\) orthogonal
- \(\mathbf{D}\): \(p \times p\) diagonal (singular values)
- \(\mathbf{V}\): \(p \times p\) orthogonal
Moore-Penrose inverse: \(\mathbf{X}^+ = \mathbf{V}\mathbf{D}^+\mathbf{U}'\)
# Create rank-deficient X
X_rank_def <- X
X_rank_def[, 5] <- X_rank_def[, 1] + X_rank_def[, 2] # Perfect collinearity
# QR will detect rank deficiency
qr_obj_def <- qr(X_rank_def)
cat("Rank of X:", qr_obj_def$rank, "(should be 4, not 5)\n")Rank of X: 4 (should be 4, not 5)# SVD approach
svd_obj <- svd(X_rank_def)
d <- svd_obj$d
u <- svd_obj$u
v <- svd_obj$v
# Threshold small singular values
threshold <- 1e-10
d_inv <- ifelse(d > threshold, 1/d, 0)
# Moore-Penrose inverse
X_pinv <- v %*% diag(d_inv) %*% t(u)
b_svd <- X_pinv %*% y
cat("\nSingular values:", d, "\n")
Singular values: 15.08 11.51 10.29 8.206 2.439e-15 cat("Small singular value indicates rank deficiency\n")Small singular value indicates rank deficiency# Compare with MASS::ginv()
library(MASS)
b_ginv <- ginv(X_rank_def) %*% y
cat("SVD = ginv()?", all.equal(b_svd, b_ginv, check.attributes = FALSE), "\n")SVD = ginv()? TRUE When to Use Which Method?
Decision tree:
Is X'X rank deficient?
├─ YES → Use SVD or generalized inverse
│ (See Week 12 on non-full rank models)
│
└─ NO → Is X'X already computed?
├─ YES → Is condition number < 1000?
│ ├─ YES → Use Cholesky
│ └─ NO → Use QR
│
└─ NO → Always use QR
TipPractical Recommendations
For most linear models work:
# Just use lm() or lm.fit()
fit <- lm(y ~ X)
# OR
fit <- lm.fit(X, y)If you must code your own:
# Use QR
qr_obj <- qr(X)
b <- qr.coef(qr_obj, y)For repeated solves (same \(\mathbf{X}\), different \(\mathbf{y}\)):
# Factor once
qr_obj <- qr(X)
# Solve many times
b1 <- qr.coef(qr_obj, y1)
b2 <- qr.coef(qr_obj, y2)
b3 <- qr.coef(qr_obj, y3)Beef Cattle Example: Algorithm Comparison
Scenario: Compare methods for n=500, p=10.
# Realistic beef cattle data
set.seed(999)
n <- 500
p <- 10
# Design matrix: breed, sex, sire, dam, pen effects, etc.
X <- matrix(rnorm(n * p), n, p)
X[, 1] <- 1 # Intercept
y <- rnorm(n, mean = 450, sd = 50) # Carcass weight, kg
# Method 1: QR (best)
system.time({
qr_obj <- qr(X)
b1 <- qr.coef(qr_obj, y)
}) user system elapsed
0.001 0.000 0.000 # Method 2: Cholesky (fast if well-conditioned)
system.time({
XtX <- crossprod(X)
Xty <- crossprod(X, y)
R <- chol(XtX)
b2 <- backsolve(R, forwardsolve(t(R), Xty))
}) user system elapsed
0 0 0 # Method 3: Direct solve (easy)
system.time({
XtX <- crossprod(X)
Xty <- crossprod(X, y)
b3 <- solve(XtX, Xty)
}) user system elapsed
0.001 0.000 0.001 # Method 4: lm.fit() (easiest)
system.time({
fit <- lm.fit(X, y)
b4 <- fit$coefficients
}) user system elapsed
0.000 0.000 0.001 # Verify all agree
cat("QR = Cholesky?", all.equal(b1, b2), "\n")QR = Cholesky? Attributes: < target is NULL, current is list > target is numeric, current is matrix cat("QR = solve()?", all.equal(b1, b3), "\n")QR = solve()? Attributes: < target is NULL, current is list > target is numeric, current is matrix cat("QR = lm.fit()?", all.equal(b1, b4, check.attributes = FALSE), "\n")QR = lm.fit()? TRUE # Check condition number
cat("\nCondition number of X'X:", kappa(crossprod(X)), "\n")
Condition number of X'X: 2.365 Computing Standard Errors Efficiently
Don’t compute \((\mathbf{X}'\mathbf{X})^{-1}\) unless you need the full variance-covariance matrix!
# Suppose we only need SE for one coefficient (e.g., β₁)
# Method 1: Full inverse (SLOW if you only need one SE)
XtX <- crossprod(X)
XtX_inv <- solve(XtX)
sigma2_hat <- sum((y - X %*% b1)^2) / (n - p)
se_full <- sqrt(diag(XtX_inv) * sigma2_hat)
# Method 2: Solve for specific columns (FASTER)
# Var(b_j) = [(X'X)^(-1)]_jj * σ²
# To get [(X'X)^(-1)]_jj, solve X'X * v_j = e_j
e1 <- c(0, 1, 0, 0, 0, 0, 0, 0, 0, 0) # Second coefficient (β₁)
v1 <- solve(XtX, e1)
var_b1_method2 <- v1[2] * sigma2_hat
se_b1_method2 <- sqrt(var_b1_method2)
cat("SE(β₁) via full inverse:", se_full[2], "\n")SE(β₁) via full inverse: 2.289 cat("SE(β₁) via single solve:", se_b1_method2, "\n")SE(β₁) via single solve: 2.289 cat("Match?", all.equal(se_full[2], se_b1_method2), "\n")Match? TRUE
NoteMemory Considerations
For very large \(n\):
- QR decomposition: Stores \(n \times p\) matrix \(\mathbf{Q}\) → \(O(np)\) memory
- Cholesky: Only stores \(p \times p\) matrix \(\mathbf{R}\) → \(O(p^2)\) memory
- Trade-off: Cholesky uses less memory but requires forming \(\mathbf{X}'\mathbf{X}\)
Rule of thumb: - If \(n > 10p\), Cholesky saves memory - If worried about stability, always use QR
Summary: Algorithm Selection
| Situation | Best Algorithm | R Function |
|---|---|---|
| General linear models | QR decomposition | lm() or qr.coef() |
| Well-conditioned X’X | Cholesky | chol() then backsolve() |
| Rank deficient | SVD or g-inverse | svd() or MASS::ginv() |
| Need full Var(b) | QR or Cholesky | lm() then vcov() |
| Just need estimates | QR | qr.coef() |
| Repeated solves | Factor once, solve many | Store qr_obj |
| Large \(n\), small \(p\) | Cholesky (memory) | chol() |
| Ill-conditioned | QR or SVD | qr() or svd() |
16.11.3 Checking Your Work
Trust, but verify. Even careful programmers make mistakes. This section presents systematic strategies for verifying matrix computations.
ImportantThe Cardinal Rule of Numerical Computing
Always verify your results!
Check your work by: 1. Testing matrix properties 2. Comparing with known solutions 3. Verifying against lm() 4. Checking mathematical identities 5. Using all.equal() for tolerant comparisons
Using all.equal() Correctly
Never use == for floating-point comparisons!
# Example: Two ways to compute the same thing
x <- c(1, 2, 3)
result1 <- sum(x) / length(x)
result2 <- mean(x)
# BAD: Exact comparison (may fail due to rounding!)
if (result1 == result2) {
cat("Equal!\n")
} else {
cat("Not equal!\n") # Might happen even though they're the same!
}Equal!# GOOD: Tolerant comparison
if (all.equal(result1, result2)) {
cat("Equal (within tolerance)!\n")
}Equal (within tolerance)!# Show the default tolerance
tolerance <- sqrt(.Machine$double.eps) # ≈ 1.5e-8
cat("Default tolerance:", tolerance, "\n")Default tolerance: 1.49e-08 # Custom tolerance
cat("Equal with tighter tolerance?",
all.equal(result1, result2, tolerance = 1e-15), "\n")Equal with tighter tolerance? TRUE # Checking matrices
A <- matrix(c(1, 2, 3, 4), 2, 2)
B <- A + 1e-10 # Tiny difference
cat("\nA == B (exact)?", all(A == B), "\n")
A == B (exact)? FALSE cat("all.equal(A, B)?", all.equal(A, B), "\n")all.equal(A, B)? TRUE Verification Checklist for Linear Models
When you implement a least squares solver, verify these properties:
1. Normal equations satisfied: \(\mathbf{X}'\mathbf{X}\mathbf{b} = \mathbf{X}'\mathbf{y}\)
# Setup
set.seed(111)
n <- 50
p <- 3
X <- matrix(rnorm(n * p), n, p)
y <- rnorm(n)
# Solve
b <- solve(crossprod(X), crossprod(X, y))
# Check: X'Xb should equal X'y
LHS <- crossprod(X) %*% b
RHS <- crossprod(X, y)
cat("Normal equations satisfied?", all.equal(LHS, RHS), "\n")Normal equations satisfied? TRUE cat("Max absolute difference:", max(abs(LHS - RHS)), "\n")Max absolute difference: 0 2. Residuals orthogonal to X: \(\mathbf{X}'\mathbf{e} = \mathbf{0}\)
# Compute residuals
y_hat <- X %*% b
e <- y - y_hat
# Check orthogonality
Xte <- crossprod(X, e)
cat("X'e = 0?", all.equal(Xte, matrix(0, p, 1), check.attributes = FALSE), "\n")X'e = 0? TRUE cat("Max |X'e|:", max(abs(Xte)), "\n")Max |X'e|: 2.415e-15 3. Fitted values orthogonal to residuals: \(\hat{\mathbf{y}}'\mathbf{e} = 0\)
inner_product <- t(y_hat) %*% e
cat("y_hat'e = 0?", all.equal(inner_product, matrix(0, 1, 1), check.attributes = FALSE), "\n")y_hat'e = 0? TRUE cat("|y_hat'e| =", abs(inner_product), "\n")|y_hat'e| = 4.996e-16 4. Sum of squares decomposition: \(\text{SST} = \text{SSM} + \text{SSE}\)
y_bar <- mean(y)
SST <- sum((y - y_bar)^2)
SSM <- sum((y_hat - y_bar)^2)
SSE <- sum(e^2)
cat("SST =", SST, "\n")SST = 38.12 cat("SSM =", SSM, "\n")SSM = 3.22 cat("SSE =", SSE, "\n")SSE = 37.51 cat("SSM + SSE =", SSM + SSE, "\n")SSM + SSE = 40.73 cat("SST = SSM + SSE?", all.equal(SST, SSM + SSE), "\n")SST = SSM + SSE? Mean relative difference: 0.06853 5. Compare with lm()
# Your implementation
my_results <- list(
coefficients = b,
fitted = y_hat,
residuals = e,
sigma = sqrt(SSE / (n - p))
)
# R's lm()
fit_lm <- lm.fit(X, y)
# Compare
cat("Coefficients match?",
all.equal(as.numeric(my_results$coefficients),
fit_lm$coefficients), "\n")Coefficients match? names for current but not for target cat("Fitted values match?",
all.equal(as.numeric(my_results$fitted),
fit_lm$fitted.values), "\n")Fitted values match? TRUE cat("Residuals match?",
all.equal(as.numeric(my_results$residuals),
fit_lm$residuals), "\n")Residuals match? TRUE Testing Matrix Properties
Template function for verifying matrix properties:
test_matrix_properties <- function(A, name = "A", tolerance = 1e-10) {
cat("\n=== Testing", name, "===\n")
# 1. Check dimensions
cat("Dimensions:", nrow(A), "×", ncol(A), "\n")
# 2. Check if square
is_square <- nrow(A) == ncol(A)
cat("Square?", is_square, "\n")
if (is_square) {
# 3. Check symmetry
is_symmetric <- all.equal(A, t(A), tolerance = tolerance)
cat("Symmetric?", isTRUE(is_symmetric), "\n")
# 4. Check if diagonal
is_diag <- all(A[row(A) != col(A)] < tolerance)
cat("Diagonal?", is_diag, "\n")
# 5. Check idempotence (A² = A)
A2 <- A %*% A
is_idempotent <- all.equal(A, A2, tolerance = tolerance)
cat("Idempotent?", isTRUE(is_idempotent), "\n")
# 6. Rank
cat("Rank:", qr(A)$rank, "\n")
# 7. Condition number
kappa_A <- kappa(A)
cat("Condition number:", kappa_A, "\n")
if (kappa_A > 1000) {
cat(" WARNING: Ill-conditioned!\n")
}
# 8. Eigenvalues
eigenvalues <- eigen(A, only.values = TRUE)$values
cat("Eigenvalues:", eigenvalues, "\n")
# 9. Positive definite?
is_pd <- all(eigenvalues > tolerance)
cat("Positive definite?", is_pd, "\n")
# 10. Trace
cat("Trace:", sum(diag(A)), "\n")
# 11. Determinant
cat("Determinant:", det(A), "\n")
}
invisible(NULL)
}
# Test on hat matrix
X <- matrix(rnorm(50 * 3), 50, 3)
H <- X %*% solve(crossprod(X)) %*% t(X)
test_matrix_properties(H, "Hat matrix H")
=== Testing Hat matrix H ===
Dimensions: 50 × 50
Square? TRUE
Symmetric? TRUE
Diagonal? FALSE
Idempotent? TRUE
Rank: 3
Condition number: 3.236e+19
WARNING: Ill-conditioned!
Eigenvalues: 1 1 1 4.802e-16 3.754e-16 3.231e-16 2.79e-16 2.37e-16 2.243e-16 2.075e-16 1.476e-16 1.286e-16 9.532e-17 7.989e-17 6.62e-17 5.975e-17 4.807e-17 3.753e-17 3.164e-17 2.373e-17 2.159e-17 1.523e-17 1.382e-17 9.276e-18 7.454e-18 2.488e-18 5.046e-19 -3.16e-18 -6.523e-18 -1.002e-17 -1.456e-17 -1.929e-17 -1.986e-17 -2.377e-17 -3.054e-17 -4.039e-17 -4.404e-17 -6.616e-17 -6.891e-17 -8.849e-17 -1.1e-16 -1.499e-16 -1.726e-16 -2.17e-16 -2.215e-16 -2.5e-16 -2.704e-16 -4.076e-16 -4.509e-16 -6.604e-16
Positive definite? FALSE
Trace: 3
Determinant: 0 # Test on residual maker
M <- diag(nrow(X)) - H
test_matrix_properties(M, "Residual maker M")
=== Testing Residual maker M ===
Dimensions: 50 × 50
Square? TRUE
Symmetric? TRUE
Diagonal? FALSE
Idempotent? TRUE
Rank: 47
Condition number: 1.514e+17
WARNING: Ill-conditioned!
Eigenvalues: 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 4.094e-16 -8.33e-17 -4.709e-16
Positive definite? FALSE
Trace: 47
Determinant: 4.641e-48 Debugging Numerical Issues
Common problems and how to diagnose them:
debug_linear_model <- function(X, y) {
cat("=== Debugging Linear Model ===\n\n")
n <- nrow(X)
p <- ncol(X)
# 1. Check for NAs
cat("1. Checking for missing values:\n")
cat(" NAs in X:", sum(is.na(X)), "\n")
cat(" NAs in y:", sum(is.na(y)), "\n")
# 2. Check dimensions
cat("\n2. Checking dimensions:\n")
cat(" n =", n, "\n")
cat(" p =", p, "\n")
cat(" n > p?", n > p, "(need this for full rank)\n")
# 3. Check rank
cat("\n3. Checking rank:\n")
rank_X <- qr(X)$rank
cat(" rank(X) =", rank_X, "\n")
cat(" Full rank?", rank_X == p, "\n")
# 4. Check condition number
cat("\n4. Checking condition number:\n")
XtX <- crossprod(X)
kappa_XtX <- kappa(XtX)
cat(" κ(X'X) =", kappa_XtX, "\n")
if (kappa_XtX > 1e6) {
cat(" WARNING: Severely ill-conditioned!\n")
} else if (kappa_XtX > 1000) {
cat(" WARNING: Ill-conditioned!\n")
} else {
cat(" OK: Well-conditioned\n")
}
# 5. Check for perfect collinearity
cat("\n5. Checking for collinearity:\n")
if (p > 1) {
cor_matrix <- cor(X)
max_cor <- max(abs(cor_matrix[upper.tri(cor_matrix)]))
cat(" Max |correlation| =", max_cor, "\n")
if (max_cor > 0.99) {
cat(" WARNING: Very high correlation detected!\n")
}
}
# 6. Try to solve
cat("\n6. Attempting to solve:\n")
tryCatch({
b <- solve(XtX, crossprod(X, y))
cat(" SUCCESS: Solution found\n")
cat(" Coefficients:", b, "\n")
# Check residuals
e <- y - X %*% b
SSE <- sum(e^2)
sigma2 <- SSE / (n - p)
cat(" σ² =", sigma2, "\n")
# Check if any SE are huge
se_b <- sqrt(diag(solve(XtX)) * sigma2)
max_se_ratio <- max(abs(se_b / b), na.rm = TRUE)
cat(" Max SE/estimate ratio:", max_se_ratio, "\n")
if (max_se_ratio > 1) {
cat(" WARNING: Some SEs exceed estimates!\n")
}
}, error = function(e) {
cat(" ERROR:", e$message, "\n")
cat(" System is computationally singular!\n")
})
}
# Test on good data
cat("### Test 1: Good data ###\n")### Test 1: Good data ###X_good <- matrix(rnorm(50 * 3), 50, 3)
y_good <- rnorm(50)
debug_linear_model(X_good, y_good)=== Debugging Linear Model ===
1. Checking for missing values:
NAs in X: 0
NAs in y: 0
2. Checking dimensions:
n = 50
p = 3
n > p? TRUE (need this for full rank)
3. Checking rank:
rank(X) = 3
Full rank? TRUE
4. Checking condition number:
κ(X'X) = 1.419
OK: Well-conditioned
5. Checking for collinearity:
Max |correlation| = 0.1113
6. Attempting to solve:
SUCCESS: Solution found
Coefficients: -0.04631 -0.01226 -0.2153
σ² = 0.7251
Max SE/estimate ratio: 8.983
WARNING: Some SEs exceed estimates!# Test on collinear data
cat("\n\n### Test 2: Collinear data ###\n")
### Test 2: Collinear data ###X_bad <- matrix(rnorm(50 * 3), 50, 3)
X_bad[, 3] <- X_bad[, 1] + X_bad[, 2] # Perfect collinearity
y_bad <- rnorm(50)
debug_linear_model(X_bad, y_bad)=== Debugging Linear Model ===
1. Checking for missing values:
NAs in X: 0
NAs in y: 0
2. Checking dimensions:
n = 50
p = 3
n > p? TRUE (need this for full rank)
3. Checking rank:
rank(X) = 2
Full rank? FALSE
4. Checking condition number:
κ(X'X) = 8.008e+16
WARNING: Severely ill-conditioned!
5. Checking for collinearity:
Max |correlation| = 0.7484
6. Attempting to solve:
ERROR: system is computationally singular: reciprocal condition number = 2.15156e-17
System is computationally singular!Unit Testing Template
Create a test suite for your solver:
# Function to test
my_lm_solver <- function(X, y) {
XtX <- crossprod(X)
Xty <- crossprod(X, y)
b <- solve(XtX, Xty)
return(b)
}
# Test suite
test_lm_solver <- function() {
all_pass <- TRUE
# Test 1: Simple case
cat("Test 1: Simple case... ")
X <- matrix(c(1, 1, 1, 1, 2, 3), 3, 2)
y <- c(1, 2, 2)
b <- my_lm_solver(X, y)
b_expected <- solve(crossprod(X), crossprod(X, y))
if (all.equal(b, b_expected)) {
cat("PASS\n")
} else {
cat("FAIL\n")
all_pass <- FALSE
}
# Test 2: Compare with lm()
cat("Test 2: Match lm()... ")
X <- matrix(rnorm(100 * 5), 100, 5)
y <- rnorm(100)
b_mine <- my_lm_solver(X, y)
b_lm <- lm.fit(X, y)$coefficients
if (all.equal(as.numeric(b_mine), b_lm)) {
cat("PASS\n")
} else {
cat("FAIL\n")
all_pass <- FALSE
}
# Test 3: Residuals orthogonal to X
cat("Test 3: X'e = 0... ")
e <- y - X %*% b_mine
Xte <- crossprod(X, e)
if (all.equal(Xte, matrix(0, 5, 1), check.attributes = FALSE)) {
cat("PASS\n")
} else {
cat("FAIL\n")
all_pass <- FALSE
}
# Test 4: SS decomposition
cat("Test 4: SST = SSM + SSE... ")
y_bar <- mean(y)
y_hat <- X %*% b_mine
SST <- sum((y - y_bar)^2)
SSM <- sum((y_hat - y_bar)^2)
SSE <- sum(e^2)
if (all.equal(SST, SSM + SSE)) {
cat("PASS\n")
} else {
cat("FAIL\n")
all_pass <- FALSE
}
# Summary
cat("\n")
if (all_pass) {
cat("ALL TESTS PASSED ✓\n")
} else {
cat("SOME TESTS FAILED ✗\n")
}
return(all_pass)
}
# Run tests
test_lm_solver()Quick Verification Functions
Handy functions to keep in your toolkit:
# Check if matrix is symmetric
is_symmetric <- function(A, tol = 1e-10) {
isTRUE(all.equal(A, t(A), tolerance = tol))
}
# Check if matrix is idempotent
is_idempotent <- function(A, tol = 1e-10) {
isTRUE(all.equal(A, A %*% A, tolerance = tol))
}
# Check if two vectors are orthogonal
is_orthogonal <- function(x, y, tol = 1e-10) {
abs(sum(x * y)) < tol
}
# Check normal equations
check_normal_equations <- function(X, y, b, tol = 1e-10) {
LHS <- crossprod(X) %*% b
RHS <- crossprod(X, y)
max(abs(LHS - RHS)) < tol
}
# Check projection property
check_projection <- function(P, tol = 1e-10) {
is_symmetric(P, tol) && is_idempotent(P, tol)
}
# Use them
X <- matrix(rnorm(50 * 3), 50, 3)
H <- X %*% solve(crossprod(X)) %*% t(X)
cat("H is symmetric?", is_symmetric(H), "\n")H is symmetric? TRUE cat("H is idempotent?", is_idempotent(H), "\n")H is idempotent? TRUE cat("H is projection?", check_projection(H), "\n")H is projection? TRUE
TipBest Practices Summary
Always: 1. ✅ Use all.equal() for comparisons, not == 2. ✅ Verify normal equations are satisfied 3. ✅ Check residual orthogonality 4. ✅ Verify SS decomposition 5. ✅ Compare with lm() output 6. ✅ Check condition numbers 7. ✅ Test on known cases first
Debugging strategy: 1. Start with small, simple test cases 2. Check dimensions and ranks 3. Verify mathematical properties 4. Compare with trusted implementations 5. Use diagnostic functions systematically 6. Profile code for performance bottlenecks
When something goes wrong: - Print intermediate results - Check for NAs, Infs, or NaNs - Verify matrix dimensions match - Test on well-conditioned data first - Use debug() and browser() in R
Complete Verification Example
Putting it all together for a livestock example:
# Swine litter size example
set.seed(2024)
n <- 30
parity <- sample(1:5, n, replace = TRUE)
X <- cbind(1, parity)
y <- 8 + 1.2 * parity + rnorm(n, sd = 1.5)
cat("=== Complete Verification Example ===\n\n")=== Complete Verification Example ===# Solve
b <- solve(crossprod(X), crossprod(X, y))
cat("Estimates: Intercept =", b[1], ", Slope =", b[2], "\n\n")Estimates: Intercept = 8.993 , Slope = 0.9083 # Verification checklist
cat("1. Normal equations: X'Xb = X'y?\n")1. Normal equations: X'Xb = X'y?cat(" ", check_normal_equations(X, y, b), "\n\n") TRUE cat("2. Residuals orthogonal to X?\n")2. Residuals orthogonal to X?e <- y - X %*% b
cat(" Max |X'e| =", max(abs(crossprod(X, e))), "\n\n") Max |X'e| = 7.638e-14 cat("3. Fitted values orthogonal to residuals?\n")3. Fitted values orthogonal to residuals?y_hat <- X %*% b
cat(" |y_hat'e| =", abs(sum(y_hat * e)), "\n\n") |y_hat'e| = 6.137e-13 cat("4. SS decomposition: SST = SSM + SSE?\n")4. SS decomposition: SST = SSM + SSE?y_bar <- mean(y)
SST <- sum((y - y_bar)^2)
SSM <- sum((y_hat - y_bar)^2)
SSE <- sum(e^2)
cat(" SST =", SST, "\n") SST = 101.8 cat(" SSM + SSE =", SSM + SSE, "\n") SSM + SSE = 101.8 cat(" Match?", all.equal(SST, SSM + SSE), "\n\n") Match? TRUE cat("5. Compare with lm():\n")5. Compare with lm():fit <- lm(y ~ parity)
cat(" Coefficients match?",
all.equal(as.numeric(b), coef(fit), check.attributes = FALSE), "\n\n") Coefficients match? TRUE cat("6. Projection matrix properties:\n")6. Projection matrix properties:H <- X %*% solve(crossprod(X)) %*% t(X)
cat(" H symmetric?", is_symmetric(H), "\n") H symmetric? TRUE cat(" H idempotent?", is_idempotent(H), "\n") H idempotent? TRUE cat(" tr(H) = p?", all.equal(sum(diag(H)), ncol(X)), "\n\n") tr(H) = p? TRUE cat("7. Condition number:\n")7. Condition number:cat(" κ(X'X) =", kappa(crossprod(X)), "\n\n") κ(X'X) = 87.82 cat("✓ ALL CHECKS PASSED\n")✓ ALL CHECKS PASSED16.12 Cross-Reference Table
This comprehensive table maps matrix algebra concepts to their locations in the course and provides quick reference for R implementations.
NoteHow to Use This Table
- Concept: Matrix algebra term or operation
- Section: Where it’s defined in this appendix
- Key Formula: Most important identity or formula
- Used in Weeks: Course weeks where this concept appears
- R Function: Primary R function(s) for computation
- Notes: Critical usage notes or warnings
16.12.1 Core Matrix Operations
| Concept | Section | Key Formula | Used in Weeks | R Function | Notes |
|---|---|---|---|---|---|
| Matrix transpose | Section 16.2.3 | \((\mathbf{A}')' = \mathbf{A}\) | 1-15 | t(A) |
Use crossprod() instead of t(X) %*% X |
| Matrix multiplication | Section 16.2.2 | \((\mathbf{AB})' = \mathbf{B}'\mathbf{A}'\) | 1-15 | %*% |
Not commutative! |
| Cross-product | Section 16.10.4 | \(\mathbf{X}'\mathbf{X}\) | 4-15 | crossprod(X) |
2× faster than t(X) %*% X |
| Outer product | Section 16.10.4 | \(\mathbf{X}\mathbf{X}'\) | 5-11 | tcrossprod(X) |
Avoid for large \(n\) |
| Kronecker product | Section 16.9 | \(\mathbf{A} \otimes \mathbf{B}\) | 14 (preview) | kronecker(A, B) |
Never form explicitly for large matrices! |
16.12.2 Special Matrices
| Concept | Section | Key Formula | Used in Weeks | R Function | Notes |
|---|---|---|---|---|---|
| Identity matrix | Section 16.3.1 | \(\mathbf{I}_n\mathbf{A} = \mathbf{A}\) | 1-15 | diag(n) |
|
| Diagonal matrix | Section 16.3.2 | \(\mathbf{D} = \text{diag}(d_1, \ldots, d_n)\) | 2-15 | diag(x) |
Creates diagonal or extracts diagonal |
| Symmetric matrix | Section 16.3.3 | \(\mathbf{A}' = \mathbf{A}\) | 2-15 | isSymmetric(A) |
\(\mathbf{X}'\mathbf{X}\) always symmetric |
| Orthogonal matrix | Section 16.3.4 | \(\mathbf{Q}'\mathbf{Q} = \mathbf{I}\) | 2, 5, 11 | qr.Q() |
Preserves lengths, numerically stable |
| Idempotent matrix | Section 16.3.5 | \(\mathbf{P}^2 = \mathbf{P}\) | 5, 6, 11 | Custom function | Projection matrices are idempotent |
| Hat matrix | Section 16.6.1 | \(\mathbf{H} = \mathbf{X}(\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}'\) | 5, 6, 11 | hatvalues() |
NEVER form explicitly for large \(n\) |
| Residual maker | Section 16.6.1 | \(\mathbf{M} = \mathbf{I} - \mathbf{H}\) | 5, 6, 11 | Use implicitly | \(\mathbf{e} = \mathbf{M}\mathbf{y}\) |
| Centering matrix | Section 16.3 | \(\mathbf{C} = \mathbf{I} - n^{-1}\mathbf{1}\mathbf{1}'\) | 4-10 | scale(center=TRUE) |
For computing SST |
16.12.3 Matrix Properties
| Concept | Section | Key Formula | Used in Weeks | R Function | Notes |
|---|---|---|---|---|---|
| Rank | Section 16.4.1 | \(r(\mathbf{X}'\mathbf{X}) = r(\mathbf{X})\) | 2, 7, 12 | qr()$rank |
Critical for estimability |
| Trace | Section 16.4.2 | \(\text{tr}(\mathbf{H}) = p\) | 2, 5, 6 | sum(diag(A)) |
Sum of eigenvalues |
| Determinant | Section 16.4.3 | \(\det(\mathbf{AB}) = \det(\mathbf{A})\det(\mathbf{B})\) | 2, 5 | det(A) |
Zero if singular |
| Condition number | Section 16.11.1 | \(\kappa(\mathbf{A}) = \lambda_{\max}/\lambda_{\min}\) | 6, 11, 12 | kappa(A) |
\(>10^6\) is severely ill-conditioned |
| Eigenvalues | Section 16.7 | \(\mathbf{A}\mathbf{v} = \lambda\mathbf{v}\) | 2, 7 | eigen() |
For spectral decomposition |
| Singular values | Section 16.7.4 | \(\mathbf{X} = \mathbf{UDV}'\) | 2, 11, 12 | svd() |
Most numerically stable decomposition |
16.12.4 Matrix Inverses
| Concept | Section | Key Formula | Used in Weeks | R Function | Notes |
|---|---|---|---|---|---|
| Regular inverse | Section 16.5 | \(\mathbf{A}\mathbf{A}^{-1} = \mathbf{I}\) | 2-15 | solve(A) |
Only for full-rank square matrices |
| Solve linear system | Section 16.11.2 | \(\mathbf{Ab} = \mathbf{c}\) | 4-15 | solve(A, c) |
NEVER use solve(A) %*% c |
| Generalized inverse | Section 16.5.2 | \(\mathbf{A}\mathbf{A}^-\mathbf{A} = \mathbf{A}\) | 2, 12, 13 | MASS::ginv() |
For rank-deficient systems |
| Moore-Penrose inverse | Section 16.5.2 | Unique g-inverse | 12 | MASS::ginv() |
Uses SVD |
| Cholesky decomposition | Section 16.11.2 | \(\mathbf{A} = \mathbf{R}'\mathbf{R}\) | 11 | chol(A) |
Requires positive definite |
| QR decomposition | Section 16.11.2 | \(\mathbf{X} = \mathbf{QR}\) | 2, 11 | qr() |
Most stable for normal equations |
16.12.5 Projection and Quadratic Forms
| Concept | Section | Key Formula | Used in Weeks | R Function | Notes |
|---|---|---|---|---|---|
| Projection matrix | Section 16.6.1 | \(\mathbf{P}^2 = \mathbf{P} = \mathbf{P}'\) | 5, 6 | Custom | Symmetric + idempotent |
| Fitted values | Section 16.6.1 | \(\hat{\mathbf{y}} = \mathbf{H}\mathbf{y}\) | 4-15 | fitted() or X %*% b |
Don’t form \(\mathbf{H}\) |
| Residuals | Section 16.6.1 | \(\mathbf{e} = \mathbf{M}\mathbf{y}\) | 4-15 | residuals() |
\(\mathbf{X}'\mathbf{e} = \mathbf{0}\) |
| Quadratic form | Section 16.6.2 | \(\mathbf{y}'\mathbf{A}\mathbf{y}\) | 5-10 | t(y) %*% A %*% y or sum(y * (A %*% y)) |
Sum of squares |
| Leverage | Section 16.6.1 | \(h_{ii} = [\mathbf{H}]_{ii}\) | 11 | hatvalues() |
Influence of observation \(i\) |
| Mahalanobis distance | Section 16.6.2 | \(D^2 = (\mathbf{x} - \boldsymbol{\mu})'\boldsymbol{\Sigma}^{-1}(\mathbf{x} - \boldsymbol{\mu})\) | 11 | mahalanobis() |
For outlier detection |
16.12.6 Linear Models Identities
| Concept | Section | Key Formula | Used in Weeks | R Function | Notes |
|---|---|---|---|---|---|
| Normal equations | Section 16.10.1 | \(\mathbf{X}'\mathbf{X}\mathbf{b} = \mathbf{X}'\mathbf{y}\) | 4-15 | solve(crossprod(X), crossprod(X, y)) |
Foundation of LS |
| LS solution | Section 16.10.1 | \(\mathbf{b} = (\mathbf{X}'\mathbf{X})^{-1}\mathbf{X}'\mathbf{y}\) | 4-15 | lm.fit() or qr.coef() |
Use QR, not inverse |
| Residual orthogonality | Section 16.10.1 | \(\mathbf{X}'\mathbf{e} = \mathbf{0}\) | 5-15 | Check: crossprod(X, e) |
Always verify! |
| Var(b) | Section 16.10.2 | \(\text{Var}(\mathbf{b}) = \sigma^2(\mathbf{X}'\mathbf{X})^{-1}\) | 5-15 | vcov() |
For standard errors |
| Var(y_hat) | Section 16.10.2 | \(\text{Var}(\hat{\mathbf{y}}) = \sigma^2\mathbf{H}\) | 5, 11 | sigma2 * H |
Heteroscedastic! |
| Var(e) | Section 16.10.2 | \(\text{Var}(\mathbf{e}) = \sigma^2\mathbf{M}\) | 5, 11 | sigma2 * M |
Not constant variance |
| Contrast variance | Section 16.10.2 | \(\text{Var}(\mathbf{c}'\mathbf{b}) = \sigma^2\mathbf{c}'(\mathbf{X}'\mathbf{X})^{-1}\mathbf{c}\) | 8 | Custom | For testing hypotheses |
16.12.7 Sum of Squares
| Concept | Section | Key Formula | Used in Weeks | R Function | Notes |
|---|---|---|---|---|---|
| SST | Section 16.10.3 | \(\sum(y_i - \bar{y})^2\) | 4-10 | sum((y - mean(y))^2) |
Total variation |
| SSE | Section 16.10.3 | \(\mathbf{e}'\mathbf{e} = \mathbf{y}'\mathbf{M}\mathbf{y}\) | 4-15 | sum(residuals^2) or deviance() |
Error SS |
| SSM/SSR | Section 16.10.3 | \(\mathbf{b}'\mathbf{X}'\mathbf{y} - n\bar{y}^2\) | 4-10 | From anova() |
Model/Regression SS |
| SS decomposition | Section 16.10.3 | \(\text{SST} = \text{SSM} + \text{SSE}\) | 5-10 | Always verify! | Orthogonal decomposition |
| R² | Section 16.10.3 | \(R^2 = \text{SSM}/\text{SST}\) | 4-6 | summary()$r.squared |
Proportion explained |
| Adjusted R² | Section 16.10.3 | \(\bar{R}^2 = 1 - \frac{\text{SSE}/(n-p)}{\text{SST}/(n-1)}\) | 6 | summary()$adj.r.squared |
Penalizes complexity |
16.12.8 Matrix Calculus
| Concept | Section | Key Formula | Used in Weeks | R Function | Notes |
|---|---|---|---|---|---|
| Derivative scalar wrt vector | Section 16.8 | \(\partial(\mathbf{a}'\mathbf{x})/\partial\mathbf{x} = \mathbf{a}\) | 5 | Manual | For deriving normal equations |
| Derivative quadratic form | Section 16.8 | \(\partial(\mathbf{x}'\mathbf{A}\mathbf{x})/\partial\mathbf{x} = 2\mathbf{Ax}\) | 5 | Manual | For minimizing SSE |
| Hessian | Section 16.8 | \(\partial^2 S/\partial\boldsymbol{\beta}\partial\boldsymbol{\beta}' = 2\mathbf{X}'\mathbf{X}\) | 5 | Manual | For checking convexity |
16.12.9 Computational Topics
| Concept | Section | Key Formula | Used in Weeks | R Function | Notes |
|---|---|---|---|---|---|
| VIF | Section 16.11.1 | \(\text{VIF}_j = 1/(1 - R_j^2)\) | 6, 11, 12 | car::vif() |
\(>10\) indicates collinearity |
| Centering predictors | Section 16.11.1 | \(\mathbf{X}_c = \mathbf{X} - \bar{\mathbf{X}}\) | 6, 10, 11 | scale(X, center=TRUE) |
Improves conditioning |
| Scaling predictors | Section 16.11.1 | Standardize to mean 0, sd 1 | 6, 11 | scale(X) |
For comparing effects |
| all.equal() | Section 16.11.3 | Tolerant comparison | 2-15 | all.equal(a, b) |
NEVER use == for floats |
| Numerical tolerance | Section 16.11.3 | Default \(\approx 1.5 \times 10^{-8}\) | 2-15 | .Machine$double.eps |
For checking zeros |
16.12.10 Week-Specific Applications
| Week | Primary Topics | Key Matrix Operations | Critical Sections |
|---|---|---|---|
| 1 | Overview, matrix basics | Transpose, multiplication | Section 16.2 |
| 2 | Linear algebra essentials | Rank, inverse, eigenvalues | Section 16.4.1, Section 16.5, Section 16.7 |
| 3 | Design matrices | Building \(\mathbf{X}\), coding schemes | Section 16.2 |
| 4 | Simple regression | \(\mathbf{X}'\mathbf{X}\), \(\mathbf{X}'\mathbf{y}\), \(\mathbf{b}\) | Section 16.10.1 |
| 5 | Least squares theory | \(\mathbf{H}\), \(\mathbf{M}\), projections, Gauss-Markov | Section 16.6.1 |
| 6 | Multiple regression | \(\text{Var}(\mathbf{b})\), collinearity, VIF | Section 16.10.2, Section 16.11.1 |
| 7 | One-way ANOVA | Cell means model, SS decomposition | Section 16.10.3 |
| 8 | Contrasts | \(\mathbf{c}'\mathbf{b}\), estimability | Section 16.10.2 |
| 9 | Two-way ANOVA | Multiple factors, interactions | Section 16.10.3 |
| 10 | ANCOVA | Adjusted means, homogeneity of slopes | Section 16.10.2 |
| 11 | Diagnostics | Leverage (\(h_{ii}\)), Cook’s D | Section 16.6.1, Section 16.6.2 |
| 12 | Non-full rank | Generalized inverse, constraints | Section 16.5.2 |
| 13 | Special topics I | Unbalanced data, Type I/II/III SS | Section 16.10.3 |
| 14 | Special topics II | Polynomial regression, WLS, mixed model preview | Section 16.9 |
| 15 | Capstone | All concepts integrated | All sections |
TipQuick Lookup Strategy
- Find your week in the Week-Specific Applications table
- Identify the matrix concept you need
- Look up the concept in the detailed tables above
- Navigate to the section for full details
- Use the R function provided for implementation
WarningCommon Mistakes to Avoid
Based on the course material, students commonly make these errors:
| Mistake | Correct Approach | Reference |
|---|---|---|
Using == for float comparison |
Use all.equal() |
Section 16.11.3 |
| Forming \(\mathbf{H}\) explicitly | Use \(\mathbf{X}\mathbf{b}\) instead | Section 16.10.4 |
Using solve(A) %*% c |
Use solve(A, c) |
Section 16.11.2 |
| Ignoring rank deficiency | Check qr()$rank, use g-inverse |
Section 16.11.1 |
| Not centering predictors | Use scale() for ill-conditioned \(\mathbf{X}'\mathbf{X}\) |
Section 16.11.1 |
| Forming large Kronecker products | Use inverse property, implicit operations | Section 16.9 |
Using t(X) %*% X |
Use crossprod(X) |
Section 16.10.4 |
16.13 R Code Templates
This section provides production-ready R functions for common linear models tasks. Copy and adapt these templates for your own analyses.
NoteHow to Use These Templates
Each template includes: - Complete, tested function code - Input/output specifications - Usage examples with livestock data - Error checking and validation - Documentation comments
Installation: Copy the function to your R script or save in a separate file to source().
16.13.1 Matrix Property Checker
Purpose: Comprehensive diagnostic function for checking matrix properties.
#' Check Matrix Properties
#'
#' Comprehensive diagnostic function for matrices in linear models
#'
#' @param A Matrix to check
#' @param name Character string for display (default: "A")
#' @param tolerance Numerical tolerance for checks (default: 1e-10)
#' @param verbose Logical, print detailed output? (default: TRUE)
#'
#' @return List with logical test results (invisible)
#'
#' @examples
#' X <- matrix(rnorm(50*3), 50, 3)
#' H <- X %*% solve(t(X) %*% X) %*% t(X)
#' check_matrix_properties(H, "Hat Matrix")
#'
check_matrix_properties <- function(A, name = "A", tolerance = 1e-10, verbose = TRUE) {
# Initialize results list
results <- list()
if (verbose) cat("\n=== Checking", name, "===\n\n")
# Basic properties
dims <- dim(A)
results$dimensions <- dims
if (verbose) cat("Dimensions:", dims[1], "×", dims[2], "\n")
is_square <- dims[1] == dims[2]
results$is_square <- is_square
if (verbose) cat("Square:", is_square, "\n")
if (!is_square) {
if (verbose) cat("(Additional checks require square matrix)\n")
return(invisible(results))
}
# Symmetry
is_sym <- isTRUE(all.equal(A, t(A), tolerance = tolerance))
results$is_symmetric <- is_sym
if (verbose) cat("Symmetric:", is_sym, "\n")
# Diagonal
off_diag <- A[row(A) != col(A)]
is_diag <- all(abs(off_diag) < tolerance)
results$is_diagonal <- is_diag
if (verbose) cat("Diagonal:", is_diag, "\n")
# Idempotent
A2 <- A %*% A
is_idem <- isTRUE(all.equal(A, A2, tolerance = tolerance))
results$is_idempotent <- is_idem
if (verbose) cat("Idempotent (A² = A):", is_idem, "\n")
# Rank
rank_A <- qr(A)$rank
results$rank <- rank_A
full_rank <- rank_A == min(dims)
results$full_rank <- full_rank
if (verbose) {
cat("Rank:", rank_A, "/", min(dims))
if (full_rank) cat(" (full rank)")
cat("\n")
}
# Condition number
kappa_A <- kappa(A)
results$condition_number <- kappa_A
if (verbose) {
cat("Condition number:", sprintf("%.2e", kappa_A))
if (kappa_A > 1e6) {
cat(" [SEVERELY ILL-CONDITIONED]")
} else if (kappa_A > 1000) {
cat(" [ILL-CONDITIONED]")
} else if (kappa_A > 10) {
cat(" [MODERATE]")
} else {
cat(" [WELL-CONDITIONED]")
}
cat("\n")
}
# Eigenvalues
eigen_vals <- eigen(A, only.values = TRUE)$values
results$eigenvalues <- eigen_vals
if (verbose) {
cat("Eigenvalues:", paste(sprintf("%.4f", Re(eigen_vals)), collapse=", "))
if (any(abs(Im(eigen_vals)) > tolerance)) {
cat(" [COMPLEX]")
}
cat("\n")
}
# Positive definite
is_pd <- all(Re(eigen_vals) > tolerance) && all(abs(Im(eigen_vals)) < tolerance)
results$positive_definite <- is_pd
if (verbose) cat("Positive definite:", is_pd, "\n")
# Trace
tr_A <- sum(diag(A))
results$trace <- tr_A
if (verbose) cat("Trace:", sprintf("%.4f", tr_A), "\n")
# Determinant
det_A <- det(A)
results$determinant <- det_A
results$singular <- abs(det_A) < tolerance
if (verbose) {
cat("Determinant:", sprintf("%.4e", det_A))
if (abs(det_A) < tolerance) cat(" [SINGULAR]")
cat("\n")
}
# Projection matrix check
if (is_sym && is_idem) {
if (verbose) cat("\n✓ This is a PROJECTION MATRIX\n")
results$is_projection <- TRUE
} else {
results$is_projection <- FALSE
}
return(invisible(results))
}
# Example usage
X <- matrix(rnorm(50 * 3), 50, 3)
H <- X %*% solve(t(X) %*% X) %*% t(X)
check_matrix_properties(H, "Hat Matrix")16.13.2 Build Projection Matrices
Purpose: Safely construct projection matrices with numerical stability checks.
#' Build Projection Matrices
#'
#' Construct hat matrix H and residual maker M with stability checks
#'
#' @param X Design matrix (n × p)
#' @param method Character: "qr" (default, most stable) or "cholesky"
#' @param check_properties Logical, verify projection properties? (default: TRUE)
#'
#' @return List with components:
#' - H: Hat matrix (n × n) - NOTE: only computed if n < 1000
#' - M: Residual maker (n × n) - NOTE: only computed if n < 1000
#' - qr_obj: QR decomposition object (for fitted values)
#' - rank: Rank of X
#' - is_full_rank: Logical
#'
#' @details For large n, H and M are NOT computed explicitly. Use qr_obj instead.
#'
#' @examples
#' X <- cbind(1, rnorm(50), rnorm(50))
#' proj <- build_projection_matrices(X)
#' y_hat <- proj$qr_obj$qr %*% qr.coef(proj$qr_obj, y) # Efficient
#'
build_projection_matrices <- function(X, method = "qr", check_properties = TRUE) {
n <- nrow(X)
p <- ncol(X)
# Check dimensions
if (n < p) {
stop("n must be >= p for projection matrices")
}
# QR decomposition (always computed, most stable)
qr_obj <- qr(X)
rank_X <- qr_obj$rank
is_full_rank <- rank_X == p
if (!is_full_rank) {
warning(paste("X is not full rank. Rank =", rank_X, "but p =", p))
}
# Build projection matrices (only for small n)
H <- NULL
M <- NULL
if (n < 1000) {
if (method == "qr") {
Q <- qr.Q(qr_obj)
H <- tcrossprod(Q) # Q %*% t(Q)
} else if (method == "cholesky") {
if (!is_full_rank) {
stop("Cholesky method requires full rank X")
}
XtX <- crossprod(X)
XtX_inv <- chol2inv(chol(XtX))
H <- X %*% XtX_inv %*% t(X)
} else {
stop("method must be 'qr' or 'cholesky'")
}
M <- diag(n) - H
# Verify properties
if (check_properties) {
# Check symmetry
if (!isTRUE(all.equal(H, t(H)))) {
warning("H is not symmetric (numerical issue)")
}
# Check idempotence
if (!isTRUE(all.equal(H, H %*% H, tolerance = 1e-8))) {
warning("H is not idempotent (numerical issue)")
}
# Check trace
tr_H <- sum(diag(H))
if (!isTRUE(all.equal(tr_H, rank_X, tolerance = 1e-6))) {
warning(paste("tr(H) =", tr_H, "but should be", rank_X))
}
}
} else {
message("n >= 1000: H and M not computed explicitly (too large)")
message("Use qr_obj for efficient operations instead")
}
return(list(
H = H,
M = M,
qr_obj = qr_obj,
rank = rank_X,
is_full_rank = is_full_rank,
n = n,
p = p
))
}
# Example: Small dataset
X_small <- cbind(1, rnorm(50), rnorm(50))
proj <- build_projection_matrices(X_small)
cat("Rank:", proj$rank, "\nFull rank?:", proj$is_full_rank, "\n")
# Example: Large dataset (won't form H explicitly)
X_large <- cbind(1, rnorm(5000), rnorm(5000))
proj_large <- build_projection_matrices(X_large)16.13.3 Solve Normal Equations
Purpose: Flexible solver for normal equations with multiple methods and diagnostics.
#' Solve Normal Equations
#'
#' Solve X'Xb = X'y using specified method with full diagnostics
#'
#' @param X Design matrix (n × p)
#' @param y Response vector (length n)
#' @param method Character: "qr" (default), "cholesky", "svd", or "ginv"
#' @param compute_diagnostics Logical, compute full diagnostics? (default: TRUE)
#'
#' @return List with components:
#' - coefficients: Estimated coefficients
#' - fitted.values: Fitted values
#' - residuals: Residuals
#' - sigma2: Variance estimate
#' - vcov: Variance-covariance matrix of coefficients
#' - se: Standard errors
#' - df: Degrees of freedom
#' - rank: Rank of X
#' - method: Method used
#' - diagnostics: List of diagnostic measures (if requested)
#'
#' @examples
#' X <- cbind(1, rnorm(50), rnorm(50))
#' y <- rnorm(50)
#' fit <- solve_normal_equations(X, y, method = "qr")
#' summary(fit)
#'
solve_normal_equations <- function(X, y, method = "qr", compute_diagnostics = TRUE) {
n <- nrow(X)
p <- ncol(X)
# Input validation
if (length(y) != n) {
stop("Length of y must equal nrow(X)")
}
# Initialize result
result <- list(method = method)
# Solve based on method
if (method == "qr") {
qr_obj <- qr(X)
result$rank <- qr_obj$rank
b <- qr.coef(qr_obj, y)
y_hat <- qr.fitted(qr_obj, y)
e <- qr.resid(qr_obj, y)
} else if (method == "cholesky") {
XtX <- crossprod(X)
Xty <- crossprod(X, y)
result$rank <- qr(X)$rank
R <- chol(XtX)
b <- backsolve(R, forwardsolve(t(R), Xty))
y_hat <- X %*% b
e <- y - y_hat
} else if (method == "svd") {
svd_obj <- svd(X)
result$rank <- sum(svd_obj$d > 1e-10)
d_inv <- ifelse(svd_obj$d > 1e-10, 1/svd_obj$d, 0)
X_pinv <- svd_obj$v %*% diag(d_inv) %*% t(svd_obj$u)
b <- X_pinv %*% y
y_hat <- X %*% b
e <- y - y_hat
} else if (method == "ginv") {
library(MASS)
result$rank <- qr(X)$rank
X_pinv <- ginv(X)
b <- X_pinv %*% y
y_hat <- X %*% b
e <- y - y_hat
} else {
stop("method must be 'qr', 'cholesky', 'svd', or 'ginv'")
}
# Remove names if present
b <- as.numeric(b)
y_hat <- as.numeric(y_hat)
e <- as.numeric(e)
# Basic results
result$coefficients <- b
result$fitted.values <- y_hat
result$residuals <- e
result$df <- n - result$rank
# Variance estimation
SSE <- sum(e^2)
sigma2 <- SSE / result$df
result$sigma2 <- sigma2
result$sigma <- sqrt(sigma2)
# Variance-covariance matrix
XtX <- crossprod(X)
if (result$rank == p) {
vcov_mat <- solve(XtX) * sigma2
} else {
vcov_mat <- ginv(XtX) * sigma2
}
result$vcov <- vcov_mat
result$se <- sqrt(diag(vcov_mat))
# Compute diagnostics
if (compute_diagnostics) {
diag_list <- list()
# Sum of squares
y_bar <- mean(y)
SST <- sum((y - y_bar)^2)
SSM <- sum((y_hat - y_bar)^2)
diag_list$SST <- SST
diag_list$SSM <- SSM
diag_list$SSE <- SSE
diag_list$MSE <- sigma2
diag_list$R2 <- SSM / SST
diag_list$adj_R2 <- 1 - (SSE / result$df) / (SST / (n - 1))
# Check normal equations
check_ne <- max(abs(crossprod(X, e)))
diag_list$max_Xte <- check_ne
diag_list$normal_eqs_satisfied <- check_ne < 1e-8
# Condition number
diag_list$condition_number <- kappa(XtX)
# F-statistic
if (result$rank > 1) {
MSM <- SSM / (result$rank - 1)
F_stat <- MSM / sigma2
diag_list$F_statistic <- F_stat
diag_list$F_pvalue <- pf(F_stat, result$rank - 1, result$df, lower.tail = FALSE)
}
result$diagnostics <- diag_list
}
class(result) <- "my_lm"
return(result)
}
# Print method
print.my_lm <- function(x, ...) {
cat("\nCall: solve_normal_equations(method =", paste0("'", x$method, "')\n\n"))
cat("Coefficients:\n")
print(round(x$coefficients, 4))
cat("\nResidual standard error:", round(x$sigma, 4), "on", x$df, "degrees of freedom\n")
if (!is.null(x$diagnostics)) {
cat("Multiple R-squared:", round(x$diagnostics$R2, 4), "\n")
cat("Adjusted R-squared:", round(x$diagnostics$adj_R2, 4), "\n")
}
invisible(x)
}
# Example usage
set.seed(123)
n <- 50
X <- cbind(1, rnorm(n), rnorm(n))
y <- X %*% c(10, 2, -1) + rnorm(n, sd = 2)
fit <- solve_normal_equations(X, y, method = "qr")
print(fit)
# Compare methods
fit_qr <- solve_normal_equations(X, y, "qr", compute_diagnostics = FALSE)
fit_chol <- solve_normal_equations(X, y, "cholesky", compute_diagnostics = FALSE)
cat("QR vs Cholesky:", all.equal(fit_qr$coefficients, fit_chol$coefficients), "\n")16.13.4 Compute Quadratic Forms
Purpose: Efficient computation of quadratic forms and sums of squares.
#' Compute Quadratic Form
#'
#' Efficiently compute y'Ay for various matrix structures
#'
#' @param y Numeric vector (length n)
#' @param A Matrix (n × n), or NULL for identity
#' @param type Character: "general", "diagonal", "symmetric", or "identity"
#'
#' @return Scalar value of quadratic form
#'
#' @examples
#' y <- rnorm(100)
#' A <- crossprod(matrix(rnorm(100*100), 100, 100))
#' qf <- compute_quadratic_form(y, A, type = "symmetric")
#'
compute_quadratic_form <- function(y, A = NULL, type = "general") {
n <- length(y)
if (type == "identity" || is.null(A)) {
# y'y
return(sum(y^2))
} else if (type == "diagonal") {
# y'diag(d)y = sum(d * y^2)
d <- diag(A)
return(sum(d * y^2))
} else if (type == "symmetric") {
# Exploit symmetry: only compute upper triangle
# More efficient: sum(y * (A %*% y))
return(sum(y * (A %*% y)))
} else if (type == "general") {
# Full computation: t(y) %*% A %*% y
return(as.numeric(t(y) %*% A %*% y))
} else {
stop("type must be 'general', 'diagonal', 'symmetric', or 'identity'")
}
}
#' Decompose Sums of Squares
#'
#' Compute SST, SSM, SSE decomposition with verification
#'
#' @param y Response vector
#' @param y_hat Fitted values vector
#' @param verify Logical, verify decomposition? (default: TRUE)
#'
#' @return List with SST, SSM, SSE, R2, verification status
#'
decompose_sums_of_squares <- function(y, y_hat, verify = TRUE) {
n <- length(y)
y_bar <- mean(y)
# Compute components
SST <- sum((y - y_bar)^2)
SSM <- sum((y_hat - y_bar)^2)
SSE <- sum((y - y_hat)^2)
# R-squared
R2 <- SSM / SST
# Verify decomposition
decomp_ok <- TRUE
if (verify) {
sum_check <- SSM + SSE
decomp_ok <- isTRUE(all.equal(SST, sum_check, tolerance = 1e-10))
if (!decomp_ok) {
warning(paste("SS decomposition failed: SST =", SST, "but SSM + SSE =", sum_check))
}
}
return(list(
SST = SST,
SSM = SSM,
SSE = SSE,
R2 = R2,
decomposition_verified = decomp_ok
))
}
# Example usage
y <- rnorm(100, mean = 50, sd = 10)
y_hat <- rnorm(100, mean = 50, sd = 8)
ss_decomp <- decompose_sums_of_squares(y, y_hat)
print(ss_decomp)16.13.5 Kronecker Product Functions
Purpose: Efficient operations with Kronecker product structure (never form explicitly!).
#' Kronecker Product Matrix-Vector Multiplication
#'
#' Compute (A ⊗ B)x efficiently WITHOUT forming A ⊗ B
#'
#' @param A Matrix (m × n)
#' @param B Matrix (p × q)
#' @param x Vector (length nq)
#'
#' @return Vector (length mp), result of (A ⊗ B)x
#'
#' @details Uses the identity: (A ⊗ B)vec(X) = vec(BXA')
#'
kronecker_matvec <- function(A, B, x) {
m <- nrow(A)
n <- ncol(A)
p <- nrow(B)
q <- ncol(B)
# Check dimensions
if (length(x) != n * q) {
stop(paste("x must have length", n * q, "for this Kronecker product"))
}
# Reshape x to matrix X (q × n)
X <- matrix(x, nrow = q, ncol = n)
# Compute BXA' and vectorize
result <- B %*% X %*% t(A)
return(as.vector(result))
}
#' Solve (A ⊗ B)x = y Efficiently
#'
#' Solve Kronecker structured system WITHOUT forming A ⊗ B
#'
#' @param A Matrix (m × m), must be invertible
#' @param B Matrix (p × p), must be invertible
#' @param y Vector (length mp)
#'
#' @return Vector x such that (A ⊗ B)x = y
#'
#' @details Uses: (A ⊗ B)^(-1) = A^(-1) ⊗ B^(-1)
#'
solve_kronecker_system <- function(A, B, y) {
m <- nrow(A)
p <- nrow(B)
# Check dimensions
if (length(y) != m * p) {
stop(paste("y must have length", m * p))
}
# Check invertibility
if (abs(det(A)) < 1e-10) stop("A is singular")
if (abs(det(B)) < 1e-10) stop("B is singular")
# Compute inverses separately
A_inv <- solve(A)
B_inv <- solve(B)
# Apply (A^(-1) ⊗ B^(-1)) to y
x <- kronecker_matvec(A_inv, B_inv, y)
return(x)
}
#' Example: Multi-Trait Genetic Evaluation Structure
#'
#' Demonstrates Kronecker product in genetic evaluation context
#'
multi_trait_var_structure <- function(G, A, n_traits = 2, n_animals = 5) {
# G: genetic covariance between traits (2×2)
# A: additive relationship matrix (5×5)
# Full covariance: V = G ⊗ A (10×10)
cat("=== Multi-Trait Variance Structure ===\n\n")
cat("G (genetic covariance matrix):\n")
print(G)
cat("\nA (relationship matrix):\n")
print(A)
# Size of full system
total_dim <- n_traits * n_animals
cat("\nFull system size:", total_dim, "×", total_dim, "\n")
cat("Would require", format(total_dim^2, big.mark=","), "elements\n")
# DON'T form explicitly!
if (total_dim <= 20) {
V_explicit <- kronecker(G, A)
cat("\nV = G ⊗ A (formed explicitly for illustration):\n")
cat("Dimensions:", dim(V_explicit), "\n")
} else {
cat("\n[V not formed - too large!]\n")
}
# For solving (G ⊗ A)^(-1)y, use:
cat("\nTo solve (G ⊗ A)^(-1)y:\n")
cat("1. Compute G^(-1) (", n_traits, "×", n_traits, ")\n")
cat("2. Compute A^(-1) (", n_animals, "×", n_animals, ")\n")
cat("3. Apply (G^(-1) ⊗ A^(-1)) implicitly\n")
# Demonstrate
G_inv <- solve(G)
A_inv <- solve(A)
y_test <- rnorm(total_dim)
x_solution <- solve_kronecker_system(G_inv, A_inv, y_test)
cat("\nTest: Solved system of size", total_dim, "without forming", total_dim, "×", total_dim, "matrix!\n")
return(invisible(list(G = G, A = A, G_inv = G_inv, A_inv = A_inv)))
}
# Example: 2 traits, 5 animals
G <- matrix(c(10, 3, 3, 5), 2, 2) # Genetic covariance
A <- matrix(c(1.0, 0.5, 0.0, 0.0, 0.25,
0.5, 1.0, 0.25, 0.0, 0.125,
0.0, 0.25, 1.0, 0.5, 0.375,
0.0, 0.0, 0.5, 1.0, 0.25,
0.25, 0.125, 0.375, 0.25, 1.0), 5, 5)
result <- multi_trait_var_structure(G, A)References
Key references for matrix algebra in linear models:
- Searle, S. R. (1971). Linear Models. John Wiley & Sons.
- Searle, S. R. (1982). Matrix Algebra Useful for Statistics. John Wiley & Sons.
- Henderson, C. R. (1984). Applications of Linear Models in Animal Breeding. University of Guelph.
- Harville, D. A. (1997). Matrix Algebra From a Statistician’s Perspective. Springer.
TipWhat’s Next?
After reviewing matrix algebra concepts here, you’ll be well-prepared to:
- Understand the derivations in Week 5: Least Squares Theory
- Work with rank-deficient systems in Week 12: Non-Full Rank Models
- Explore advanced topics in future Animal models and multi-trait analysis courses