R'de PCA biplotunda temel değişkenlerin okları

Soruyu yazılıma özgü hale getirme riski altındadır ve her yerde ve kendine özgü ifadelerinin mazereti ile, biplot()R'deki fonksiyon hakkında ve daha spesifik olarak, varsayılan, üst üste binmiş kırmızı okların hesaplanması ve çizilmesi hakkında sormak istiyorum. temeldeki değişkenlere.

---

[Yorumlardan bazılarını anlamak için, başlangıçta gönderilen arazilerin az ilgi duyduğu bir sclaing sorunu vardı ve şimdi siliniyorlar.]

Upvoting düşünün @ amip en ve @ttnphns' sonrası . Yardımlarınız ve fikirleriniz için teşekkür ederiz.

---

Aşağıdaki dayanır R İris veri kümesi , ve spesifik olarak, ilk üç değişken (sütun): Sepal.Length, Sepal.Width, Petal.Length.

Bir biplot , bir yükleme grafiğini (standartlaştırılmamış özvektörler) - betonda, ilk iki yüklemeyi ve bir skor grafiğini (ana bileşenlere göre çizilen döndürülmüş ve dilate veri noktaları) birleştirir. Aynı veri kümesini kullanarak, @amoeba , birinci ve ikinci temel bileşenlerin skor grafiğinin 3 olası normalizasyonuna ve başlangıç ​​değişkenlerinin yükleme grafiğinin (oklar) 3 normalizasyonuna dayanan 9 olası PCA biplot kombinasyonunu açıklar . R'nin bu olası kombinasyonları nasıl ele aldığını görmek için biplot()yönteme bakmak ilginçtir :

---

İlk önce kopyalamaya ve yapıştırmaya hazır lineer cebir:

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. Yükleme grafiğinin (oklar) çoğaltılması:

$V$Sepal L.$h'$$a_1$$a_2$$V$$\small \text{PC} 1$$\small \text{PC} 2$

---

---

Sepal L.$\small\text{PC}1$

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

$\small\text{PC}1$$\small\text{S}1$

$\Vert\text{S}1\Vert = \sqrt{\sum_1^n \text{scores}_1^2} = 1$$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}$$

Yana ,$\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}.$$

Aynı şekilde,

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

Eq. ,$(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)$ bu nedenle, faktörünün kırışıklığını anlamadığım uyarıyla , Pearson'un korelasyon katsayısı , olarak düşünülebilir .$r$$n-1$

Kırmızı okları çoğaltma ve üst üste bindirme 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)

---

İlgi noktaları:

• Oklar, orijinal değişkenlerin ilk iki temel bileşen tarafından üretilen puanlarla korelasyonu olarak çoğaltılabilir.
• Alternatif olarak bu, @ amoeba'nın gönderisinde etiketli ikinci satırdaki ilk grafikte olduğu gibi gerçekleştirilebilir :$\mathbf{ V*S}$

veya R kodunda:

    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)

hatta henüz ...

    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)

bağlantı @ttnphns ile yükleri geometrik açıklama veya @ttnphns ile de bu diğer bilgi yazı .

• Bir ölçeklendirme faktörü var: sqrt(nrow(X) - 1)bu biraz gizemini koruyor.

• $0.8$ , etiket için alan oluşturmakla ilgilidir - bu yoruma buradan bakın :

Ayrıca, okların metin etiketinin merkezi olması gereken yerde olacak şekilde çizildiğini söylemek gerekir! Daha sonra, çizilmeden önce oklar 0.80.8 ile çarpılır, yani tüm oklar, muhtemelen metin etiketi ile çakışmayı önlemek için olması gerekenden daha kısadır (biplot.default koduna bakın). Bunun son derece kafa karıştırıcı olduğunu düşünüyorum. - 19 Mart'ta amip 10:06

---

2. biplot()Skor grafiğinin çizilmesi (ve oklar aynı anda):

Eksen tekabül eden, kareler birim toplamına ölçeklenir birinci bölgeden ilk satırın @ amip yayınının matris çizilmesi çoğaltılabilir, "- SVD ayrışma (bu konuda daha sonra) Sütunlarını : bunlar, birim kareler toplamına ölçeklendirilmiş temel bileşenler. "$\mathbf U$$\mathbf U$

Biplot yapısında alt ve üst yatay eksenlerde iki farklı ölçek vardır:

Bununla birlikte, göreceli ölçek hemen belli değildir, işlevlerin ve yöntemlerin incelenmesini gerektirir:

biplot() dikey birim vektörler olan sütunları olarak grafikleri :$\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

Oysa prcomp()R işlevi, özdeğerler ölçeklenmiş puanları verir:

> 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

Bu nedenle özdeğerlere bölerek varyansı ölçeklendirebiliriz :$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

Ancak karelerin toplamının olmasını istediğimiz için gerekecek çünkü:$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

Not olarak, ölçeklendirme faktörünün kullanımı daha sonra değiştirilirken , açıklama tanımlanırken$\sqrt{n-1}$$\sqrt{n}$lan

prcomp kullanır : "princomp'den farklı olarak varyanslar normal bölücü ile hesaplanır ".$n-1$$n - 1$

---

Onları tüm ififadelerden ve diğer temizlikçi tüylerden arındırdıktan sonra, biplot()aşağıdaki gibi ilerler:

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)

beklendiği biplot()gibi biplot(PCA), dokunulmamış tüm estetik eksikliklerinde çıktıyı doğrudan (aşağıda soldaki çizim) ile çağrıldığı şekilde ( aşağıda sağdaki görüntü) üretir :

İlgi noktaları:

• Oklar, iki ana bileşenin her birinin ölçeklendirilmiş özvektörü ile bunlara ilişkin ölçeklendirilmiş puanlar ( ratio) arasındaki maksimum oranla ilişkili bir ölçekte çizilir . AS @amoeba yorumlar:

dağılım grafiği ve "ok grafiği", okların en büyük (mutlak değer) x veya y ok koordinatı, dağınık veri noktalarının en büyük (mutlak değer) x veya y koordinatına tam olarak eşit olacak şekilde ölçeklendirilir

• Yukarıda tahmin edildiği gibi, noktalar doğrudan SVD'nin matrisindeki puanlar olarak çizilebilir :$\mathbf U$

---