"PCA geograficamente ponderato" è molto descrittivo: in R, il programma praticamente si scrive da solo. (Ha bisogno di più righe di commento rispetto alle righe di codice effettive.)
Cominciamo con i pesi, perché è qui che l'azienda di parti PCA ponderata geograficamente dalla stessa PCA. Il termine "geografico" indica che i pesi dipendono dalle distanze tra un punto base e le posizioni dei dati. Lo standard - ma non solo - la ponderazione è una funzione gaussiana; cioè, decadimento esponenziale con distanza quadrata. L'utente deve specificare il tasso di decadimento o - in modo più intuitivo - una distanza caratteristica su cui si verifica un ammontare fisso di decadimento.
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 si applica a una covarianza o matrice di correlazione (che è derivata da una covarianza). Ecco quindi una funzione per calcolare le covarianze ponderate in modo numericamente stabile.
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 correlazione viene derivata nel solito modo, usando le deviazioni standard per le unità di misura di ciascuna variabile:
correlation <- function(y, weights) {
z <- covariance(y, weights)
sigma <- sqrt(diag(z)) # Standard deviations
z / (sigma %o% sigma)
}
Ora possiamo fare il 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))
}
(Finora sono nette 10 righe di codice eseguibile. Ne occorrerà solo un'altra, di seguito, dopo aver descritto una griglia su cui eseguire l'analisi.)
Illustriamo con alcuni dati di esempio casuali comparabili a quelli descritti nella domanda: 30 variabili in 550 posizioni.
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)
I calcoli geograficamente ponderati vengono spesso eseguiti su una serie selezionata di posizioni, ad esempio lungo un transetto o in punti di una griglia regolare. Usiamo una griglia grossolana per ottenere una prospettiva sui risultati; più tardi - una volta che siamo sicuri che tutto funzioni e stiamo ottenendo ciò che vogliamo - possiamo perfezionare la griglia.
# 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)))))
C'è una domanda su quali informazioni desideriamo conservare da ciascun PCA. Tipicamente, un PCA per n variabili restituisce un elenco ordinato di n autovalori e - in varie forme - un corrispondente elenco di n vettori, ciascuno di lunghezza n . Sono n * (n + 1) numeri da mappare! Prendendo alcuni spunti dalla domanda, mappiamo gli autovalori. Questi vengono estratti dall'output di gw.pcatramite l' $sdevattributo, che è l'elenco degli autovalori per valore decrescente.
# 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))
Questo si completa in meno di 5 secondi su questa macchina. Si noti che nella chiamata a è stata utilizzata una distanza caratteristica (o "larghezza di banda") di 1 gw.pca.
Il resto è una questione di pulizia. Mappiamo i risultati usando la rasterlibreria. (Invece, si potrebbero scrivere i risultati in un formato griglia per la post-elaborazione con un GIS.)
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)})
Queste sono le prime quattro delle 30 mappe, che mostrano i quattro autovalori più grandi. (Non eccitarti troppo per le loro dimensioni, che superano 1 in ogni posizione. Ricorda che questi dati sono stati generati in modo totalmente casuale e quindi, se hanno una struttura di correlazione - che gli autovalori di grandi dimensioni in queste mappe sembrano indicare --è dovuto esclusivamente al caso e non riflette nulla di "reale" che spiega il processo di generazione dei dati.)
È istruttivo cambiare la larghezza di banda. Se è troppo piccolo, il software si lamenterà delle singolarità. (Non ho inserito alcun errore durante il controllo di questa implementazione bare-bones.) Ridurlo da 1 a 1/4 (e utilizzando gli stessi dati di prima) offre risultati interessanti:
Nota la tendenza dei punti attorno al confine a fornire autovalori principali insolitamente grandi (mostrati nelle posizioni verdi della mappa in alto a sinistra), mentre tutti gli altri autovalori sono depressi per compensare (mostrati dal rosa chiaro nelle altre tre mappe) . Questo fenomeno, e molte altre sottigliezze della PCA e della ponderazione geografica, dovranno essere compresi prima di poter sperare in modo affidabile di interpretare la versione ponderata geograficamente della PCA. E poi ci sono gli altri 30 * 30 = 900 autovettori (o "caricamenti") da considerare ....
