"भौगोलिक रूप से भारित पीसीए" बहुत वर्णनात्मक है: में R, कार्यक्रम व्यावहारिक रूप से खुद को लिखता है। (इसे कोड की वास्तविक लाइनों की तुलना में अधिक टिप्पणी लाइनों की आवश्यकता है।)
चलो वजन के साथ शुरू करते हैं, क्योंकि यह वह जगह है जहां पीसीए से भौगोलिक रूप से भारित पीसीए पार्ट्स कंपनी है। "भौगोलिक" शब्द का अर्थ है कि वजन एक आधार बिंदु और डेटा स्थानों के बीच की दूरी पर निर्भर करता है। मानक - लेकिन केवल किसी भी तरह से - भार एक गाऊसी कार्य है; अर्थात्, वर्ग दूरी के साथ घातीय क्षय। उपयोगकर्ता को क्षय दर या अधिक सहज ज्ञान युक्त निर्दिष्ट करने की आवश्यकता है - एक विशेषता दूरी जिस पर एक निश्चित मात्रा में क्षय होता है।
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)))
}
पीसीए या तो एक सहसंयोजक या सहसंबंध मैट्रिक्स (जो एक सहसंयोजक से प्राप्त होता है) पर लागू होता है। यहाँ, फिर, एक संख्यात्मक रूप से स्थिर तरीके से भारित सहसंयोजकों की गणना करने का एक कार्य है।
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)))))
एक सवाल है कि हम प्रत्येक पीसीए से किस जानकारी को बनाए रखना चाहते हैं। आमतौर पर, n वेरिएबल्स के लिए एक PCA, n eigenvalues की सॉर्ट की गई सूची और - विभिन्न रूपों में - n vectors की एक संबंधित सूची , प्रत्येक की लंबाई 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लायब्रेरी का उपयोग करके परिणामों को मैप करते हैं । (इसके बजाय, कोई व्यक्ति जीआईएस के साथ पोस्ट-प्रोसेसिंग के लिए एक ग्रिड प्रारूप में परिणाम लिख सकता है।)
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 से अधिक हो। यह याद रखें कि ये डेटा पूरी तरह से यादृच्छिक रूप से उत्पन्न हुए थे और इसलिए, यदि उनके पास कोई सहसंबंध संरचना है - जो इन मानचित्रों में लघ्वान्त्र eigenvalues इंगित करते हैं - यह पूरी तरह से मौका के कारण होता है और यह "वास्तविक" कुछ भी प्रतिबिंबित नहीं करता है जो डेटा निर्माण प्रक्रिया को समझाता है।)
यह बैंडविड्थ को बदलने का निर्देश है। यदि यह बहुत छोटा है, तो सॉफ्टवेयर विलक्षणताओं के बारे में शिकायत करेगा। (मैंने इस नंगे हड्डियों के कार्यान्वयन में किसी भी त्रुटि की जाँच में निर्माण नहीं किया है।) लेकिन इसे 1 से 1/4 तक कम करना (और पहले जैसा ही डेटा का उपयोग करना) दिलचस्प परिणाम देता है:
सीमा के चारों ओर के बिंदुओं के लिए असामान्य रूप से बड़े प्रिंसिपल eigenvalues (ऊपरी बाएं हाथ के नक्शे के हरे स्थानों में दिखाया गया है) देने की प्रवृत्ति पर ध्यान दें, जबकि अन्य सभी eigenvalues को क्षतिपूर्ति करने के लिए उदास हैं (अन्य तीन मानचित्रों में हल्के गुलाबी द्वारा दिखाए गए) । यह घटना, और पीसीए और भौगोलिक भार के कई अन्य सूक्ष्मताएं, पीसीए की भौगोलिक रूप से भारित संस्करण की व्याख्या करने के लिए मज़बूती से उम्मीद कर सकती हैं, इससे पहले समझने की आवश्यकता होगी। और फिर विचार करने के लिए अन्य 30 * 30 = 900 eigenvectors (या "लोडिंग") हैं ...।
