"Географічно зважений 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)
}
Тепер ми можемо зробити 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))
}
(Це поки чисте 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 власних векторів (або "навантажень"), які слід врахувати ....
