Lindsay Smith के ट्यूटोरियल का उपयोग करते हुए R में PCA के चरणबद्ध तरीके से कार्यान्वयन

Question

मैं लिंडसे I स्मिथ द्वारा एक उत्कृष्ट पीसीए ट्यूटोरियल के माध्यम से आर में काम कर रहा हूं और अंतिम चरण में फंस रहा हूं । नीचे दी गई आर स्क्रिप्ट हमें स्टेज पर ले जाती है (पी .१ ९ पर) जहां मूल डेटा (इस मामले में एकवचन) से प्रिंसिपल कंपोनेंट का पुनर्निर्माण किया जा रहा है, जिसे पीसीए १ अक्ष के साथ एक सीधी रेखा प्लॉट मिलनी चाहिए (यह देखते हुए कि डेटा केवल 2 आयाम हैं, जिनमें से दूसरा जानबूझकर गिराया जा रहा है)।

d = data.frame(x=c(2.5,0.5,2.2,1.9,3.1,2.3,2.0,1.0,1.5,1.1),
               y=c(2.4,0.7,2.9,2.2,3.0,2.7,1.6,1.1,1.6,0.9))

# mean-adjusted values 
d$x_adj = d$x - mean(d$x)
d$y_adj = d$y - mean(d$y)

# calculate covariance matrix and eigenvectors/values
(cm = cov(d[,1:2]))

#### outputs #############
#          x         y
# x 0.6165556 0.6154444
# y 0.6154444 0.7165556
##########################

(e = eigen(cm))

##### outputs ##############
# $values
# [1] 1.2840277 0.0490834
#
# $vectors
#          [,1]       [,2]
# [1,] 0.6778734 -0.7351787
# [2,] 0.7351787  0.6778734
###########################


# principal component vector slopes
s1 = e$vectors[1,1] / e$vectors[2,1] # PC1
s2 = e$vectors[1,2] / e$vectors[2,2] # PC2

plot(d$x_adj, d$y_adj, asp=T, pch=16, xlab='x', ylab='y')
abline(a=0, b=s1, col='red')
abline(a=0, b=s2)

# PCA data = rowFeatureVector (transposed eigenvectors) * RowDataAdjust (mean adjusted, also transposed)
feat_vec = t(e$vectors)
row_data_adj = t(d[,3:4])
final_data = data.frame(t(feat_vec %*% row_data_adj)) # ?matmult for details
names(final_data) = c('x','y')

#### outputs ###############
# final_data
#              x           y
# 1   0.82797019 -0.17511531
# 2  -1.77758033  0.14285723
# 3   0.99219749  0.38437499
# 4   0.27421042  0.13041721
# 5   1.67580142 -0.20949846
# 6   0.91294910  0.17528244
# 7  -0.09910944 -0.34982470
# 8  -1.14457216  0.04641726
# 9  -0.43804614  0.01776463
# 10 -1.22382056 -0.16267529
############################

# final_data[[1]] = -final_data[[1]] # for some reason the x-axis data is negative the tutorial's result

plot(final_data, asp=T, xlab='PCA 1', ylab='PCA 2', pch=16)

जहाँ तक मुझे मिला है, और अब तक सब ठीक है। लेकिन मैं यह पता नहीं लगा सकता कि डेटा अंतिम प्लॉट के लिए कैसे प्राप्त किया जाता है - पीसीए 1 के लिए भिन्नता - जो स्मिथ के रूप में है:

यही मैंने कोशिश की है (जो मूल साधनों को जोड़ने की उपेक्षा करता है):

trans_data = final_data
trans_data[,2] = 0
row_orig_data = t(t(feat_vec[1,]) %*% t(trans_data))
plot(row_orig_data, asp=T, pch=16)

.. और एक भयावह मिला:

.. क्योंकि मैंने मैट्रिक्स गुणन में किसी तरह डेटा आयाम खो दिया है। मैं एक विचार के लिए बहुत आभारी रहूंगा कि यहां क्या गलत हो रहा है।

---

* संपादित करें *

मुझे आश्चर्य है कि अगर यह सही सूत्र है:

row_orig_data = t(t(feat_vec) %*% t(trans_data))
plot(row_orig_data, asp=T, pch=16, cex=.5)
abline(a=0, b=s1, col='red')

लेकिन मैं थोड़ा उलझन में हूँ अगर ऐसा है तो (क्योंकि) मैं rowVectorFeatureवांछित गतिशीलता (PCA1 के लिए eigenvector) को कम करने की ज़रूरतों को समझता हूं , और (b) यह PCA1 एबलाइन के साथ लाइन नहीं करता है:

किसी भी विचार बहुत सराहना की।

Comments

बस एक छोटा नोट (पहले से ही नीचे दिए गए उत्तरों में उल्लेख किया गया है, लेकिन संभावित रूप से आपके प्रश्न को देखने वाले किसी व्यक्ति के लिए भ्रमित करना): आपको s1ढलान एक गलती के साथ गणना की गई थी ( होना चाहिए , नहीं होना चाहिए ), यही कारण है कि लाल रेखा नहीं है पहले आंकड़े पर डेटा और पिछले एक पर पुनर्निर्माण के साथ पूरी तरह से संरेखित। $y/x$$x/y$

— अमीबा का कहना है कि मोनिका

प्रमुख प्रमुख घटकों से मूल डेटा को फिर से संगठित करने के बारे में, इस नए सूत्र को देखें : ysts.stackexchange.com/questions/22x92 ।

— अमीबा का कहना है कि

Answer 1

आप बहुत करीब थे और आर में मैट्रिसेस के साथ काम करने में एक सूक्ष्म मुद्दे से पकड़े गए। मैंने आपके माध्यम से काम किया final_dataऔर स्वतंत्र रूप से सही परिणाम प्राप्त किए। तब मुझे आपके कोड पर एक करीब से नज़र पड़ी। एक लंबी कहानी को छोटा करने के लिए, जहाँ आपने लिखा था

row_orig_data = t(t(feat_vec[1,]) %*% t(trans_data))

अगर आपने लिखा होता तो आप ठीक होते

row_orig_data = t(t(feat_vec) %*% t(trans_data))

इसके बजाय (क्योंकि आपने उस भाग को शून्य कर दिया trans_dataथा जिसे दूसरे ईजनवेक्टर पर रखा गया था)। के रूप में यह आप गुणा करने के लिए कोशिश कर रहे थे था एक एक से मैट्रिक्स मैट्रिक्स लेकिन आर यदि आपको कोई त्रुटि नहीं दिया। समस्या यह है कि रूप में माना जाता है । कोशिश करने से आपको एक त्रुटि मिली होगी । निम्नलिखित, संभवतः आपके इरादे की रेखाओं के साथ और भी अधिक काम किया होगा$2\times1$$2\times10$t(feat_vec[1,])$1\times2$row_orig_data = t(as.matrix(feat_vec[1,],ncol=1,nrow=2) %*% t(trans_data))non-conformable arguments

row_orig_data = t(as.matrix(feat_vec[1,],ncol=1,nrow=2) %*% t(trans_data)[1,])

चूंकि यह मैट्रिक्स को मैट्रिक्स से है (ध्यान दें कि आप यहां मूल मैट्रिक्स का उपयोग कर सकते थे)। यह इस तरह से यह करने के लिए आवश्यक नहीं है, लेकिन यह के अच्छे गणितीय क्योंकि यह पता चलता है कि आप हो रही है में मान से दाहिने हाथ की ओर मूल्यों।$2\times1$$1\times10$final_data$20=2\times10$row_orig_data$12=2\times1 + 1\times10$

मैंने अपना मूल उत्तर नीचे छोड़ दिया है, क्योंकि कोई इसे उपयोगी पा सकता है, और यह आवश्यक भूखंडों को प्रदर्शित करता है। यह भी दिखाता है कि कुछ अनावश्यक बदलावों से छुटकारा पाकर कोड थोड़ा सरल हो सकता है: तो ।$(XY)^T=Y^TX^T$t(t(p) %*% t(q)) = q %*% t

अपना संपादन पुनः करें, मैंने नीचे दिए गए मेरे प्लॉट में हरे रंग में प्रमुख घटक लाइन जोड़ी है। आपके प्रश्न में आपको ढलान नहीं रूप में मिला था ।$x/y$$y/x$

---

लिखना

d_in_new_basis = as.matrix(final_data)

फिर अपने डेटा को उसके मूल आधार में वापस लाने के लिए जिसकी आपको आवश्यकता है

d_in_original_basis = d_in_new_basis %*% feat_vec

आप अपने डेटा के उन हिस्सों को शून्य कर सकते हैं जिनका उपयोग करके दूसरे घटक के साथ प्रोजेक्ट किया जाता है

d_in_new_basis_approx = d_in_new_basis
d_in_new_basis_approx[,2] = 0

और आप पहले की तरह बदल सकते हैं

d_in_original_basis_approx = d_in_new_basis_approx %*% feat_vec

इन्हें एक ही भूखंड पर प्लॉट करना, हरे रंग में प्रमुख घटक लाइन के साथ मिलकर आपको दिखाता है कि सन्निकटन ने कैसे काम किया।

plot(x=d_in_original_basis[,1]+mean(d$x),
     y=d_in_original_basis[,2]+mean(d$y),
     pch=16, xlab="x", ylab="y", xlim=c(0,3.5),ylim=c(0,3.5),
     main="black=original data\nred=original data restored using only a single eigenvector")
points(x=d_in_original_basis_approx[,1]+mean(d$x),
       y=d_in_original_basis_approx[,2]+mean(d$y),
       pch=16,col="red")
points(x=c(mean(d$x)-e$vectors[1,1]*10,mean(d$x)+e$vectors[1,1]*10), c(y=mean(d$y)-e$vectors[2,1]*10,mean(d$y)+e$vectors[2,1]*10), type="l",col="green")

जो आपके पास था, उसे वापस करते हैं। यह लाइन ठीक थी

final_data = data.frame(t(feat_vec %*% row_data_adj))

यहाँ महत्वपूर्ण बिट वह है feat_vec %*% row_data_adjजो समतुल्य है जहाँ आइजन्वेक्टर का मैट्रिक्स है और आपके डेटा मैट्रिक्स के साथ पंक्तियों में आपका डेटा है, और नए आधार में डेटा है। यह क्या कह रहा है कि की पहली पंक्ति का योग है ( पंजे पहले आइगेनवेक्टर द्वारा)। और की दूसरी पंक्ति का योग है ( भार को दूसरे आइगेनवेक्टर द्वारा)।$Y=S^TX$$S$$X$$Y$$Y$$X$$Y$$X$

तब आपके पास था

trans_data = final_data
trans_data[,2] = 0

यह ठीक है: आप अपने डेटा के उन हिस्सों को शून्य कर रहे हैं जो दूसरे घटक के साथ अनुमानित हैं। यह गलत कहां है

row_orig_data = t(t(feat_vec[1,]) %*% t(trans_data))

लेखन डेटा की मैट्रिक्स के लिए नया आधार में, दूसरी पंक्ति में शून्य से, और लेखन पहले आइजन्वेक्टर के लिए, इस कोड के व्यापार अंत करने के लिए नीचे आता है । वाईई1ए1$\hat Y$$Y$$\mathbf{e}_1$t(feat_vec[1,]) %*% t(trans_data)$\mathbf{e}_1 \hat Y$

जैसा कि ऊपर समझाया (यह वह जगह है जहाँ मैं सूक्ष्म आर समस्या का एहसास हुआ और मेरा उत्तर के पहले भाग में लिखा था), गणितीय आप एक गुणा करने के लिए कोशिश कर रहे हैं एक से वेक्टर मैट्रिक्स। यह गणितीय रूप से काम नहीं करता है। क्या करना चाहिए की पहली पंक्ति में ले = की पहली पंक्ति में इस फोन: । फिर एक साथ और गुणा करें । परिणाम का th कॉलम , eigenvector जो नए आधार में केवल th बिंदु के केवल 1 समन्वय के द्वारा भारित होता है, जो कि आप चाहते हैं।2 × 10 वाई वाई वाई 1 ई 1 y 1 मैं ई 1 y 1 ई 1$2\times1$$2\times10$$\hat Y$$Y$$\mathbf{y}_1$$\mathbf{e}_1$$\mathbf{y}_1$$i$$\mathbf{e}_1\mathbf{y}_1$$\mathbf{e}_1$$i$

Comments

बहुत बहुत धन्यवाद यह बहुत व्यापक है, और अंतिम चरण में मैट्रिक्स गणना और फीचरवेक्टर की भूमिका की मेरी समझ में अस्पष्टता का समाधान करता है।

— जियोथैरी

महान :)। मैंने इस सवाल का जवाब दिया क्योंकि मैं इस समय SVD / PCA के सिद्धांत का अध्ययन कर रहा हूं और एक उदाहरण के साथ काम करना चाहता हूं। सभी मैट्रिक्स गणनाओं के माध्यम से काम करने के बाद मैं थोड़ा आश्चर्यचकित था कि यह एक आर समस्या बन गई है - इसलिए मुझे खुशी है कि आपने इसके मैट्रिक्स पहलू की भी सराहना की।

— टीओटी

Answer 2

मुझे लगता है कि आपके पास सही विचार है, लेकिन आर की एक गंदा विशेषता पर ठोकर खाई है। यहां जैसा कि आपने कहा है संबंधित कोड टुकड़ा फिर से है:

trans_data = final_data
trans_data[,2] = 0
row_orig_data = t(t(feat_vec[1,]) %*% t(trans_data))
plot(row_orig_data, asp=T, pch=16)

मूलतः final_dataसहप्रसरण मैट्रिक्स के eigenvectors द्वारा परिभाषित समन्वय प्रणाली के संबंध में मूल अंक के निर्देशांक शामिल हैं। मूल बिंदुओं को फिर से संगठित करने के लिए प्रत्येक eigenvector को संबंधित रूपांतरित समन्वय के साथ गुणा करना होगा, जैसे

(1) final_data[1,1]*t(feat_vec[1,] + final_data[1,2]*t(feat_vec[2,])

जो पहले बिंदु के मूल निर्देशांक प्राप्त करेगा। अपने प्रश्न में आपने दूसरा घटक सही ढंग से शून्य पर सेट किया है trans_data[,2] = 0। यदि आप तब (जैसा कि आपने पहले ही संपादित किया है) गणना करें

(2) row_orig_data = t(t(feat_vec) %*% t(trans_data))

आप एक साथ सभी बिंदुओं के लिए सूत्र (1) की गणना करते हैं। आपका पहला दृष्टिकोण

row_orig_data = t(t(feat_vec[1,]) %*% t(trans_data))

कुछ अलग गणना करता है और केवल इसलिए काम करता है क्योंकि R स्वचालित रूप से आयाम विशेषता को छोड़ देता है feat_vec[1,], इसलिए यह अब एक पंक्ति वेक्टर नहीं है, लेकिन स्तंभ वेक्टर के रूप में माना जाता है। बाद का स्थानान्तरण इसे फिर से एक पंक्ति वेक्टर बनाता है और यही कारण है कि कम से कम गणना में त्रुटि उत्पन्न नहीं होती है, लेकिन यदि आप गणित से गुजरते हैं तो आप देखेंगे कि यह (1) की तुलना में कुछ अलग है। सामान्य तौर पर यह मैट्रिक्स गुणन में एक अच्छा विचार है जो आयाम विशेषता को छोड़ने के लिए है drop, जिसे पैरामीटर द्वारा प्राप्त किया जा सकता है , जैसे feat_vec[1,,drop=FALSE]।

आपका संपादित समाधान सही लगता है, लेकिन आपने पीसीए 1 को गलत तरीके से ढलान की गणना की है। ढलान द्वारा दिया गया है , इसलिए$\Delta y / \Delta x$

s1 = e$vectors[2,1] / e$vectors[1,1] # PC1
s2 = e$vectors[2,2] / e$vectors[1,2] # PC2

Comments

बहुत बहुत धन्यवाद जॉर्ज। आप PCA1 ढलान के बारे में सही हैं। बहुत उपयोगी टिप भी drop=Fतर्क के बारे में ।

— जियोथैरी

Answer 3

इस अभ्यास की खोज के बाद आप R में आसान तरीके आजमा सकते हैं । PCA करने के दो लोकप्रिय कार्य हैं: princompऔर prcomp। यह princompकार्य आपके अभ्यास में किए गए स्वदेशी अपघटन को करता है। prcompसमारोह विलक्षण मूल्य अपघटन उपयोग करता है। दोनों विधियां लगभग हर समय एक ही परिणाम देगी: यह उत्तर आर के अंतरों की व्याख्या करता है , जबकि यह उत्तर गणित की व्याख्या करता है । ( अब इस पोस्ट में एकीकृत टिप्पणियों के लिए बहुत धन्यवाद ।)

यहाँ हम आर का उपयोग करने के लिए दोनों का उपयोग करते हैं। पहले प्रयोग करते हुए princomp:

d = data.frame(x=c(2.5,0.5,2.2,1.9,3.1,2.3,2.0,1.0,1.5,1.1), 
               y=c(2.4,0.7,2.9,2.2,3.0,2.7,1.6,1.1,1.6,0.9))

# compute PCs
p = princomp(d,center=TRUE,retx=TRUE)

# use loadings and scores to reproduce with only first PC
loadings = t(p$loadings[,1]) 
scores = p$scores[,1] 

reproduce = scores %*% loadings  + colMeans(d)

# plots
plot(reproduce,pch=3,ylim=c(-1,4),xlim=c(-1,4))
abline(h=0,v=0,lty=3)
mtext("Original data restored using only a single eigenvector",side=3,cex=0.7)

biplot(p)

दूसरा प्रयोग prcomp:

d = data.frame(x=c(2.5,0.5,2.2,1.9,3.1,2.3,2.0,1.0,1.5,1.1), 
               y=c(2.4,0.7,2.9,2.2,3.0,2.7,1.6,1.1,1.6,0.9))

# compute PCs
p = prcomp(d,center=TRUE,retx=TRUE)

# use loadings and scores to reproduce with only first PC
loadings = t(p$rotation[,1])
scores = p$x[,1]

reproduce = scores %*% loadings  + colMeans(d)

# plots
plot(reproduce,pch=3,ylim=c(-1,4),xlim=c(-1,4))
abline(h=0,v=0,lty=3)
mtext("Original data restored using only a single eigenvector",side=3,cex=0.7)

biplot(p)

स्पष्ट रूप से संकेत छोड़े गए हैं लेकिन भिन्नता की व्याख्या समतुल्य है।

Comments

धन्यवाद mrbcuda आपका बिप्लॉट लिंडसे स्मिथ के समान दिखता है, इसलिए मुझे लगता है कि उसने 12 साल पहले उसी विधि का इस्तेमाल किया था! मैं कुछ अन्य उच्च स्तरीय विधियों से भी अवगत हूँ , लेकिन जैसा कि आप ठीक से इंगित करते हैं कि यह अंतर्निहित पीसीए गणित को स्पष्ट करने के लिए एक अभ्यास है।

— जियोथैरी