「地理的に重み付けされたPCA」は非常に記述的です：でR、プログラムは実際に書き込みます。（実際のコード行よりも多くのコメント行が必要です。）
これは、PCA自体から地理的に重み付けされたPCAパーツ会社であるため、重みから始めましょう。「地理的」という用語は、重みが基点とデータ位置の間の距離に依存することを意味します。標準-決して決してではない-重み付けはガウス関数です。つまり、距離が2乗する指数関数的減衰です。ユーザーは、減衰率、または（より直感的に）一定の減衰量が発生する特徴的な距離を指定する必要があります。
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行です。分析を実行するグリッドについて説明した後、あと1つだけが必要になります。）
質問で説明されているものに匹敵するいくつかのランダムなサンプルデータで説明しましょう：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個のマップのうち最初の4個で、4つの最大固有値を示しています。（すべての場所で1を超えるサイズにあまり興奮しないでください。これらのデータは完全にランダムに生成されているため、これらのマップに相関構造がある場合は、これらのマップの大きな固有値が示すことを思い出してください-それは単に偶然によるものであり、データ生成プロセスを説明する「実際の」ものを反映するものではありません。）
帯域幅を変更することは有益です。小さすぎる場合、ソフトウェアは特異点について不平を言います。（このベアボーン実装ではエラーチェックを組み込みませんでした。）しかし、それを1から1/4に減らす（そして以前と同じデータを使用する）と興味深い結果が得られます。
境界付近のポイントが異常に大きな主固有値（左上のマップの緑の位置に表示）を提供する傾向に注意してください。他のすべての固有値は補正するために押し下げられます（他の3つのマップに薄いピンクで表示） 。PCAの地理的に重み付けされたバージョンを確実に解釈するには、この現象、およびPCAと地理的重み付けのその他の多くの微妙な点を理解する必要があります。そして、考慮すべき他の30 * 30 = 900個の固有ベクトル（または「負荷」）があります...。
