“地理加权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行可执行代码。在下面描述要执行分析的网格之后，下面只需要一行。）
让我们用与问题中描述的数据相当的一些随机样本数据进行说明：550个位置的30个变量。
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个变量的PCA 返回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库映射结果。（相反，可以将结果以网格格式写出，以便使用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)})
这些是30张地图中的前四张，显示了四个最大的特征值。（不要对它们的大小感到兴奋，每个地方的大小都超过1。回想一下，这些数据是完全随机生成的，因此，如果它们根本具有任何相关结构，则这些图中的特征值似乎表明了这一点-这完全是出于偶然，并不反映任何解释数据生成过程的“真实”信息。）
更改带宽很有帮助。如果太小，软件将抱怨奇异之处。（我没有在此基本实现中进行任何错误检查。）但是将其从1减少到1/4（并使用与以前相同的数据）确实会得到有趣的结果：
请注意，边界周围的点趋向于给出异常大的主特征值（显示在左上图的绿色位置），而所有其他特征值都被压低以进行补偿（在其他三幅图中显示为浅粉红色） 。在人们希望可靠地解释PCA的地理加权版本之前，需要先了解这一现象以及PCA和地理加权的许多其他细微之处。然后还有其他30 * 30 = 900个特征向量（或“载荷”）要考虑...。
