"PCA có trọng số địa lý" rất mô tả: trong đó R, chương trình thực tế tự viết. (Nó cần nhiều dòng nhận xét hơn các dòng mã thực tế.)
Hãy bắt đầu với các trọng số, bởi vì đây là nơi mà công ty phụ tùng PCA có trọng lượng địa lý từ chính PCA. Thuật ngữ "địa lý" có nghĩa là các trọng số phụ thuộc vào khoảng cách giữa điểm gốc và vị trí dữ liệu. Tiêu chuẩn - nhưng không có nghĩa là duy nhất - trọng số là một hàm Gaussian; đó là, phân rã theo cấp số nhân với khoảng cách bình phương. Người dùng cần chỉ định tốc độ phân rã hoặc - trực quan hơn - một khoảng cách đặc trưng mà trên đó xảy ra một lượng sâu răng cố định.
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 áp dụng cho ma trận hiệp phương sai hoặc ma trận tương quan (có nguồn gốc từ hiệp phương sai). Ở đây, sau đó, là một hàm để tính hiệp phương sai có trọng số theo cách ổn định về số.
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))
}
Mối tương quan được rút ra theo cách thông thường, bằng cách sử dụng độ lệch chuẩn cho các đơn vị đo lường của từng biến:
correlation <- function(y, weights) {
z <- covariance(y, weights)
sigma <- sqrt(diag(z)) # Standard deviations
z / (sigma %o% sigma)
}
Bây giờ chúng ta có thể làm 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))
}
(Đó là 10 dòng mã thực thi cho đến nay. Chỉ cần thêm một dòng nữa, bên dưới, sau khi chúng tôi mô tả một lưới để thực hiện phân tích.)
Chúng ta hãy minh họa với một số dữ liệu mẫu ngẫu nhiên có thể so sánh với dữ liệu được mô tả trong câu hỏi: 30 biến tại 550 vị trí.
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)
Tính toán theo trọng số địa lý thường được thực hiện trên một tập hợp các vị trí đã chọn, chẳng hạn như dọc theo một mặt cắt hoặc tại các điểm của lưới thông thường. Chúng ta hãy sử dụng một lưới thô để có được một số quan điểm về kết quả; sau này - một khi chúng tôi tự tin mọi thứ đang hoạt động và chúng tôi đang có được những gì chúng tôi muốn - chúng tôi có thể tinh chỉnh lưới điện.
# 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)))))
Có một câu hỏi về thông tin nào chúng tôi muốn giữ lại từ mỗi PCA. Thông thường, PCA cho n biến trả về một danh sách được sắp xếp gồm n giá trị riêng và - ở các dạng khác nhau - một danh sách tương ứng gồm n vectơ, mỗi vectơ có độ dài n . Đó là số n * (n + 1) trên bản đồ! Lấy một số tín hiệu từ câu hỏi, hãy lập bản đồ các giá trị riêng. Chúng được trích xuất từ đầu ra của gw.pcathông qua $sdevthuộc tính, là danh sách các giá trị riêng theo giá trị giảm dần.
# 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))
Điều này hoàn thành trong chưa đầy 5 giây trên máy này. Lưu ý rằng khoảng cách đặc trưng (hoặc "băng thông") của 1 đã được sử dụng trong lệnh gọi đến gw.pca.
Phần còn lại là vấn đề lau dọn. Hãy lập bản đồ kết quả bằng rasterthư viện. (Thay vào đó, người ta có thể viết kết quả ra dưới dạng lưới để xử lý hậu kỳ với một hệ thống 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)})
Đây là bốn bản đồ đầu tiên trong số 30 bản đồ, hiển thị bốn giá trị riêng lớn nhất. (Đừng quá phấn khích bởi kích thước của chúng, vượt quá 1 tại mọi vị trí. Hãy nhớ lại rằng những dữ liệu này được tạo hoàn toàn ngẫu nhiên và do đó, nếu chúng có bất kỳ cấu trúc tương quan nào - mà các giá trị riêng trong các bản đồ này dường như chỉ ra --it chỉ là do tình cờ và không phản ánh bất cứ điều gì "thực" giải thích quá trình tạo dữ liệu.)
Đó là hướng dẫn để thay đổi băng thông. Nếu nó quá nhỏ, phần mềm sẽ phàn nàn về điểm kỳ dị. (Tôi không xây dựng bất kỳ kiểm tra lỗi nào trong quá trình triển khai cơ bản này.) Nhưng việc giảm từ 1 xuống 1/4 (và sử dụng cùng một dữ liệu như trước đây) sẽ cho kết quả thú vị:
Lưu ý xu hướng các điểm xung quanh ranh giới đưa ra các giá trị riêng lớn bất thường (hiển thị ở các vị trí màu xanh lục của bản đồ phía trên bên trái), trong khi tất cả các giá trị riêng khác đều được ấn xuống để bù (hiển thị bằng màu hồng nhạt trong ba bản đồ khác) . Hiện tượng này, và nhiều sự tinh tế khác của PCA và trọng số địa lý, sẽ cần được hiểu trước khi người ta có thể hy vọng đáng tin cậy để giải thích phiên bản PCA có trọng số về mặt địa lý. Và sau đó, có 30 * 30 = 900 eigenvector khác (hoặc "tải") để xem xét ....
