Frecce delle variabili sottostanti nel biplot PCA in R

A rischio di rendere la domanda specifica per il software, e con la scusa della sua ubiquità e idiosincrasie, voglio fare una domanda sulla funzione biplot()in R e, più specificamente, sul calcolo e sulla stampa delle sue frecce rosse sovrapposte predefinite, corrispondenti alle variabili sottostanti.

---

[Per dare un senso ad alcuni dei commenti, le trame inizialmente pubblicate avevano un problema di rimprovero di scarso interesse e ora sono cancellate.]

Prendi in considerazione l'upgrade del post di @ amoeba e @ttnphns . Grazie ad entrambi per l'aiuto e le idee.

---

Quanto segue si basa sul set di dati Iris in R , e in particolare i primi tre variabili (colonne): Sepal.Length, Sepal.Width, Petal.Length.

Un biplot combina un diagramma di carico (autovettori non standardizzati) - in concreto, i primi due carichi , e un plot punteggio (punti dati ruotati e dilatate tracciati rispetto a componenti principali). Utilizzando lo stesso set di dati, @amoeba descrive 9 possibili combinazioni di biplot PCA basate su 3 possibili normalizzazioni del diagramma dei punteggi del primo e del secondo componente principale e 3 normalizzazioni del diagramma di caricamento (frecce) delle variabili iniziali. Per vedere come R gestisce queste possibili combinazioni, è interessante osservare il biplot()metodo:

---

Innanzitutto l'algebra lineare pronta per copiare e incollare:

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. Riproduzione del diagramma di caricamento (frecce):

Qui l'interpretazione geometrica di questo post di @ttnphns aiuta molto. La notazione del diagramma nel post è stata mantenuta: sta per la variabile nello spazio soggetto . h ′ è la freccia corrispondente alla fine tracciata; e le coordinate di un 1 e un 2 sono i carichi compongono una variabile V rispetto al PC 1 e PC 2 :$V$Sepal L.$h'$$a_1$$a_2$$V$$\small \text{PC} 1$$\small \text{PC} 2$

---

---

Il componente della variabile Sepal L.rispetto al sarà quindi:$\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}$$

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

Allo stesso modo,

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

Tornando all'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)$Pertanto, può essere considerato un coefficiente di correlazione di Pearson , , con l'avvertenza che non capisco la ruga del fattore .$r$$n-1$

Duplicando e sovrapponendo in blu le frecce rosse di 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)

---

Punti di interesse:

• Le frecce possono essere riprodotte come correlazione delle variabili originali con i punteggi generati dai primi due componenti principali.
• In alternativa, questo può essere ottenuto come nel primo grafico della seconda riga, etichettato nel post di @ amoeba:$\mathbf{ V*S}$

o nel codice 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)

o anche ancora ...

    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)

collegandosi alla spiegazione geometrica dei caricamenti di @ttnphns , o di questo altro post informativo anche di @ttnphns .

• C'è un fattore di ridimensionamento: sqrt(nrow(X) - 1)che rimane un po 'un mistero.

• $0.8$ ha a che fare con la creazione di spazio per l'etichetta - vedi questo commento qui :

Inoltre, si dovrebbe dire che le frecce sono tracciate in modo tale che il centro dell'etichetta di testo sia dove dovrebbe essere! Le frecce vengono quindi moltiplicate per 0,80,8 prima della stampa, ovvero tutte le frecce sono più corte di quanto dovrebbero essere, presumibilmente per evitare la sovrapposizione con l'etichetta di testo (vedere il codice per biplot.default). Trovo che sia estremamente confuso. - ameba, 19 marzo 15 alle 10:06

---

2. Tracciare il grafico dei biplot()punteggi (e le frecce contemporaneamente):

Gli assi sono ridimensionati in unità di somma dei quadrati, corrispondente alla prima trama della prima riga sul post di @ amoeba , che può essere riprodotta tracciando la matrice della decomposizione svd (più avanti su questo più avanti) - " Colonne di : questi sono i componenti principali ridimensionati in base alla somma unitaria dei quadrati. "$\mathbf U$$\mathbf U$

Ci sono due diverse scale in gioco sugli assi orizzontale inferiore e superiore nella costruzione del biplot:

Tuttavia, la scala relativa non è immediatamente ovvia e richiede approfondimenti su funzioni e metodi:

biplot()traccia i punteggi come colonne di in SVD, che sono vettori di unità ortogonali:$\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

Considerando che la prcomp()funzione in R restituisce i punteggi ridimensionati ai loro autovalori:

> 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

Pertanto possiamo ridimensionare la varianza su dividendo per gli autovalori:$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

Ma poiché vogliamo che la somma dei quadrati sia , dovremo dividere per perché:$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

Da notare l'uso del fattore di ridimensionamento , viene successivamente modificato in quando la definizione della spiegazione sembra risiedere nel fatto che$\sqrt{n-1}$$\sqrt{n}$lan

prcompusa : "A differenza di princomp, le varianze sono calcolate con il solito divisore ".n - $n-1$$n - 1$

---

Dopo averle rimosse da tutte le ifdichiarazioni e da altre lanugine per la pulizia della casa, biplot()procedi come segue:

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)

che, come previsto, riproduce (immagine a destra in basso) l' biplot()output come chiamato direttamente con biplot(PCA)(diagramma a sinistra in basso) in tutte le sue carenze estetiche intatte:

Punti di interesse:

• Le frecce sono tracciate su una scala correlata al rapporto massimo tra l'autovettore in scala di ciascuno dei due componenti principali e i loro rispettivi punteggi in scala (il ratio). Commenti AS @amoeba:

il diagramma a dispersione e il "diagramma a freccia" sono ridimensionati in modo tale che la coordinata più grande (in valore assoluto) x o y delle frecce fosse esattamente uguale alla coordinata più grande (in valore assoluto) x o y dei punti di dati sparsi

• Come anticipato sopra, i punti possono essere tracciati direttamente come punteggi nella matrice dell'SVD:$\mathbf U$

---