"PCA ponderado geográficamente" es muy descriptivo: en R, el programa prácticamente se escribe solo. (Necesita más líneas de comentarios que líneas de código reales).
Comencemos con los pesos, porque aquí es donde la empresa de piezas PCA ponderada geográficamente de la propia PCA. El término "geográfico" significa que los pesos dependen de las distancias entre un punto base y las ubicaciones de datos. La ponderación estándar, pero de ninguna manera solamente, es una función gaussiana; es decir, disminución exponencial con distancia al cuadrado. El usuario necesita especificar la tasa de descomposición o, más intuitivamente, una distancia característica sobre la cual ocurre una cantidad fija de descomposición.
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 se aplica a una matriz de covarianza o correlación (que se deriva de una covarianza). Aquí, entonces, es una función para calcular covarianzas ponderadas de una manera numéricamente estable.
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))
}
La correlación se deriva de la forma habitual, utilizando las desviaciones estándar para las unidades de medida de cada variable:
correlation <- function(y, weights) {
z <- covariance(y, weights)
sigma <- sqrt(diag(z)) # Standard deviations
z / (sigma %o% sigma)
}
Ahora podemos hacer el PCA:
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))
}
(Esa es una red de 10 líneas de código ejecutable hasta ahora. Solo se necesitará una más, a continuación, después de que describamos una cuadrícula sobre la cual realizar el análisis).
Vamos a ilustrar con algunos datos de muestra aleatorios comparables a los descritos en la pregunta: 30 variables en 550 ubicaciones.
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)
Los cálculos ponderados geográficamente a menudo se realizan en un conjunto seleccionado de ubicaciones, como a lo largo de un transecto o en puntos de una cuadrícula regular. Usemos una grilla gruesa para obtener una perspectiva de los resultados; más tarde, una vez que estamos seguros de que todo está funcionando y estamos obteniendo lo que queremos, podemos refinar la red.
# 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)))))
Hay una pregunta sobre qué información deseamos retener de cada PCA. Típicamente, un PCA para n variables devuelve una lista ordenada de n valores propios y, en varias formas, una lista correspondiente de n vectores, cada uno de longitud n . ¡Eso es n * (n + 1) números para mapear! Tomando algunas pistas de la pregunta, mapeemos los valores propios. Estos se extraen de la salida de a gw.pcatravés del $sdevatributo, que es la lista de valores propios por valor descendente.
# 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))
Esto se completa en menos de 5 segundos en esta máquina. Observe que se utilizó una distancia característica (o "ancho de banda") de 1 en la llamada a gw.pca.
El resto es una cuestión de limpieza. Vamos a mapear los resultados usando la rasterbiblioteca. (En cambio, uno podría escribir los resultados en un formato de cuadrícula para el procesamiento posterior con un SIG).
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)})
Estos son los primeros cuatro de los 30 mapas, que muestran los cuatro valores propios más grandes. (No se entusiasme demasiado con sus tamaños, que exceden 1 en cada ubicación. Recuerde que estos datos se generaron totalmente al azar y, por lo tanto, si tienen alguna estructura de correlación, lo que parecen indicar los valores propios más grandes en estos mapas) - se debe únicamente al azar y no refleja nada "real" que explique el proceso de generación de datos).
Es instructivo cambiar el ancho de banda. Si es demasiado pequeño, el software se quejará de las singularidades. (No incluí ninguna comprobación de errores en esta implementación básica). Pero reducirlo de 1 a 1/4 (y usar los mismos datos que antes) da resultados interesantes:
Tenga en cuenta la tendencia de los puntos alrededor del límite a dar valores propios principales inusualmente grandes (que se muestran en las ubicaciones verdes del mapa superior izquierdo), mientras que todos los otros valores propios se deprimen para compensar (como se muestra en rosa claro en los otros tres mapas) . Este fenómeno, y muchas otras sutilezas de PCA y ponderación geográfica, deberán entenderse antes de que uno pueda esperar interpretar de manera confiable la versión ponderada geográficamente de PCA. Y luego están los otros 30 * 30 = 900 vectores propios (o "cargas") a considerar ....
