"PCA geograficamente ponderado" é muito descritivo: em R, o programa praticamente se escreve. (Ele precisa de mais linhas de comentário do que linhas de código reais.)
Vamos começar com os pesos, porque é aqui que a empresa de peças de PCA geograficamente ponderada da própria PCA. O termo "geográfico" significa que os pesos dependem das distâncias entre um ponto base e os locais dos dados. A ponderação padrão - mas de nenhuma maneira somente - é uma função gaussiana; isto é, decaimento exponencial com distância ao quadrado. O usuário precisa especificar a taxa de decaimento ou - mais intuitivamente - uma distância característica sobre a qual ocorre uma quantidade fixa de decaimento.
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)))
}
O PCA se aplica a uma matriz de covariância ou correlação (que é derivada de uma covariância). Aqui, então, é uma função para calcular covariâncias ponderadas de maneira numericamente estável.
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))
}
A correlação é derivada da maneira usual, usando os desvios padrão para as unidades de medida de cada variável:
correlation <- function(y, weights) {
z <- covariance(y, weights)
sigma <- sqrt(diag(z)) # Standard deviations
z / (sigma %o% sigma)
}
Agora podemos fazer o 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))
}
(Até agora, são 10 linhas líquidas de código executável. Somente mais uma será necessária, abaixo, depois de descrevermos uma grade sobre a qual executar a análise.)
Vamos ilustrar com alguns dados de amostra aleatória comparáveis aos descritos na pergunta: 30 variáveis em 550 locais.
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)
Os cálculos geograficamente ponderados são geralmente realizados em um conjunto selecionado de locais, como ao longo de uma seção transversal ou em pontos de uma grade regular. Vamos usar uma grade grossa para ter uma perspectiva dos resultados; mais tarde - quando estivermos confiantes de que tudo está funcionando e conseguimos o que queremos - podemos refinar a grade.
# 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)))))
Há uma pergunta de quais informações queremos reter de cada PCA. Normalmente, um PCA para n variáveis retorna uma lista classificada de n autovalores e - de várias formas - uma lista correspondente de n vetores, cada um com comprimento n . São n * (n + 1) números para mapear! Tomando algumas dicas da pergunta, vamos mapear os autovalores. Eles são extraídos da saída de gw.pcavia $sdevatributo, que é a lista de valores próprios por valor 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))
Isso é concluído em menos de 5 segundos nesta máquina. Observe que uma distância característica (ou "largura de banda") de 1 foi usada na chamada para gw.pca.
O resto é uma questão de limpar. Vamos mapear os resultados usando a rasterbiblioteca. (Em vez disso, pode-se escrever os resultados em um formato de grade para pós-processamento com um 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)})
Estes são os quatro primeiros dos 30 mapas, mostrando os quatro maiores valores próprios. (Não fique muito empolgado com seus tamanhos, que excedem 1 em cada local. Lembre-se de que esses dados foram gerados totalmente aleatoriamente e, portanto, se eles possuem alguma estrutura de correlação - os quais os autovalores amplos nesses mapas parecem indicar - é apenas devido ao acaso e não reflete nada "real" que explique o processo de geração de dados.)
É instrutivo alterar a largura de banda. Se for muito pequeno, o software irá reclamar de singularidades. (Não construí nenhuma verificação de erro nesta implementação básica). Mas reduzi-lo de 1 para 1/4 (e usar os mesmos dados de antes) fornece resultados interessantes:
Observe a tendência dos pontos ao redor do limite de fornecer autovalores principais invulgarmente grandes (mostrados nas localizações verdes do mapa superior esquerdo), enquanto todos os outros autovalores são pressionados para compensar (mostrados em rosa claro nos outros três mapas) . Esse fenômeno, e muitas outras sutilezas do PCA e da ponderação geográfica, precisarão ser entendidos antes que se possa esperar com segurança interpretar a versão ponderada geograficamente do PCA. E existem os outros 30 * 30 = 900 autovetores (ou "cargas") a serem considerados ....
