Lindsay Smith의 튜토리얼을 사용하여 R에서 PCA를 단계별로 구현

Lindsay I Smith 의 훌륭한 PCA 튜토리얼을 통해 R에서 일하고 있으며 마지막 단계에 갇혀 있습니다. 아래의 R 스크립트는 원래 데이터가 (이 경우 단수) Principal Component에서 재구성되는 단계 (p.19)로 이동하여 PCA1 축을 따라 직선 플롯을 생성합니다 2 차원 만 있고, 2 차원은 의도적으로 떨어집니다).

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)

이것은 내가 가진 한, 그리고 지금까지는 괜찮습니다. 그러나 Smith가 다음과 같이 플롯하는 최종 플롯 (PCA 1에 기인 한 분산)에 대한 데이터를 얻는 방법을 알 수 없습니다.

이것은 내가 시도한 것입니다 (원래의 수단을 추가하는 것을 무시합니다) :

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)

.. 그리고 잘못되었다 :

.. 행렬 곱셈에서 어떻게 든 데이터 차원을 잃어 버렸기 때문입니다. 나는 여기서 무엇이 잘못되고 있는지에 대해 매우 감사하게 생각합니다.

* 편집하다 *

이것이 올바른 수식인지 궁금합니다.

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')

그러나 (a) rowVectorFeature원하는 차원 (PCA1의 고유 벡터)으로 축소해야한다는 것을 이해 하고 (b) PCA1 abline과 일치하지 않기 때문에 약간 혼란 스럽습니다.

많은 의견을 부탁드립니다.

당신은 매우 가까이에 있었고 R의 행렬로 작업하는 데 미묘한 문제에 사로 잡혔습니다. 나는 당신에게서 일 final_data했고 독립적으로 정확한 결과를 얻었습니다. 그런 다음 코드를 자세히 살펴 보았습니다. 당신이 쓴 긴 이야기를 짧게 자르려면

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

당신이 쓴다면 당신은 괜찮 았을 것입니다

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

대신 ( trans_data두 번째 고유 벡터에 투영 된 부분을 ​​0으로 만들었 기 때문에 ). 행렬에 행렬 을 곱하려고 했지만 R은 오류를주지 않았습니다. 문제는 로 처리 된다는 것 입니다 . 시도 하면 오류가 발생 했을 것 입니다. 의도 한 내용에 따라 다음과 같이 작동했을 수도 있습니다.2 × 10 1 × $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,])

행렬에 행렬을 곱하므로 여기 에서 원래 행렬 을 사용할 수 있습니다 . 이 방법으로 수행 할 필요는 없지만 수학적으로 오른쪽 에서 값에서 값을 얻는다는 것을 보여주기 때문에 수학적으로 더 .1 × 10 20 = 2 × 10 12 = 2 × 1 + 1 × $2\times1$$1\times10$final_data$20=2\times10$row_orig_data$12=2\times1 + 1\times10$

누군가가 유용하다고 생각할 수 있으므로 원래의 대답을 아래에 남겨두고 필요한 줄거리를 얻는 방법을 보여줍니다. 또한 불필요한 전치 so를 제거하여 코드가 조금 더 단순해질 수 있음을 보여줍니다 .$(XY)^T=Y^TX^T$t(t(p) %*% t(q)) = q %*% t

편집을 다시 한 번 아래 그림에 주요 구성 요소 줄을 녹색으로 추가했습니다. 귀하의 질문에 아닌 로 기울기를 가졌습니다 .y /$x/y$$y/x$

쓰다

d_in_new_basis = as.matrix(final_data)

데이터를 원래대로 되돌리려면

d_in_original_basis = d_in_new_basis %*% feat_vec

다음을 사용하여 두 번째 구성 요소를 따라 투영 된 데이터 부분을 제로화 할 수 있습니다

d_in_new_basis_approx = d_in_new_basis
d_in_new_basis_approx[,2] = 0

그런 다음 이전과 같이 변형 할 수 있습니다

d_in_original_basis_approx = d_in_new_basis_approx %*% feat_vec

녹색으로 주요 구성 요소 라인과 함께 동일한 플롯에 이것을 플롯하면 근사가 어떻게 작동했는지 보여줍니다.

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")

가지고 있던 것으로 되 감자. 이 줄은 괜찮았다

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$

그럼 당신은

trans_data = final_data
trans_data[,2] = 0

이것은 괜찮습니다 : 두 번째 구성 요소를 따라 투영되는 데이터 부분을 제로화하고 있습니다. 잘못 된 곳은

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

$\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$

나는 당신이 옳은 생각을 가지고 있다고 생각하지만 R의 불쾌한 특징을 우연히 발견했습니다. 여기에 다시 언급 한 관련 코드 조각 :

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)

본질적으로 final_data공분산 행렬의 고유 벡터에 의해 정의 된 좌표계에 대한 원래 점의 좌표를 포함합니다. 따라서 원래 점을 재구성하려면 각 고유 벡터에 관련 변환 된 좌표를 곱해야합니다. 예 :

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

첫 번째 점의 원래 좌표를 산출합니다. 귀하의 질문에 두 번째 구성 요소를 올바르게 0으로 설정했습니다 trans_data[,2] = 0. 그런 다음 (이미 편집 한대로) 계산

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

모든 포인트에 대해 공식 (1)을 동시에 계산합니다. 첫 번째 접근법

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

R은의 차원 속성을 자동으로 삭제 feat_vec[1,]하므로 행 벡터가 아니라 열 벡터로 취급 되므로 다른 것으로 계산하고 작동합니다 . 이후의 조옮김은 행 벡터를 다시 만들어서 적어도 계산에서 오류가 발생하지 않는 이유입니다. 그러나 수학을 거치면 (1)과 다른 것이 보입니다. 일반적으로 행렬 곱셈에서 drop매개 변수에 의해 달성 될 수있는 차원 속성의 삭제를 억제하는 것이 좋습니다 feat_vec[1,,drop=FALSE].

$\Delta y / \Delta x$

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

이 연습을 살펴본 후 R에서 더 쉬운 방법을 시도 할 수 있습니다 . PCA를 수행하는 데 널리 사용되는 두 가지 기능은 다음 princomp과 같습니다 prcomp. 이 princomp함수는 운동에서 수행 한 고유 값 분해를 수행합니다. 이 prcomp함수는 특이 값 분해를 사용합니다. 두 방법 모두 거의 항상 동일한 결과를 제공합니다. 이 답변 은 R 의 차이점 을 설명하고이 답변은 수학을 설명합니다 . ( 이 게시물에 통합 된 의견 에 대해서는 TooTone 에게 감사합니다 .)

여기서 우리는 R에서 운동을 재현하기 위해 두 가지를 모두 사용합니다 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)

두 번째 사용 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)

분명히 부호가 뒤집어 지지만 변형에 대한 설명은 동일합니다.