লিন্ডসে স্মিথের টিউটোরিয়ালটি ব্যবহার করে আর-তে পিসিএ-র ধাপে রূপায়ণ implementation


13

আমি লিন্ডসে আই স্মিথের একটি দুর্দান্ত পিসিএ টিউটোরিয়াল দিয়ে আরে কাজ করছি এবং শেষ পর্যায়ে আটকে যাচ্ছি। নীচের আর স্ক্রিপ্টটি আমাদের মঞ্চে নিয়ে যায় (p.19-এ) যেখানে মূল তথ্যগুলি পুনরায় তৈরি করা হচ্ছে (এক্ষেত্রে একক) প্রধান উপাদান, যা পিসিএ 1 অক্ষ বরাবর একটি সরলরেখার প্লট তৈরি করবে (প্রদত্ত তথ্য হিসাবে কেবলমাত্র 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পছন্দসই মাত্রিকতা (পিসিএ 1 এর জন্য আইজেনভেક્ટર) হ্রাস করার প্রয়োজনীয়তাগুলি বুঝতে পেরেছি, এবং (খ) এটি পিসিএ 1 আবলিনের সাথে সামঞ্জস্য নয়:

এখানে চিত্র বর্ণনা লিখুন

কোন মতামত অনেক প্রশংসা।


s1y/xx/y

শীর্ষস্থানীয় প্রধান উপাদানগুলি থেকে মূল ডেটা পুনর্গঠনের বিষয়ে, এই নতুন থ্রেডটি দেখুন: stats.stackexchange.com/questions/229092
অ্যামিবা বলছে মনিকা পুনরায়

উত্তর:


10

আপনি খুব কাছাকাছি এসেছিলেন এবং আর ম্যাট্রিক্সের সাথে কাজ করার ক্ষেত্রে একটি সূক্ষ্ম ইস্যুতে জড়িয়ে পড়েছিলেন I আমি আপনার কাছ থেকে কাজ করেছি final_dataএবং স্বাধীনভাবে সঠিক ফলাফল পেয়েছি। তারপরে আমি আপনার কোডটি ঘনিষ্ঠভাবে দেখেছি। একটি দীর্ঘ গল্প সংক্ষিপ্ত কাটা, যেখানে আপনি লিখেছেন

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

আপনি লিখলে ঠিক আছে

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

trans_data2×12×10t(feat_vec[1,])1×2row_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×11×10final_data20=2×10row_orig_data12=2×1+1×10

(XY)T=YTXTt(t(p) %*% t(q)) = q %*% t

x/yy/x


লিখন

d_in_new_basis = as.matrix(final_data)

তারপরে আপনার ডেটাটিকে আপনার মূল ভিত্তিতে ফিরে পেতে

d_in_original_basis = d_in_new_basis %*% feat_vec

দ্বিতীয়টি ব্যবহার করে আপনার ডেটা অংশগুলি শূন্য করতে পারেন that

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_adjY=STXSXYYXYX

তারপর আপনি ছিল

trans_data = final_data
trans_data[,2] = 0

এটি ঠিক আছে: আপনি কেবলমাত্র আপনার উপাদানটির দ্বিতীয় অংশের সাথে অনুমান করা অংশগুলি শূন্য করছেন। যেখানে এটি ভুল হয়

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

Y^Ye1t(feat_vec[1,]) %*% t(trans_data)e1Y^

2×12×10Y^Yy1e1y1ie1y1e1i


ধন্যবাদ টোটোন এটি অত্যন্ত বিস্তৃত এবং চূড়ান্ত পর্যায়ে ম্যাট্রিক্স গণনা এবং ফিচারভেক্টরের ভূমিকা সম্পর্কে আমার বুঝতে অস্পষ্টতাগুলি সমাধান করে।
ভূগোলিক

দুর্দান্ত :)। আমি এই প্রশ্নের উত্তর দিয়েছি কারণ আমি এই মুহূর্তে এসভিডি / পিসিএ তত্ত্বটি অধ্যয়ন করছি এবং এটি কীভাবে উদাহরণ সহকারে কাজ করে তা আঁকড়ে ধরতে চেয়েছিলাম: আপনার প্রশ্নটি ভাল সময় ছিল। সমস্ত ম্যাট্রিক্স গণনার মধ্য দিয়ে কাজ করার পরে আমি কিছুটা অবাক হয়েছিলাম যে এটি কোনও আর সমস্যা হয়ে দাঁড়িয়েছে - তাই আমি আনন্দিত যে আপনি এর ম্যাট্রিক্সের দিকটিও প্রশংসা করেছেন।
টুটোনে

4

আমার মনে হয় আপনি সঠিক ধারণা পেয়েছেন তবে আর এর একটি বাজে বৈশিষ্ট্য নিয়ে হোঁচট খেয়েছেন Here এখানে আবার প্রাসঙ্গিক কোড পিস হিসাবে আপনি বলেছেন:

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কোভারিয়েন্স ম্যাট্রিক্সের ইগেনভেেক্টর দ্বারা নির্ধারিত স্থানাঙ্ক ব্যবস্থার সাথে মূল পয়েন্টগুলির স্থানাঙ্ক থাকে। মূল পয়েন্টগুলি পুনর্গঠন করতে একটিকে প্রতিটি রূপান্তরিত সমন্বিত, যেমন, যেমন প্রতিটি ইগেনভেક્ટરকে গুণ করতে হবে multip

(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))

আলাদা কিছু গণনা করে এবং কেবলমাত্র কাজ করে কারণ আর স্বয়ংক্রিয়ভাবে এর জন্য মাত্রা বৈশিষ্ট্যটি ড্রপ করে feat_vec[1,], সুতরাং এটি আর কোনও সারি ভেক্টর নয় তবে কলাম ভেক্টর হিসাবে বিবেচিত হবে। পরবর্তী ট্রান্সপোজ এটিকে আবার সারি ভেক্টর হিসাবে তৈরি করে এবং এ কারণেই কমপক্ষে গণনাটি ত্রুটি তৈরি করে না তবে আপনি যদি গণিতে যান তবে আপনি দেখতে পাবেন যে এটি (1) এর চেয়ে আলাদা কিছু। সাধারণভাবে dropপ্যারামিটার দ্বারা অর্জন করা যেতে পারে এমন ডাইমেনশন অ্যাট্রিবিউটটি বাদ দেওয়া দমন করার জন্য ম্যাট্রিক্স গুণে এটি একটি ভাল ধারণা feat_vec[1,,drop=FALSE]

Δy/Δx

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

অনেক ধন্যবাদ জর্জি আপনি ঠিক পিসিএ 1 opeাল সম্পর্কে। drop=Fযুক্তি সম্পর্কে খুব দরকারী টিপ ।
ভূগোলিক

4

এই অনুশীলনটি অন্বেষণের পরে আপনি আরে সহজ উপায়গুলি চেষ্টা করতে পারেন PC পিসিএ করার জন্য দুটি জনপ্রিয় ফাংশন রয়েছে: princompএবং prcompprincompফাংশন eigenvalue পচানি আপনার ব্যায়াম মধ্যে সম্পন্ন হিসাবে আছে। 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)

এখানে চিত্র বর্ণনা লিখুন এখানে চিত্র বর্ণনা লিখুন

স্পষ্টতই লক্ষণগুলি উল্টে গেছে তবে পরিবর্তনের ব্যাখ্যা সমান।


ধন্যবাদ মিঃবুকুদা। আপনার বাইপলট লিন্ডসে স্মিথের সাথে অভিন্ন দেখায় তাই আমি অনুমান করি যে তিনি 12 বছর আগে একই পদ্ধতি ব্যবহার করেছিলেন! আমি অন্যান্য কয়েকটি উচ্চ স্তরের পদ্ধতি সম্পর্কেও সচেতন , তবে আপনি যথাযথভাবে উল্লেখ করেছেন এটি অন্তর্নিহিত পিসিএ গণিতগুলি সুস্পষ্ট করার জন্য অনুশীলন।
ভূগোলিক
আমাদের সাইট ব্যবহার করে, আপনি স্বীকার করেছেন যে আপনি আমাদের কুকি নীতি এবং গোপনীয়তা নীতিটি পড়েছেন এবং বুঝতে পেরেছেন ।
Licensed under cc by-sa 3.0 with attribution required.