Từng bước thực hiện PCA trong R bằng hướng dẫn của Lindsay Smith

Tôi đang làm việc trong R thông qua một hướng dẫn PCA tuyệt vời của Lindsay I Smith và đang bị mắc kẹt trong giai đoạn cuối. Kịch bản R bên dưới đưa chúng ta đến giai đoạn (trên trang 19) trong đó dữ liệu gốc đang được xây dựng lại từ Thành phần chính (số ít trong trường hợp này), sẽ tạo ra một biểu đồ đường thẳng dọc theo trục PCA1 (cho rằng dữ liệu chỉ có 2 chiều, thứ hai trong số đó đang bị cố ý bỏ).

d = data.frame(x=c(2.5,0.5,2.2,1.9,3.1,2.3,2.0,1.0,1.5,1.1),
               y=c(2.4,0.7,2.9,2.2,3.0,2.7,1.6,1.1,1.6,0.9))

# mean-adjusted values 
d$x_adj = d$x - mean(d$x)
d$y_adj = d$y - mean(d$y)

# calculate covariance matrix and eigenvectors/values
(cm = cov(d[,1:2]))

#### outputs #############
#          x         y
# x 0.6165556 0.6154444
# y 0.6154444 0.7165556
##########################

(e = eigen(cm))

##### outputs ##############
# $values
# [1] 1.2840277 0.0490834
#
# $vectors
#          [,1]       [,2]
# [1,] 0.6778734 -0.7351787
# [2,] 0.7351787  0.6778734
###########################


# principal component vector slopes
s1 = e$vectors[1,1] / e$vectors[2,1] # PC1
s2 = e$vectors[1,2] / e$vectors[2,2] # PC2

plot(d$x_adj, d$y_adj, asp=T, pch=16, xlab='x', ylab='y')
abline(a=0, b=s1, col='red')
abline(a=0, b=s2)

# PCA data = rowFeatureVector (transposed eigenvectors) * RowDataAdjust (mean adjusted, also transposed)
feat_vec = t(e$vectors)
row_data_adj = t(d[,3:4])
final_data = data.frame(t(feat_vec %*% row_data_adj)) # ?matmult for details
names(final_data) = c('x','y')

#### outputs ###############
# final_data
#              x           y
# 1   0.82797019 -0.17511531
# 2  -1.77758033  0.14285723
# 3   0.99219749  0.38437499
# 4   0.27421042  0.13041721
# 5   1.67580142 -0.20949846
# 6   0.91294910  0.17528244
# 7  -0.09910944 -0.34982470
# 8  -1.14457216  0.04641726
# 9  -0.43804614  0.01776463
# 10 -1.22382056 -0.16267529
############################

# final_data[[1]] = -final_data[[1]] # for some reason the x-axis data is negative the tutorial's result

plot(final_data, asp=T, xlab='PCA 1', ylab='PCA 2', pch=16)

Điều này là như tôi đã có, và tất cả đều ổn cho đến nay. Nhưng tôi không thể tìm ra cách thu thập dữ liệu cho âm mưu cuối cùng - phương sai được quy cho PCA 1 - mà Smith vẽ như sau:

Đây là những gì tôi đã thử (bỏ qua việc thêm các phương tiện ban đầu):

trans_data = final_data
trans_data[,2] = 0
row_orig_data = t(t(feat_vec[1,]) %*% t(trans_data))
plot(row_orig_data, asp=T, pch=16)

.. và có một lỗi thời:

.. bởi vì tôi đã mất một thứ nguyên dữ liệu bằng cách nào đó trong phép nhân ma trận. Tôi rất biết ơn về một ý tưởng những gì đang xảy ra ở đây.

* Biên tập *

Tôi tự hỏi nếu đây là công thức đúng:

row_orig_data = t(t(feat_vec) %*% t(trans_data))
plot(row_orig_data, asp=T, pch=16, cex=.5)
abline(a=0, b=s1, col='red')

Nhưng tôi hơi bối rối nếu như vậy bởi vì (a) Tôi hiểu rằng rowVectorFeaturecần phải giảm xuống thứ nguyên mong muốn (trình xác định cho PCA1) và (b) nó không phù hợp với abline PCA1:

Bất kỳ quan điểm đánh giá cao nhiều.

Bạn đã ở rất gần đó và bị bắt gặp bởi một vấn đề tinh tế khi làm việc với ma trận ở R. Tôi đã làm việc từ bạn final_datavà có kết quả chính xác một cách độc lập. Sau đó, tôi đã xem xét kỹ hơn mã của bạn. Để cắt ngắn một câu chuyện dài, nơi bạn đã viết

row_orig_data = t(t(feat_vec[1,]) %*% t(trans_data))

bạn sẽ ổn thôi nếu bạn đã viết

row_orig_data = t(t(feat_vec) %*% t(trans_data))

trans_data$2\times1$$2\times10$t(feat_vec[1,])$1\times2$row_orig_data = t(as.matrix(feat_vec[1,],ncol=1,nrow=2) %*% t(trans_data))non-conformable arguments

row_orig_data = t(as.matrix(feat_vec[1,],ncol=1,nrow=2) %*% t(trans_data)[1,])

$2\times1$$1\times10$final_data$20=2\times10$row_orig_data$12=2\times1 + 1\times10$

$(XY)^T=Y^TX^T$t(t(p) %*% t(q)) = q %*% t

$x/y$$y/x$

Viết

d_in_new_basis = as.matrix(final_data)

sau đó để lấy lại dữ liệu của bạn trong cơ sở ban đầu, bạn cần

d_in_original_basis = d_in_new_basis %*% feat_vec

Bạn có thể loại bỏ các phần dữ liệu của bạn được chiếu dọc theo thành phần thứ hai bằng cách sử dụng

d_in_new_basis_approx = d_in_new_basis
d_in_new_basis_approx[,2] = 0

và sau đó bạn có thể biến đổi như trước

d_in_original_basis_approx = d_in_new_basis_approx %*% feat_vec

Vẽ các biểu đồ này trên cùng một ô, cùng với dòng thành phần chính có màu xanh lục, cho bạn thấy cách tính gần đúng hoạt động.

plot(x=d_in_original_basis[,1]+mean(d$x),
     y=d_in_original_basis[,2]+mean(d$y),
     pch=16, xlab="x", ylab="y", xlim=c(0,3.5),ylim=c(0,3.5),
     main="black=original data\nred=original data restored using only a single eigenvector")
points(x=d_in_original_basis_approx[,1]+mean(d$x),
       y=d_in_original_basis_approx[,2]+mean(d$y),
       pch=16,col="red")
points(x=c(mean(d$x)-e$vectors[1,1]*10,mean(d$x)+e$vectors[1,1]*10), c(y=mean(d$y)-e$vectors[2,1]*10,mean(d$y)+e$vectors[2,1]*10), type="l",col="green")

Hãy tua lại những gì bạn đã có. Dòng này là ok

final_data = data.frame(t(feat_vec %*% row_data_adj))

feat_vec %*% row_data_adj$Y=S^TX$$S$$X$$Y$$Y$$X$$Y$$X$

Sau đó, bạn đã có

trans_data = final_data
trans_data[,2] = 0

Điều này là ổn: bạn chỉ cần loại bỏ các phần dữ liệu của bạn được chiếu dọc theo thành phần thứ hai. Nó sai ở đâu

row_orig_data = t(t(feat_vec[1,]) %*% t(trans_data))

Viết $\hat Y$$Y$$\mathbf{e}_1$t(feat_vec[1,]) %*% t(trans_data)$\mathbf{e}_1 \hat Y$

$2\times1$$2\times10$$\hat Y$$Y$$\mathbf{y}_1$$\mathbf{e}_1$$\mathbf{y}_1$$i$$\mathbf{e}_1\mathbf{y}_1$$\mathbf{e}_1$$i$

Tôi nghĩ rằng bạn có ý tưởng đúng nhưng vấp phải một tính năng khó chịu của R. Đây lại là đoạn mã có liên quan như bạn đã nêu:

trans_data = final_data
trans_data[,2] = 0
row_orig_data = t(t(feat_vec[1,]) %*% t(trans_data))
plot(row_orig_data, asp=T, pch=16)

Về cơ bản final_datachứa tọa độ của các điểm ban đầu đối với hệ tọa độ được xác định bởi các hàm riêng của ma trận hiệp phương sai. Do đó, để xây dựng lại các điểm ban đầu, người ta phải nhân từng hàm riêng với tọa độ biến đổi liên quan, vd

(1) final_data[1,1]*t(feat_vec[1,] + final_data[1,2]*t(feat_vec[2,])

mà sẽ mang lại tọa độ ban đầu của điểm đầu tiên. Trong câu hỏi của bạn, bạn đặt thành phần thứ hai chính xác bằng không , trans_data[,2] = 0. Nếu bạn sau đó (như bạn đã chỉnh sửa) tính toán

(2) row_orig_data = t(t(feat_vec) %*% t(trans_data))

bạn tính công thức (1) cho tất cả các điểm cùng một lúc. Cách tiếp cận đầu tiên của bạn

row_orig_data = t(t(feat_vec[1,]) %*% t(trans_data))

tính toán một cái gì đó khác nhau và chỉ hoạt động vì R tự động loại bỏ thuộc tính thứ nguyên feat_vec[1,], vì vậy nó không còn là một vectơ hàng nữa mà được coi là một vectơ cột. Sự hoán vị tiếp theo làm cho nó trở thành một vectơ hàng và đó là lý do tại sao ít nhất phép tính không tạo ra lỗi, nhưng nếu bạn trải qua toán học, bạn sẽ thấy rằng nó là một cái gì đó khác với (1). Nói chung, đó là một ý tưởng tốt trong phép nhân ma trận để loại bỏ thuộc tính thứ nguyên có thể đạt được bằng droptham số, ví dụ feat_vec[1,,drop=FALSE].

Giải pháp chỉnh sửa của bạn có vẻ đúng, nhưng bạn đã tính độ dốc nếu PCA1 sai. Độ dốc được cho bởi $\Delta y / \Delta x$

s1 = e$vectors[2,1] / e$vectors[1,1] # PC1
s2 = e$vectors[2,2] / e$vectors[1,2] # PC2

Sau khi khám phá bài tập này, bạn có thể thử các cách dễ dàng hơn trong R. Có hai chức năng phổ biến để thực hiện PCA: princompvà prcomp. Các princompchức năng thực hiện quá trình phân hủy eigenvalue như thực hiện trong tập thể dục của bạn. Các prcompchức năng sử dụng phân hủy giá trị duy nhất. Cả hai phương pháp sẽ cho cùng một kết quả gần như mọi lúc: câu trả lời này giải thích sự khác biệt trong R, trong khi câu trả lời này giải thích toán học . (Cảm ơn TooTone vì những bình luận hiện được tích hợp vào bài đăng này.)

Ở đây chúng tôi sử dụng cả hai để tái tạo bài tập trong R. Đầu tiên sử dụng princomp:

d = data.frame(x=c(2.5,0.5,2.2,1.9,3.1,2.3,2.0,1.0,1.5,1.1), 
               y=c(2.4,0.7,2.9,2.2,3.0,2.7,1.6,1.1,1.6,0.9))

# compute PCs
p = princomp(d,center=TRUE,retx=TRUE)

# use loadings and scores to reproduce with only first PC
loadings = t(p$loadings[,1]) 
scores = p$scores[,1] 

reproduce = scores %*% loadings  + colMeans(d)

# plots
plot(reproduce,pch=3,ylim=c(-1,4),xlim=c(-1,4))
abline(h=0,v=0,lty=3)
mtext("Original data restored using only a single eigenvector",side=3,cex=0.7)

biplot(p)

Sử dụng thứ hai prcomp:

d = data.frame(x=c(2.5,0.5,2.2,1.9,3.1,2.3,2.0,1.0,1.5,1.1), 
               y=c(2.4,0.7,2.9,2.2,3.0,2.7,1.6,1.1,1.6,0.9))

# compute PCs
p = prcomp(d,center=TRUE,retx=TRUE)

# use loadings and scores to reproduce with only first PC
loadings = t(p$rotation[,1])
scores = p$x[,1]

reproduce = scores %*% loadings  + colMeans(d)

# plots
plot(reproduce,pch=3,ylim=c(-1,4),xlim=c(-1,4))
abline(h=0,v=0,lty=3)
mtext("Original data restored using only a single eigenvector",side=3,cex=0.7)

biplot(p)

Rõ ràng các dấu hiệu được lật nhưng giải thích về sự thay đổi là tương đương.