"Coğrafi ağırlıklı PCA" çok açıklayıcı: içinde R, program pratikte kendini yazar. (Gerçek kod satırlarından daha fazla yorum satırına ihtiyaç duyar.)
Haydi ağırlıklar ile başlayalım, çünkü bu, PCA'nın kendisinden coğrafi ağırlıklı PCA parçaları şirketinin bulunduğu yerdir. "Coğrafi" terimi, ağırlıklar, bir taban nokta ile veri yerleri arasındaki mesafelere bağlı olduğunu ifade eder. Standart - ancak sadece hiçbir şekilde - ağırlıklandırma bir Gauss fonksiyonudur; yani, kare mesafe ile üssel çürüme. Kullanıcının, çürüme oranını veya - daha sezgisel olarak - üzerinde sabit bir çürüme miktarının oluştuğu karakteristik bir mesafeyi belirtmesi gerekir.
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, bir kovaryans veya korelasyon matrisine uygulanır (bir kovaryanstan türetilir). Bu durumda, burada ağırlıklı kovaryansları sayısal olarak kararlı bir şekilde hesaplamak için bir işlevdir.
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))
}
Korelasyon, her bir değişkenin ölçüm birimleri için standart sapmalar kullanılarak, olağan şekilde elde edilir:
correlation <- function(y, weights) {
z <- covariance(y, weights)
sigma <- sqrt(diag(z)) # Standard deviations
z / (sigma %o% sigma)
}
Şimdi PCA'yı yapabiliriz:
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))
}
(Şimdilik net bir 10 çalıştırılabilir kod satırı. Bu, analizin gerçekleştirileceği bir ızgarayı açıkladıktan sonra aşağıda yalnızca bir tane daha gerekli olacak.)
Şimdi, soruda tarif edilenlerle karşılaştırılabilir bazı rastgele örnek verilerle gösterelim: 550 lokasyonda 30 değişken.
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)
Coğrafi olarak ağırlıklandırılmış hesaplamalar, çoğu zaman, bir kesit boyunca veya normal bir kılavuzun noktaları gibi seçilen bir konum kümesi üzerinde gerçekleştirilir. Sonuçlara bir bakış açısı getirmek için kaba bir ızgara kullanalım; sonra - bir kere her şeyin işe yarayacağından ve istediğimizi elde ettiğimizden emin olduktan sonra - ızgarayı iyileştirebiliriz.
# 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)))))
Her PCA'dan hangi bilgileri saklamak istediğimizle ilgili bir soru var. Tipik olarak, n değişkenleri için bir PCA , n özdeğerlerinin sıralı bir listesini ve - çeşitli formlarda - her birinin uzunluğu n olan karşılık gelen n vektörlerinin bir listesini verir . Bu, haritadaki n * (n + 1) sayıdır! Bu sorudan bazı ipuçları alarak, özdeğerleri haritalayalım. Bu çıktısından çıkarılır ile değeri azalan ile eigen listesi özniteliği.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))
Bu, makinede 5 saniyeden daha kısa sürede tamamlanır. Çağrıda 1 karakteristik mesafesinin (veya "bant genişliği") kullanıldığına dikkat edin gw.pca.
Gerisi silme meselesidir. Sonuçları rasterkütüphaneyi kullanarak eşleştirelim . (Bunun yerine, bir GIS ile işlem sonrası için sonuçları bir ızgara biçiminde yazabilirsiniz.)
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)})
Bunlar en büyük dört özdeğerleri gösteren 30 haritanın ilk dördü. (Her yerde 1'i aşan boyutları ile çok fazla heyecanlanma. Bu verilerin tamamen rastgele üretildiğini ve bu nedenle, eğer herhangi bir korelasyon yapıları varsa - bu haritalardaki largish özdeğerlerinin belirttiğini - bu sadece şansa bağlıdır ve veri oluşturma sürecini açıklayan "gerçek" herhangi bir şeyi yansıtmaz.)
Bant genişliğini değiştirmek öğreticidir. Çok küçükse, yazılım tekillikler hakkında şikayet edecektir. (Bu çıplak kemik uygulamasında herhangi bir hata kontrolü yapmadım.) Ancak 1'den 1/4'e (ve daha önce olduğu gibi aynı verileri kullanmak) ilginç sonuçlar veriyor:
Sınır etrafındaki noktaların alışılmadık derecede büyük ana özdeğerler verme (sol üst haritanın yeşil konumlarında gösterilir), diğer tüm özdeğerler telafi etmek için basıldığında (diğer üç haritada açık pembe ile gösterilir) eğilimini not edin. . Bu fenomenin ve birçok PCA incelikinin ve coğrafi ağırlıklandırmanın, PCA'nın coğrafi ağırlıklı versiyonunu güvenilir bir şekilde yorumlamayı umabilmesi için anlaşılması gerekecektir. Ve sonra dikkate alınması gereken diğer 30 * 30 = 900 özvektörler (veya "yükler") vardır ....
