Schrittweise Implementierung von PCA in R mithilfe des Tutorials von Lindsay Smith

Ich arbeite in R durch ein hervorragendes PCA-Tutorial von Lindsay I Smith und stecke in der letzten Phase fest. Das unten stehende R-Skript führt uns bis zu dem Punkt (auf Seite 19), an dem die ursprünglichen Daten aus der (in diesem Fall singulären) Hauptkomponente rekonstruiert werden. Dabei sollte sich entlang der PCA1-Achse ein gerader Plot ergeben (vorausgesetzt, die Daten sind vorhanden) hat nur 2 Dimensionen, von denen die zweite absichtlich fallengelassen wird).

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)

Das ist soweit ich weiß und soweit alles in Ordnung. Ich kann jedoch nicht herausfinden, wie die Daten für das endgültige Diagramm - die auf PCA 1 zurückzuführende Varianz - erhalten werden, das Smith wie folgt darstellt:

Folgendes habe ich versucht (wobei das Hinzufügen der ursprünglichen Mittel ignoriert wird):

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)

.. und bekam eine fehlerhafte:

.. weil ich irgendwie eine Datendimension in der Matrixmultiplikation verloren habe. Ich wäre sehr dankbar für eine Idee, was hier falsch läuft.

* Bearbeiten *

Ich frage mich, ob dies die richtige Formel ist:

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

Aber ich bin ein wenig verwirrt, wenn ja, weil (a) ich verstehe, dass die rowVectorFeatureAnforderungen auf die gewünschte Dimension reduziert werden müssen (der Eigenvektor für PCA1) und (b) er nicht mit der PCA1-Zeile übereinstimmt:

Alle Ansichten sehr geschätzt.

Sie waren sehr, sehr nah dran und wurden von einem subtilen Problem bei der Arbeit mit Matrizen in R erfasst. Ich habe es von Ihnen durchgearbeitet final_dataund unabhängig die richtigen Ergebnisse erzielt. Dann habe ich mir Ihren Code genauer angesehen. Um es kurz zu machen, wo Sie geschrieben haben

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

Sie wären in Ordnung gewesen, wenn Sie geschrieben hätten

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$

Schreiben

d_in_new_basis = as.matrix(final_data)

Dann brauchen Sie, um Ihre Daten wieder auf die ursprüngliche Basis zu bringen

d_in_original_basis = d_in_new_basis %*% feat_vec

Sie können die Teile Ihrer Daten, die entlang der zweiten Komponente projiziert werden, mit auf Null setzen

d_in_new_basis_approx = d_in_new_basis
d_in_new_basis_approx[,2] = 0

und Sie können dann wie zuvor transformieren

d_in_original_basis_approx = d_in_new_basis_approx %*% feat_vec

Wenn Sie diese zusammen mit der Hauptkomponentenlinie in Grün auf demselben Diagramm zeichnen, sehen Sie, wie die Approximation funktioniert hat.

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

Lassen Sie uns zurückspulen, was Sie hatten. Diese Zeile war in Ordnung

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$

Dann hattest du

trans_data = final_data
trans_data[,2] = 0

Das ist in Ordnung: Sie setzen nur die Teile Ihrer Daten auf Null, die entlang der zweiten Komponente projiziert werden. Wo es schief geht ist

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$

Ich denke, Sie haben die richtige Idee, stolperten aber über ein böses Feature von R. Hier noch einmal das relevante Codestück, wie Sie es angegeben haben:

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_dataEnthält im Wesentlichen die Koordinaten der ursprünglichen Punkte in Bezug auf das durch die Eigenvektoren der Kovarianzmatrix definierte Koordinatensystem. Um die ursprünglichen Punkte zu rekonstruieren, muss man daher jeden Eigenvektor mit der zugehörigen transformierten Koordinate multiplizieren, z

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

das würde die ursprünglichen Koordinaten des ersten Punktes ergeben. In Ihrer Frage setzen Sie die zweite Komponente korrekt auf Null trans_data[,2] = 0. Wenn Sie dann (wie Sie bereits bearbeitet haben) berechnen

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

Sie berechnen Formel (1) für alle Punkte gleichzeitig. Dein erster Ansatz

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

berechnet etwas anderes und funktioniert nur, weil R das Dimensionsattribut für automatisch löscht feat_vec[1,], sodass es kein Zeilenvektor mehr ist, sondern als Spaltenvektor behandelt wird. Die nachfolgende Transponierung macht es wieder zu einem Zeilenvektor und das ist der Grund, warum zumindest die Berechnung keinen Fehler erzeugt, aber wenn Sie die Mathematik durchgehen, werden Sie sehen, dass es etwas anderes ist als (1). Im Allgemeinen ist es bei Matrixmultiplikationen eine gute Idee, das Löschen des Dimensionsattributs zu unterdrücken, das durch den dropParameter erreicht werden kann, z 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

Nachdem Sie diese Übung durchgearbeitet haben, können Sie die einfacheren Methoden in R ausprobieren. Es gibt zwei beliebte Funktionen für PCA: princompund prcomp. Die princompFunktion führt die Eigenwertzerlegung wie in Ihrer Übung durch. Die prcompFunktion verwendet die Singularwertzerlegung. Beide Methoden liefern fast immer die gleichen Ergebnisse: Diese Antwort erklärt die Unterschiede in R, während diese Antwort die Mathematik erklärt . (Dank an TooTone für die jetzt in diesen Beitrag integrierten Kommentare.)

Hier verwenden wir beide, um die Übung in R zu reproduzieren. Zuerst verwenden wir 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)

Zweite Verwendung 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)

Klar sind die Zeichen umgedreht, aber die Erklärung der Variation ist gleichwertig.