Mũi tên của các biến cơ bản trong biplot PCA trong R

Có nguy cơ làm cho câu hỏi trở nên cụ thể bằng phần mềm và với lý do có tính phổ biến và đặc trưng của nó, tôi muốn hỏi về chức năng biplot()trong R, và cụ thể hơn là về cách tính và vẽ đồ thị của mũi tên đỏ được đặt chồng lên nhau, tương ứng đến các biến cơ bản.

---

[Để hiểu ý nghĩa của một số ý kiến, các lô ban đầu được đăng có một vấn đề đáng lo ngại về sự quan tâm khan hiếm, và hiện đã bị xóa.]

Xem xét nâng cấp bài đăng của @ amoeba và @ttnphns . Cảm ơn cả hai vì sự giúp đỡ và ý tưởng của bạn.

---

Các mục sau đây dựa trên tập dữ liệu Iris trong R và cụ thể là ba biến (cột) đầu tiên : Sepal.Length, Sepal.Width, Petal.Length.

Một biplot kết hợp một biểu đồ tải (các hàm riêng không chuẩn) - trong bê tông, hai lần tải đầu tiên và một biểu đồ điểm (các điểm dữ liệu được xoay và giãn được vẽ theo các thành phần chính). Sử dụng cùng một tập dữ liệu, @amoeba mô tả 9 tổ hợp biplot PCA có thể dựa trên 3 chuẩn hóa có thể có của biểu đồ điểm số của các thành phần chính thứ nhất và thứ hai và 3 chuẩn hóa của biểu đồ tải (mũi tên) của các biến ban đầu. Để xem R xử lý các kết hợp có thể này như thế nào, thật thú vị khi xem biplot()phương thức:

---

Đầu tiên đại số tuyến tính đã sẵn sàng để sao chép và dán:

X = as.matrix(iris[,1:3])             # Three first variables of Iris dataset
CEN = scale(X, center = T, scale = T) # Centering and scaling the data
PCA = prcomp(CEN)

# EIGENVECTORS:
(evecs.ei = eigen(cor(CEN))$vectors)       # Using eigen() method
(evecs.svd = svd(CEN)$v)                   # PCA with SVD...
(evecs = prcomp(CEN)$rotation)             # Confirming with prcomp()

# EIGENVALUES:
(evals.ei = eigen(cor(CEN))$values)        # Using the eigen() method
(evals.svd = svd(CEN)$d^2/(nrow(X) - 1))   # and SVD: sing.values^2/n - 1
(evals = prcomp(CEN)$sdev^2)               # with prcomp() (needs squaring)

# SCORES:
scr.svd = svd(CEN)$u %*% diag(svd(CEN)$d)  # with SVD
scr = prcomp(CEN)$x                        # with prcomp()
scr.mm = CEN %*% prcomp(CEN)$rotation      # "Manually" [data] [eigvecs]

# LOADINGS:

loaded = evecs %*% diag(prcomp(CEN)$sdev)  # [E-vectors] [sqrt(E-values)]

---

1. Tái tạo âm mưu tải (mũi tên):

Ở đây giải thích hình học trên bài đăng này của @ttnphns giúp rất nhiều. Ký hiệu của sơ đồ trong bài đã được duy trì: là viết tắt của biến trong không gian chủ đề . là mũi tên tương ứng cuối cùng được vẽ; và tọa độ và là tải phần một biến đối với với và :h ′ a 1 a 2 V PC 1 PC $V$Sepal L.$h'$$a_1$$a_2$$V$$\small \text{PC} 1$$\small \text{PC} 2$

---

---

Thành phần của biến Sepal L.liên quan đến sau đó sẽ là:$\small\text{PC}1$

$$\begin{align} a_1 &= h\cdot\cos(\phi)\\[2ex] \end{align}$$

trong đó, nếu điểm số liên quan đến - hãy gọi chúng là - được chuẩn hóa sao choS $\small\text{PC}1$$\small\text{S}1$

$\Vert\text{S}1\Vert = \sqrt{\sum_1^n \text{scores}_1^2} = 1$ , phương trình trên tương đương với sản phẩm chấm :$V\cdot \text{S}1$

$$\begin{align} a_1 &= V\cdot \text{S}1\\[2ex] &=\Vert V\Vert\,\Vert \text{S}1\Vert\, \cos(\phi)\\[2ex] &= h\times 1\times \cdot\cos(\phi)\tag{1} \end{align}$$

Vì ,$\Vert V \Vert=\sqrt{\small{\sum x^2}}$

$$\sqrt{\small{\text{Var}(V)}}=\frac{\sqrt{\small{\sum x^2}}}{\sqrt{n-1}}=\frac{\Vert V \Vert}{\sqrt{n-1}} \implies \Vert V\Vert =h=\sqrt{\small{\text{var}(V)}} \sqrt {n-1}.$$

Tương tự như vậy,

$$\Vert\text{S}1\Vert=1=\sqrt{\small \text{var(S}1)}\sqrt {n-1}.$$

Quay trở lại phương trình. ,$(1)$

$$a_1=h\times 1\times \cdot\cos(\phi)=\sqrt{\small{\text{var}(V)}}\,\sqrt{\small{\text{var}(\text{S}1)}}\, \cos(\theta) \;(n-1)$$

$\cos(\phi)$Do đó, có thể được coi là hệ số tương quan của Pearson , , với lời cảnh báo mà tôi không hiểu về nếp nhăn của yếu tố .$r$$n-1$

Sao chép và chồng chéo trong màu xanh mũi tên màu đỏ của biplot()

par(mfrow = c(1,2)); par(mar=c(1.2,1.2,1.2,1.2))

biplot(PCA, cex = 0.6, cex.axis = .6, ann = F, tck=-0.01) # R biplot
# R biplot with overlapping (reproduced) arrows in blue completely covering red arrows:
biplot(PCA, cex = 0.6, cex.axis = .6, ann = F, tck=-0.01) 
arrows(0, 0,
       cor(X[,1], scr[,1]) * 0.8 * sqrt(nrow(X) - 1), 
       cor(X[,1], scr[,2]) * 0.8 * sqrt(nrow(X) - 1), 
       lwd = 1, angle = 30, length = 0.1, col = 4)
arrows(0, 0,
       cor(X[,2], scr[,1]) * 0.8 * sqrt(nrow(X) - 1), 
       cor(X[,2], scr[,2]) * 0.8 * sqrt(nrow(X) - 1), 
       lwd = 1, angle = 30, length = 0.1, col = 4)
arrows(0, 0,
       cor(X[,3], scr[,1]) * 0.8 * sqrt(nrow(X) - 1), 
       cor(X[,3], scr[,2]) * 0.8 * sqrt(nrow(X) - 1), 
       lwd = 1, angle = 30, length = 0.1, col = 4)

---

Điểm quan tâm:

• Các mũi tên có thể được sao chép dưới dạng tương quan của các biến ban đầu với điểm số được tạo bởi hai thành phần chính đầu tiên.
• Ngoài ra, điều này có thể đạt được như trong âm mưu đầu tiên ở hàng thứ hai, được gắn nhãn trong bài đăng của @ amoeba:$\mathbf{ V*S}$

hoặc trong mã R:

    biplot(PCA, cex = 0.6, cex.axis = .6, ann = F, tck=-0.01) # R biplot
    # R biplot with overlapping arrows in blue completely covering red arrows:
    biplot(PCA, cex = 0.6, cex.axis = .6, ann = F, tck=-0.01) 
    arrows(0, 0,
       (svd(CEN)$v %*% diag(svd(CEN)$d))[1,1] * 0.8, 
       (svd(CEN)$v %*% diag(svd(CEN)$d))[1,2] * 0.8, 
       lwd = 1, angle = 30, length = 0.1, col = 4)
    arrows(0, 0,
       (svd(CEN)$v %*% diag(svd(CEN)$d))[2,1] * 0.8, 
       (svd(CEN)$v %*% diag(svd(CEN)$d))[2,2] * 0.8, 
       lwd = 1, angle = 30, length = 0.1, col = 4)
    arrows(0, 0,
       (svd(CEN)$v %*% diag(svd(CEN)$d))[3,1] * 0.8, 
       (svd(CEN)$v %*% diag(svd(CEN)$d))[3,2] * 0.8, 
       lwd = 1, angle = 30, length = 0.1, col = 4)

hoặc thậm chí ...

    biplot(PCA, cex = 0.6, cex.axis = .6, ann = F, tck=-0.01) # R biplot
    # R biplot with overlapping (reproduced) arrows in blue completely covering red arrows:
    biplot(PCA, cex = 0.6, cex.axis = .6, ann = F, tck=-0.01) 
    arrows(0, 0,
       (loaded)[1,1] * 0.8 * sqrt(nrow(X) - 1), 
       (loaded)[1,2] * 0.8 * sqrt(nrow(X) - 1), 
       lwd = 1, angle = 30, length = 0.1, col = 4)
    arrows(0, 0,
       (loaded)[2,1] * 0.8 * sqrt(nrow(X) - 1), 
       (loaded)[2,2] * 0.8 * sqrt(nrow(X) - 1), 
       lwd = 1, angle = 30, length = 0.1, col = 4)
    arrows(0, 0,
       (loaded)[3,1] * 0.8 * sqrt(nrow(X) - 1), 
       (loaded)[3,2] * 0.8 * sqrt(nrow(X) - 1), 
       lwd = 1, angle = 30, length = 0.1, col = 4)

kết nối với giải thích hình học của tải trọng bởi @ttnphns hoặc bài đăng thông tin khác này cũng bởi @ttnphns .

• Có một yếu tố tỷ lệ : sqrt(nrow(X) - 1), vẫn còn một chút bí ẩn.

• $0.8$ phải làm với việc tạo không gian cho nhãn - xem nhận xét này tại đây :

Ngoài ra, người ta nên nói rằng các mũi tên được vẽ sao cho trung tâm của nhãn văn bản là nơi cần có! Các mũi tên sau đó được nhân với 0,80,8 trước khi vẽ, tức là tất cả các mũi tên ngắn hơn so với những gì chúng cần, có lẽ là để ngăn chặn sự chồng chéo với nhãn văn bản (xem mã cho biplot.default). Tôi thấy điều này là vô cùng khó hiểu. - amip 19/03/2015 lúc 10:06

---

2. Vẽ sơ đồ biplot()điểm số (và mũi tên đồng thời):

Các trục được chia tỷ lệ thành đơn vị tổng bình phương, tương ứng với ô đầu tiên của hàng đầu tiên trên bài đăng của @ amoeba , có thể được sao chép âm mưu ma trận của phân tách svd (nhiều hơn về sau này) - " Cột của : đây là những thành phần chính được chia tỷ lệ thành đơn vị tổng bình phương. "$\mathbf U$$\mathbf U$

Có hai thang đo khác nhau khi chơi trên các trục ngang dưới và trên cùng trong cấu trúc biplot:

Tuy nhiên, quy mô tương đối không rõ ràng ngay lập tức, đòi hỏi phải đi sâu vào các chức năng và phương thức:

biplot()vẽ đồ thị điểm như các cột của trong SVD, là các vectơ đơn vị trực giao:$\mathbf U$

> scr.svd = svd(CEN)$u %*% diag(svd(CEN)$d) 
> U = svd(CEN)$u
> apply(U, 2, function(x) sum(x^2))
[1] 1 1 1

Trong khi đó prcomp()hàm trong R trả về điểm số được chia tỷ lệ theo giá trị riêng của chúng:

> apply(scr, 2, function(x) var(x))         # pr.comp() scores scaled to evals
       PC1        PC2        PC3 
2.02142986 0.90743458 0.07113557 
> evals                                     #... here is the proof:
[1] 2.02142986 0.90743458 0.07113557

Do đó, chúng ta có thể chia tỷ lệ phương sai thành bằng cách chia cho các giá trị riêng:$1$

> scr_var_one = scr/sqrt(evals)[col(scr)]  # to scale to var = 1
> apply(scr_var_one, 2, function(x) var(x)) # proved!
[1] 1 1 1

Nhưng vì chúng tôi muốn tổng bình phương là , chúng tôi sẽ cần chia cho vì:$1$$\sqrt{n-1}$

$$\small \text{var}(\text{scr_var_one})= 1 =\frac{\sum_1^n \text{scr_var_one}}{n -1}$$

> scr_sum_sqrs_one = scr_var_one / sqrt(nrow(scr) - 1) # We / by sqrt n - 1.
> apply(scr_sum_sqrs_one, 2, function(x) sum(x^2))     #... proving it...
PC1 PC2 PC3 
  1   1   1

Lưu ý rằng việc sử dụng hệ số tỷ lệ , sau này được thay đổi thành khi xác định giải thích dường như nằm trong thực tế rằng$\sqrt{n-1}$$\sqrt{n}$lan

prcompsử dụng : "Không giống như Princeomp, phương sai được tính với ước số thông thường ".$n-1$$n - 1$

---

Sau khi tước bỏ tất cả các iftuyên bố và lông tơ khác, biplot()tiến hành như sau:

X   = as.matrix(iris[,1:3])                    # The original dataset
CEN = scale(X, center = T, scale = T)          # Centered and scaled
PCA = prcomp(CEN)                              # PCA analysis

par(mfrow = c(1,2))                            # Splitting the plot in 2.
biplot(PCA)                                    # In-built biplot() R func.

# Following getAnywhere(biplot.prcomp):

choices = 1:2                                  # Selecting first two PC's
scale = 1                                      # Default
scores= PCA$x                                  # The scores
lam = PCA$sdev[choices]                        # Sqrt e-vals (lambda) 2 PC's
n = nrow(scores)                               # no. rows scores
lam = lam * sqrt(n)                            # See below.

# at this point the following is called...
# biplot.default(t(t(scores[,choices])      /  lam), 
#                t(t(x$rotation[,choices]) *   lam))

# Following from now on getAnywhere(biplot.default):

x = t(t(scores[,choices])       / lam)         # scaled scores
# "Scores that you get out of prcomp are scaled to have variance equal to      
#  the eigenvalue. So dividing by the sq root of the eigenvalue (lam in 
#  biplot) will scale them to unit variance. But if you want unit sum of 
#  squares, instead of unit variance, you need to scale by sqrt(n)" (see comments).
# > colSums(x^2)
# PC1       PC2 
# 0.9933333 0.9933333    # It turns out that the it's scaled to sqrt(n/(n-1)), 
# ...rather than 1 (?) - 0.9933333=149/150

y = t(t(PCA$rotation[,choices]) * lam)         # scaled eigenvecs (loadings)


n = nrow(x)                                    # Same as dataset (150)
p = nrow(y)                                    # Three var -> 3 rows

# Names for the plotting:

xlabs = 1L:n
xlabs = as.character(xlabs)                    # no. from 1 to 150 
dimnames(x) = list(xlabs, dimnames(x)[[2L]])   # no's and PC1 / PC2

ylabs = dimnames(y)[[1L]]                      # Iris species
ylabs = as.character(ylabs)
dimnames(y) <- list(ylabs, dimnames(y)[[2L]])  # Species and PC1/PC2

# Function to get the range:
unsigned.range = function(x) c(-abs(min(x, na.rm = TRUE)), 
                                abs(max(x, na.rm = TRUE)))
rangx1 = unsigned.range(x[, 1L])               # Range first col x
# -0.1418269  0.1731236
rangx2 = unsigned.range(x[, 2L])               # Range second col x
# -0.2330564  0.2255037
rangy1 = unsigned.range(y[, 1L])               # Range 1st scaled evec
# -6.288626   11.986589
rangy2 = unsigned.range(y[, 2L])               # Range 2nd scaled evec
# -10.4776155   0.8761695

(xlim = ylim = rangx1 = rangx2 = range(rangx1, rangx2))
# range(rangx1, rangx2) = -0.2330564  0.2255037

# And the critical value is the maximum of the ratios of ranges of 
# scaled e-vectors / scaled scores:

(ratio = max(rangy1/rangx1, rangy2/rangx2)) 
# rangy1/rangx1   =   26.98328    53.15472
# rangy2/rangx2   =   44.957418   3.885388
# ratio           =   53.15472

par(pty = "s")                                 # Calling a square plot

# Plotting a box with x and y limits -0.2330564  0.2255037
# for the scaled scores:

plot(x, type = "n", xlim = xlim, ylim = ylim)  # No points
# Filling in the points as no's and the PC1 and PC2 labels:
text(x, xlabs) 
par(new = TRUE)                                # Avoids plotting what follows separately

# Setting now x and y limits for the arrows:

(xlim = xlim * ratio)  # We multiply the original limits x ratio
# -16.13617  15.61324
(ylim = ylim * ratio)  # ... for both the x and y axis
# -16.13617  15.61324

# The following doesn't change the plot intially...
plot(y, axes = FALSE, type = "n", 
     xlim = xlim, 
     ylim = ylim, xlab = "", ylab = "")

# ... but it does now by plotting the ticks and new limits...
# ... along the top margin (3) and the right margin (4)
axis(3); axis(4)
text(y, labels = ylabs, col = 2)  # This just prints the species

arrow.len = 0.1                   # Length of the arrows about to plot.

# The scaled e-vecs are further reduced to 80% of their value
arrows(0, 0, y[, 1L] * 0.8, y[, 2L] * 0.8, 
       length = arrow.len, col = 2)

mà, như mong đợi, tái tạo (hình bên phải bên dưới) biplot()đầu ra như được gọi trực tiếp với biplot(PCA)(âm mưu bên trái bên dưới) trong tất cả các thiếu sót thẩm mỹ chưa được xử lý của nó:

Điểm quan tâm:

• Các mũi tên được vẽ ở một tỷ lệ liên quan đến tỷ lệ tối đa giữa trình xác định tỷ lệ của mỗi một trong hai thành phần chính và điểm số tỷ lệ tương ứng của chúng (the ratio). NHƯ bình luận @amoeba:

biểu đồ phân tán và "biểu đồ mũi tên" được chia tỷ lệ sao cho tọa độ mũi tên x hoặc y lớn nhất (về giá trị tuyệt đối) của mũi tên chính xác bằng tọa độ x (y tuyệt đối) lớn nhất của các điểm dữ liệu phân tán

• Như đã dự đoán ở trên, các điểm có thể được vẽ trực tiếp dưới dạng điểm trong ma trận của SVD:$\mathbf U$

---