การนำ PCA มาใช้อย่างเป็นขั้นเป็นตอนโดยใช้บทช่วยสอนของ Lindsay Smith

ฉันทำงานใน R ผ่านการสอน PCA ที่ยอดเยี่ยมโดย Lindsay I Smithและติดอยู่ในขั้นตอนสุดท้าย สคริปต์ R ด้านล่างพาเราขึ้นสู่สเตจ (บนหน้า 19) ซึ่งข้อมูลต้นฉบับถูกสร้างขึ้นใหม่จาก (เอกพจน์ในกรณีนี้) ส่วนประกอบหลักซึ่งควรให้พล็อตเส้นตรงตามแนวแกน PCA1 (ซึ่งเป็นข้อมูล มีเพียง 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)

นี่คือเท่าที่ฉันได้รับและตกลงทั้งหมดจนถึงขณะนี้ แต่ฉันไม่สามารถทราบได้ว่าข้อมูลจะได้รับสำหรับพล็อตสุดท้ายซึ่งเป็นความแปรปรวนของ PCA 1 ซึ่ง Smith แปลงเป็นอย่างไร:

นี่คือสิ่งที่ฉันได้ลอง (ซึ่งไม่สนใจการเพิ่มวิธีดั้งเดิม):

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

แต่ฉันสับสนเล็กน้อยถ้าเป็นเช่นนั้นเพราะ (a) ฉันเข้าใจrowVectorFeatureความต้องการที่จะลดลงตามขนาดที่ต้องการ (eigenvector สำหรับ PCA1) และ (b) ไม่ตรงกับ PCA1 abline:

มุมมองใด ๆ ชื่นชมมาก

คุณเกือบจะอยู่ที่นั่นและถูกจับได้ว่าเป็นเรื่องละเอียดอ่อนในการทำงานกับเมทริกซ์ในอาร์ฉันทำงานผ่านจากคุณ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ที่เป็นศูนย์ออกมาฉายใน eigenvector ที่สอง) อย่างที่คุณพยายามคูณเมทริกซ์ด้วยเมทริกซ์แต่ R ไม่ได้ทำให้คุณมีข้อผิดพลาด ปัญหาคือการที่จะถือว่าเป็น1พยายามที่จะได้ให้คุณข้อผิดพลาด ต่อไปนี้อาจเป็นไปตามแนวของสิ่งที่คุณตั้งใจจะทำงานได้เช่นกัน$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$

ฉันได้ทิ้งคำตอบดั้งเดิมไว้ด้านล่างเนื่องจากบางคนอาจพบว่ามันมีประโยชน์และมันแสดงให้เห็นถึงแผนการที่ต้องการ นอกจากนี้ยังแสดงให้เห็นว่ารหัสสามารถเป็นบิตง่ายโดยการกำจัด transposes บางส่วนที่ไม่จำเป็น:ดังนั้น$(XY)^T=Y^TX^T$t(t(p) %*% t(q)) = q %*% t

การแก้ไขของคุณอีกครั้งฉันได้เพิ่มบรรทัดองค์ประกอบหลักเป็นสีเขียวลงในแผนของฉันด้านล่าง ในคำถามของคุณที่คุณได้มีความลาดชันเป็นไม่ X$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ซึ่งเท่ากับโดยที่คือเมทริกซ์ของ eigenvectors และคือเมทริกซ์ข้อมูลของคุณกับข้อมูลของคุณในแถวและคือข้อมูลในพื้นฐานใหม่ สิ่งนี้พูดได้ว่าแถวแรกของคือผลรวมของ (แถวของถ่วงน้ำหนักโดย eigenvector แรก) และแถวที่สองของคือผลรวมของ (แถวของถ่วงน้ำหนักโดย eigenvector ที่สอง)$Y=S^TX$$S$$X$$Y$$Y$$X$$Y$$X$

จากนั้นคุณมี

trans_data = final_data
trans_data[,2] = 0

ไม่เป็นไร: คุณเพิ่งจะ zeroing out ส่วนของข้อมูลของคุณที่ฉายตามส่วนประกอบที่สอง มันผิดพลาดที่ไหน

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

การเขียนสำหรับเมทริกซ์ของ dataในรูปแบบใหม่โดยมีค่าศูนย์ในแถวที่สองและเขียนสำหรับ eigenvector ตัวแรกสิ้นสุดธุรกิจของรหัสนี้ลงมาที่Y Ye1อี1$\hat Y$$Y$$\mathbf{e}_1$t(feat_vec[1,]) %*% t(trans_data)$\mathbf{e}_1 \hat Y$

2 × 10 Y Y Y 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$จุดที่อยู่ในพื้นฐานใหม่ซึ่งเป็นสิ่งที่คุณต้องการ

ฉันคิดว่าคุณมีความคิดที่ถูกต้อง แต่สะดุดกับคุณลักษณะที่น่ารังเกียจของ R ที่นี่อีกครั้งรหัสชิ้นที่เกี่ยวข้องตามที่คุณได้ระบุไว้:

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 ของเมทริกซ์ความแปรปรวนร่วม ในการสร้างจุดเดิมขึ้นมาใหม่เราต้องคูณค่าไอเกนวีคเตอร์แต่ละตัวด้วยพิกัดแปลงร่างที่เกี่ยวข้องเช่น

(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) โดยทั่วไปมันเป็นความคิดที่ดีในการคูณเมทริกซ์จะลดลงปราบปรามของแอตทริบิวต์มิติซึ่งสามารถทำได้โดยพารามิเตอร์เช่นdropfeat_vec[1,,drop=FALSE]

$\Delta y / \Delta x$

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

หลังจากการสำรวจการออกกำลังกายนี้คุณสามารถลองวิธีที่ง่ายในอาร์มีสองฟังก์ชั่นที่เป็นที่นิยมสำหรับการทำ PCA คือและprincomp ฟังก์ชั่นที่ไม่สลายตัว eigenvalue เป็นทำในการออกกำลังกายของคุณ ฟังก์ชั่นใช้การสลายตัวมูลค่าเอกพจน์ ทั้งสองวิธีจะให้ผลลัพธ์ที่เหมือนกันเกือบทั้งหมดของเวลา: คำตอบนี้จะอธิบายถึงความแตกต่างในการวิจัยในขณะที่คำตอบนี้อธิบายคณิตศาสตร์ (ขอบคุณTooToneสำหรับความคิดเห็นที่รวมอยู่ในโพสต์นี้)prcompprincompprcomp

ที่นี่เราใช้ทั้งสองอย่างเพื่อทำแบบฝึกหัดในอาร์ก่อนอื่นให้ใช้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)

เห็นได้ชัดว่าสัญญาณพลิก แต่คำอธิบายของการเปลี่ยนแปลงนั้นเทียบเท่า