Ich glaube, was Sie in Ihrer Frage ansprechen, betrifft das Abschneiden von Daten mit einer geringeren Anzahl von Hauptkomponenten (PC). Für solche Operationen halte ich die Funktion prcomp
für anschaulicher, da es einfacher ist, die bei der Rekonstruktion verwendete Matrixmultiplikation zu visualisieren.
Geben Sie zunächst einen synthetischen Datensatz an, Xt
und führen Sie die PCA durch (in der Regel zentrieren Sie Stichproben, um PCs zu beschreiben, die sich auf eine Kovarianzmatrix beziehen):
#Generate data
m=50
n=100
frac.gaps <- 0.5 # the fraction of data with NaNs
N.S.ratio <- 0.25 # the Noise to Signal ratio for adding noise to data
x <- (seq(m)*2*pi)/m
t <- (seq(n)*2*pi)/n
#True field
Xt <-
outer(sin(x), sin(t)) +
outer(sin(2.1*x), sin(2.1*t)) +
outer(sin(3.1*x), sin(3.1*t)) +
outer(tanh(x), cos(t)) +
outer(tanh(2*x), cos(2.1*t)) +
outer(tanh(4*x), cos(0.1*t)) +
outer(tanh(2.4*x), cos(1.1*t)) +
tanh(outer(x, t, FUN="+")) +
tanh(outer(x, 2*t, FUN="+"))
Xt <- t(Xt)
#PCA
res <- prcomp(Xt, center = TRUE, scale = FALSE)
names(res)
In den Ergebnissen oder sehen prcomp
Sie die PC's ( res$x
), die Eigenwerte ( res$sdev
), die Informationen zur Größe der einzelnen PCs und die Ladungen ( res$rotation
).
res$sdev
length(res$sdev)
res$rotation
dim(res$rotation)
res$x
dim(res$x)
Durch Quadrieren der Eigenwerte erhalten Sie die von jedem PC erklärte Varianz:
plot(cumsum(res$sdev^2/sum(res$sdev^2))) #cumulative explained variance
Schließlich können Sie eine abgeschnittene Version Ihrer Daten erstellen, indem Sie nur die führenden (wichtigen) PCs verwenden:
pc.use <- 3 # explains 93% of variance
trunc <- res$x[,1:pc.use] %*% t(res$rotation[,1:pc.use])
#and add the center (and re-scale) back to data
if(res$scale != FALSE){
trunc <- scale(trunc, center = FALSE , scale=1/res$scale)
}
if(res$center != FALSE){
trunc <- scale(trunc, center = -1 * res$center, scale=FALSE)
}
dim(trunc); dim(Xt)
Sie sehen, dass das Ergebnis eine etwas glattere Datenmatrix mit herausgefilterten Funktionen im kleinen Maßstab ist:
RAN <- range(cbind(Xt, trunc))
BREAKS <- seq(RAN[1], RAN[2],,100)
COLS <- rainbow(length(BREAKS)-1)
par(mfcol=c(1,2), mar=c(1,1,2,1))
image(Xt, main="Original matrix", xlab="", ylab="", xaxt="n", yaxt="n", breaks=BREAKS, col=COLS)
box()
image(trunc, main="Truncated matrix (3 PCs)", xlab="", ylab="", xaxt="n", yaxt="n", breaks=BREAKS, col=COLS)
box()
Und hier ist ein sehr grundlegender Ansatz, den Sie außerhalb der Funktion prcomp ausführen können:
#alternate approach
Xt.cen <- scale(Xt, center=TRUE, scale=FALSE)
C <- cov(Xt.cen, use="pair")
E <- svd(C)
A <- Xt.cen %*% E$u
#To remove units from principal components (A)
#function for the exponent of a matrix
"%^%" <- function(S, power)
with(eigen(S), vectors %*% (values^power * t(vectors)))
Asc <- A %*% (diag(E$d) %^% -0.5) # scaled principal components
#Relationship between eigenvalues from both approaches
plot(res$sdev^2, E$d) #PCA via a covariance matrix - the eigenvalues now hold variance, not stdev
abline(0,1) # same results
Die Entscheidung, welche PCs aufbewahrt werden sollen, ist eine separate Frage , die mich vor einiger Zeit interessiert hat . Hoffentlich hilft das.