Frecce delle variabili sottostanti nel biplot PCA in R


11

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.]


Non riesco a capire come hai effettivamente ottenuto le tue frecce verdi. Non sono corretti Il fatto che la lunghezza verde sia di ca. due volte più lungo del verde s.width permette di sospettare che stavi disegnando i vettori relativi alle variabili non standardizzate. Ciò non può accadere su un biplot di PCA basato su correlazioni.
ttnphns,

Le frecce rosse sembrano corrette. Vedi: hanno la stessa lunghezza e sono simmetrici rispetto a PC2. Questa è l'unica posizione possibile quando si fa PCA con solo 2 variabili e basato su correlazioni (cioè variabili standardizzate). In PCA basato su correlazioni, i loadings (coordinati dalle frecce) sono le correlazioni tra PC e variabili. Nel tuo esempio, i carichi sono (vars dai PC): .74752, .66424; -.74752, .66424.
ttnphns,

@ttnphns Sì, le frecce rosse sono ciò che sto cercando di riprodurre (sono corrette), e sono tracciate in R con la biplot(name_of_the_PCA)chiamata, che in questo caso lo è biplot(PCA). Avevo centrato e ridimensionato i dati.
Antoni Parellada,

Quindi qual è la tua domanda? Come calcolare le coordinate per le frecce rosse? Dovrebbero essere i caricamenti di PCA . A volte, gli autovettori sono tracciati (probabilmente il tuo comando R l'ha fatto ??), tuttavia, il modo consensuale e significativo è quello di tracciare i caricamenti .
ttnphns,

@ttnphns Tracciare gli autovettori (suppongo sia lo stesso dei caricamenti) mi dà il giusto orientamento (grazie), ma non della stessa grandezza delle frecce rosse (sto incollando l'immagine nell'OP).
Antoni Parellada,

Risposte:


19

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 :VSepal L.ha1a2VPC1PC2


inserisci qui la descrizione dell'immagine


Il componente della variabile Sepal L.rispetto al sarà quindi:PC1

a1=hcos(ϕ)

PC1S1

S1=1nscores12=1VS1

a1=VS1=VS1cos(ϕ)(1)=h×1×cos(ϕ)

Poiché ,V=x2

Var(V)=x2n1=Vn1V=h=var(V)n1.

Allo stesso modo,

S1=1=var(S1)n1.

Tornando all'Eq. ,(1)

a1=h×1×cos(ϕ)=var(V)var(S1)cos(θ)(n1)

cos(ϕ)Pertanto, può essere considerato un coefficiente di correlazione di Pearson , , con l'avvertenza che non capisco la ruga del fattore .rn1

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)

inserisci qui la descrizione dell'immagine

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:VS

inserisci qui la descrizione dell'immagine

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. "UU

inserisci qui la descrizione dell'immagine

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

inserisci qui la descrizione dell'immagine

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: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é:1n1

var(scr_var_one)=1=1nscr_var_onen1
> 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 chen1nlan

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


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:

inserisci qui la descrizione dell'immagine

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:U


1
+1, buon studio. Ho aggiunto un tag Ralla tua domanda perché la questione confusa (vale a dire il coefficiente di ridimensionamento) si è rivelata in parte specifica per R. In generale, sei stato in grado di vedere te stesso che il biplot PCA è un grafico a dispersione sovrapposto di punteggi dei componenti (coordinate di riga) e coefficienti di direzione dei componenti (coordinate di colonna) e poiché a ciascuna inerzia possono essere applicati vari importi di standardizzazioni per "inerzia" (varianza) anche di così, possono sorgere vari aspetti del biplot. Per aggiungere: in genere (più senso), i carichi vengono visualizzati come coordinate di colonna (frecce).
ttnphns,

1
(cont.) Vedi la mia panoramica del biplot che spiega, in parole diverse, cosa hai mostrato nella tua bella risposta.
ttnphns,

2
+ 1 grazie per aver scritto tutorial e con codice riproducibile per noi!
Haitao Du,

Antonio, hai disegnato (come a mano) o hai tracciato (immesso dati) la tua foto? che software hai usato? Sembra carino.
ttnphns,

@ttnphns Grazie! Ecco il link ad esso . Mi chiedevo se avresti potuto migliorare, e tracciare i caricamenti e i PC in un modo migliore e più didattico. Sentiti libero di cambiare (è un programma meravigliosamente facile da usare) e, se lo fai, per favore condividi.
Antoni Parellada,
Utilizzando il nostro sito, riconosci di aver letto e compreso le nostre Informativa sui cookie e Informativa sulla privacy.
Licensed under cc by-sa 3.0 with attribution required.