"Geographisch gewichtetes PCA" ist sehr beschreibend: In Rschreibt sich das Programm praktisch von selbst. (Es benötigt mehr Kommentarzeilen als tatsächliche Codezeilen.)
Beginnen wir mit den Gewichten, denn hier befindet sich die geografisch gewichtete PCA-Teilefirma von PCA selbst. Der Begriff "geografisch" bedeutet, dass die Gewichte von den Entfernungen zwischen einem Basispunkt und den Datenpositionen abhängen. Die Standardgewichtung - aber keineswegs nur - ist eine Gaußsche Funktion; exponentieller Zerfall mit quadratischer Entfernung. Der Benutzer muss die Abklingrate oder - intuitiver - eine charakteristische Entfernung angeben, über die eine feste Abklingmenge auftritt.
distance.weight <- function(x, xy, tau) {
# x is a vector location
# xy is an array of locations, one per row
# tau is the bandwidth
# Returns a vector of weights
apply(xy, 1, function(z) exp(-(z-x) %*% (z-x) / (2 * tau^2)))
}
PCA gilt entweder für eine Kovarianz oder eine Korrelationsmatrix (die von einer Kovarianz abgeleitet ist). Hier ist also eine Funktion, um gewichtete Kovarianzen numerisch stabil zu berechnen.
covariance <- function(y, weights) {
# y is an m by n matrix
# weights is length m
# Returns the weighted covariance matrix of y (by columns).
if (missing(weights)) return (cov(y))
w <- zapsmall(weights / sum(weights)) # Standardize the weights
y.bar <- apply(y * w, 2, sum) # Compute column means
z <- t(y) - y.bar # Remove the means
z %*% (w * t(z))
}
Die Korrelation wird auf übliche Weise unter Verwendung der Standardabweichungen für die Maßeinheiten jeder Variablen abgeleitet:
correlation <- function(y, weights) {
z <- covariance(y, weights)
sigma <- sqrt(diag(z)) # Standard deviations
z / (sigma %o% sigma)
}
Jetzt können wir die PCA machen:
gw.pca <- function(x, xy, y, tau) {
# x is a vector denoting a location
# xy is a set of locations as row vectors
# y is an array of attributes, also as rows
# tau is a bandwidth
# Returns a `princomp` object for the geographically weighted PCA
# ..of y relative to the point x.
w <- distance.weight(x, xy, tau)
princomp(covmat=correlation(y, w))
}
(Das sind bisher netto 10 Zeilen ausführbaren Codes. Nach der Beschreibung eines Rasters, über das die Analyse durchgeführt werden soll, wird nur noch eine Zeile benötigt.)
Veranschaulichen wir anhand einiger Zufallsdaten, die mit den in der Frage beschriebenen Daten vergleichbar sind: 30 Variablen an 550 Standorten.
set.seed(17)
n.data <- 550
n.vars <- 30
xy <- matrix(rnorm(n.data * 2), ncol=2)
y <- matrix(rnorm(n.data * n.vars), ncol=n.vars)
Geografisch gewichtete Berechnungen werden häufig an ausgewählten Orten durchgeführt, z. B. entlang eines Schnitts oder an Punkten eines regulären Gitters. Lassen Sie uns ein grobes Raster verwenden, um einen Überblick über die Ergebnisse zu erhalten. Später - wenn wir sicher sind, dass alles funktioniert und wir bekommen, was wir wollen - können wir das Raster verfeinern.
# Create a grid for the GWPCA, sweeping in rows
# from top to bottom.
xmin <- min(xy[,1]); xmax <- max(xy[,1]); n.cols <- 30
ymin <- min(xy[,2]); ymax <- max(xy[,2]); n.rows <- 20
dx <- seq(from=xmin, to=xmax, length.out=n.cols)
dy <- seq(from=ymin, to=ymax, length.out=n.rows)
points <- cbind(rep(dx, length(dy)),
as.vector(sapply(rev(dy), function(u) rep(u, length(dx)))))
Es ist eine Frage, welche Informationen wir von jedem PCA behalten möchten. Typischerweise gibt eine PCA für n Variablen eine sortierte Liste von n Eigenwerten und - in verschiedenen Formen - eine entsprechende Liste von n Vektoren mit jeweils der Länge n zurück . Das sind n * (n + 1) Zahlen für die Karte! Nehmen wir einige Hinweise aus der Frage und ordnen Sie die Eigenwerte zu. Diese werden aus der Ausgabe von gw.pcaüber das $sdevAttribut extrahiert , bei dem es sich um die Liste der Eigenwerte nach absteigendem Wert handelt.
# Illustrate GWPCA by obtaining all eigenvalues at each grid point.
system.time(z <- apply(points, 1, function(x) gw.pca(x, xy, y, 1)$sdev))
Dies ist auf diesem Computer in weniger als 5 Sekunden erledigt. Beachten Sie, dass beim Aufruf von eine charakteristische Entfernung (oder "Bandbreite") von 1 verwendet wurde gw.pca.
Der Rest ist eine Frage des Aufwischens. Lassen Sie uns die Ergebnisse mithilfe der rasterBibliothek zuordnen. (Stattdessen könnte man die Ergebnisse in einem Rasterformat für die Nachbearbeitung mit einem GIS ausgeben.)
library("raster")
to.raster <- function(u) raster(matrix(u, nrow=n.cols),
xmn=xmin, xmx=xmax, ymn=ymin, ymx=ymax)
maps <- apply(z, 1, to.raster)
par(mfrow=c(2,2))
tmp <- lapply(maps, function(m) {plot(m); points(xy, pch=19)})
Dies sind die ersten vier der 30 Karten, die die vier größten Eigenwerte zeigen. (Seien Sie nicht zu aufgeregt über ihre Größe, die an jedem Ort 1 übersteigt. Denken Sie daran, dass diese Daten völlig zufällig generiert wurden und daher, wenn sie überhaupt eine Korrelationsstruktur haben - was die größeren Eigenwerte in diesen Karten anzudeuten scheinen - es ist ausschließlich zufällig und spiegelt nichts "Reales" wider, was den Prozess der Datengenerierung erklärt.)
Es ist aufschlussreich, die Bandbreite zu ändern. Wenn es zu klein ist, beschwert sich die Software über Singularitäten. (Ich habe in dieser Bare-Bones-Implementierung keine Fehlerprüfung eingebaut.) Eine Reduzierung von 1 auf 1/4 (und die Verwendung der gleichen Daten wie zuvor) führt jedoch zu interessanten Ergebnissen:
Beachten Sie die Tendenz, dass die Punkte um die Grenze ungewöhnlich große Haupteigenwerte ergeben (angezeigt an den grünen Stellen der oberen linken Karte), während alle anderen Eigenwerte zur Kompensation gedrückt werden (angezeigt durch das Hellrosa in den anderen drei Karten). . Dieses Phänomen und viele andere Feinheiten der PCA und der geografischen Gewichtung müssen verstanden werden, bevor die geografisch gewichtete Version der PCA zuverlässig interpretiert werden kann. Und dann gibt es noch die anderen 30 * 30 = 900 Eigenvektoren (oder "Ladungen") zu berücksichtigen ....
