«Географически взвешенный PCA» очень нагляден: Rпрограмма практически сама себя пишет. (Требуется больше строк комментариев, чем реальных строк кода.)
Начнем с весов, потому что именно здесь географически взвешенная компания PCA разделяет саму PCA. Термин «географический» означает, что веса зависят от расстояний между базовой точкой и местоположениями данных. Стандарт - но не только - взвешивание - это гауссовская функция; то есть экспоненциальный спад с квадратом расстояния. Пользователь должен указать скорость затухания или - более интуитивно - характерное расстояние, на котором происходит фиксированное количество затухания.
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 применяется либо к ковариационной, либо к корреляционной матрице (которая выводится из ковариации). Здесь, затем, функция для вычисления взвешенных ковариаций численно устойчивым способом.
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))
}
Корреляция получается обычным способом, используя стандартные отклонения для единиц измерения каждой переменной:
correlation <- function(y, weights) {
z <- covariance(y, weights)
sigma <- sqrt(diag(z)) # Standard deviations
z / (sigma %o% sigma)
}
Теперь мы можем сделать СПС:
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))
}
(На данный момент это всего 10 строк исполняемого кода. Ниже потребуется еще одна, после того, как мы опишем сетку, по которой будет выполняться анализ.)
Давайте проиллюстрируем некоторые случайные данные выборки, сопоставимые с описанными в вопросе: 30 переменных в 550 местах.
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)
Географически взвешенные вычисления часто выполняются в выбранном наборе мест, например, вдоль разреза или в точках регулярной сетки. Давайте использовать грубую сетку, чтобы получить представление о результатах; позже - когда мы уверены, что все работает и мы получаем то, что хотим, - мы можем улучшить сетку.
# 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)))))
Возникает вопрос, какую информацию мы хотим сохранить от каждого СПС. Как правило, PCA для n переменных возвращает отсортированный список из n собственных значений и - в различных формах - соответствующий список из n векторов, каждый из которых имеет длину n . Это n * (n + 1) номеров на карте! Если взять некоторые подсказки из этого вопроса, давайте сопоставим собственные значения. Они извлекается из выходного сигнала gw.pcaчерез $sdevатрибут, который является списком собственных значений по убыванию значения.
# 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))
Это завершается менее чем за 5 секунд на этой машине. Обратите внимание, что характерное расстояние (или «полоса пропускания»), равное 1, было использовано при вызове gw.pca.
Остальное дело зачистки. Давайте сопоставим результаты, используя rasterбиблиотеку. (Вместо этого можно записать результаты в формате сетки для последующей обработки с помощью ГИС.)
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)})
Это первые четыре из 30 карт, показывающие четыре самых больших собственных значения. (Не будьте слишком взволнованы их размерами, которые превышают 1 в каждом месте. Напомним, что эти данные были сгенерированы совершенно случайным образом и, следовательно, если они вообще имеют какую-либо структуру корреляции - что, по-видимому, указывают на большие собственные значения в этих картах - это исключительно случайно и не отражает ничего «реального», объясняющего процесс генерации данных.)
Поучительно изменить пропускную способность. Если он слишком маленький, программное обеспечение будет жаловаться на особенности. (Я не включал проверку ошибок в этой простой реализации.) Но уменьшение ее с 1 до 1/4 (и использование тех же данных, что и раньше) действительно дает интересные результаты:
Обратите внимание на тенденцию для точек вокруг границы давать необычно большие главные собственные значения (показанные в зеленых местах на верхней левой карте), в то время как все другие собственные значения подавлены, чтобы компенсировать (показанный светло-розовым на других трех картах) , Это явление и многие другие тонкости PCA и географического взвешивания необходимо будет понять, прежде чем можно будет надежно интерпретировать географически взвешенную версию PCA. И затем есть другие 30 * 30 = 900 собственных векторов (или «нагрузок»), которые необходимо учитывать ...
