"PCA tertimbang secara geografis" sangat deskriptif: dalam R, program ini praktis menulis sendiri. (Perlu lebih banyak baris komentar daripada baris kode yang sebenarnya.)
Mari kita mulai dengan bobot, karena ini adalah di mana perusahaan suku cadang PCA secara geografis tertimbang dari PCA itu sendiri. Istilah "geografis" berarti bobot tergantung pada jarak antara titik dasar dan lokasi data. Standar - tetapi tidak berarti hanya - pembobotan adalah fungsi Gaussian; yaitu, peluruhan eksponensial dengan jarak kuadrat. Pengguna perlu menentukan tingkat peluruhan atau - lebih intuitif - jarak karakteristik di mana jumlah peluruhan tetap terjadi.
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 berlaku untuk matriks kovarians atau korelasi (yang berasal dari kovarians). Di sini, kemudian, adalah fungsi untuk menghitung kovarian tertimbang dengan cara yang stabil secara numerik.
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))
}
Korelasi diturunkan dengan cara biasa, dengan menggunakan standar deviasi untuk unit pengukuran setiap variabel:
correlation <- function(y, weights) {
z <- covariance(y, weights)
sigma <- sqrt(diag(z)) # Standard deviations
z / (sigma %o% sigma)
}
Sekarang kita bisa melakukan 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))
}
(Sejauh ini, 10 baris net dari kode yang dapat dieksekusi. Hanya satu lagi yang akan diperlukan, di bawah ini, setelah kami menggambarkan kisi yang akan digunakan untuk melakukan analisis.)
Mari kita ilustrasikan dengan beberapa data sampel acak yang sebanding dengan yang dijelaskan dalam pertanyaan: 30 variabel di 550 lokasi.
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)
Perhitungan berbobot geografis sering dilakukan pada set lokasi yang dipilih, seperti sepanjang transek atau pada titik-titik grid biasa. Mari kita gunakan kisi kasar untuk mendapatkan perspektif tentang hasilnya; nanti - setelah kami yakin semuanya bekerja dan kami mendapatkan apa yang kami inginkan - kami dapat memperbaiki grid.
# 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)))))
Ada pertanyaan tentang informasi apa yang ingin kami simpan dari setiap PCA. Biasanya, PCA untuk n variabel return daftar diurutkan n nilai eigen dan - dalam berbagai bentuk - daftar yang sesuai dari n vektor, masing-masing dengan panjang n . Itu n * (n +1) angka untuk dipetakan! Dengan mengambil beberapa isyarat dari pertanyaan, mari kita petakan nilai eigen. Ini diekstraksi dari output gw.pcamelalui $sdevatribut, yang merupakan daftar nilai eigen dengan nilai menurun.
# 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))
Ini selesai dalam waktu kurang dari 5 detik pada mesin ini. Perhatikan bahwa jarak karakteristik (atau "bandwidth") 1 digunakan dalam panggilan ke gw.pca.
Sisanya adalah masalah pembersihan. Mari kita petakan hasilnya menggunakan rasterperpustakaan. (Sebagai gantinya, orang mungkin menuliskan hasilnya dalam format kisi untuk pasca-pemrosesan dengan 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)})
Ini adalah empat dari 30 peta pertama, yang menunjukkan empat nilai eigen terbesar. (Jangan terlalu senang dengan ukurannya, yang melebihi 1 di setiap lokasi. Ingat bahwa data ini dihasilkan secara acak dan oleh karena itu, jika mereka memiliki struktur korelasi sama sekali - yang nilai eigen besar dalam peta ini tampaknya mengindikasikan - itu semata-mata karena kebetulan dan tidak mencerminkan sesuatu yang "nyata" yang menjelaskan proses pembuatan data.)
Ini instruktif untuk mengubah bandwidth. Jika terlalu kecil, perangkat lunak akan mengeluh tentang singularitas. (Saya tidak membuat kesalahan saat memeriksa implementasi kosong ini.) Tetapi menguranginya dari 1 menjadi 1/4 (dan menggunakan data yang sama seperti sebelumnya) memang memberikan hasil yang menarik:
Perhatikan kecenderungan titik-titik di sekitar batas untuk memberikan nilai eigen utama yang luar biasa besar (ditunjukkan di lokasi hijau peta kiri atas), sementara semua nilai eigen lainnya ditekan untuk mengkompensasi (ditunjukkan oleh warna merah muda terang di tiga peta lainnya) . Fenomena ini, dan banyak seluk-beluk lainnya dari PCA dan pembobotan geografis, perlu dipahami sebelum orang dapat berharap untuk menafsirkan versi PCA yang ditimbang secara geografis. Dan kemudian ada 30 * 30 = 900 vektor eigen lainnya (atau "memuat") untuk dipertimbangkan ....
