Come determinare componenti principali significativi usando il bootstrap o l'approccio Monte Carlo?

Sono interessato a determinare il numero di modelli significativi che emergono da un'analisi della componente principale (PCA) o dell'analisi della funzione ortogonale empirica (EOF). Sono particolarmente interessato ad applicare questo metodo ai dati climatici. Il campo dati è una matrice MxN con M come dimensione temporale (ad esempio giorni) e N come dimensione spaziale (ad esempio posizioni lon / lat). Ho letto di un possibile metodo bootstrap per determinare PC significativi, ma non sono stato in grado di trovare una descrizione più dettagliata. Fino ad ora, ho applicato North's Rule of Thumb (North et al ., 1982) per determinare questo limite, ma mi chiedevo se fosse disponibile un metodo più robusto.

Come esempio:

###Generate data
x <- -10:10
y <- -10:10
grd <- expand.grid(x=x, y=y)

#3 spatial patterns
sp1 <- grd$x^3+grd$y^2
tmp1 <- matrix(sp1, length(x), length(y))
image(x,y,tmp1)

sp2 <- grd$x^2+grd$y^2
tmp2 <- matrix(sp2, length(x), length(y))
image(x,y,tmp2)

sp3 <- 10*grd$y
tmp3 <- matrix(sp3, length(x), length(y))
image(x,y,tmp3)


#3 respective temporal patterns
T <- 1:1000

tp1 <- scale(sin(seq(0,5*pi,,length(T))))
plot(tp1, t="l")

tp2 <- scale(sin(seq(0,3*pi,,length(T))) + cos(seq(1,6*pi,,length(T))))
plot(tp2, t="l")

tp3 <- scale(sin(seq(0,pi,,length(T))) - 0.2*cos(seq(1,10*pi,,length(T))))
plot(tp3, t="l")


#make data field - time series for each spatial grid (spatial pattern multiplied by temporal pattern plus error)
set.seed(1)
F <- as.matrix(tp1) %*% t(as.matrix(sp1)) + 
as.matrix(tp2) %*% t(as.matrix(sp2)) + 
as.matrix(tp3) %*% t(as.matrix(sp3)) +
matrix(rnorm(length(T)*dim(grd)[1], mean=0, sd=200), nrow=length(T), ncol=dim(grd)[1]) # error term

dim(F)
image(F)


###Empirical Orthogonal Function (EOF) Analysis 
#scale field
Fsc <- scale(F, center=TRUE, scale=FALSE)

#make covariance matrix
C <- cov(Fsc)
image(C)

#Eigen decomposition
E <- eigen(C)

#EOFs (U) and associated Lambda (L) 
U <- E$vectors
L <- E$values

#projection of data onto EOFs (U) to derive principle components (A)
A <- Fsc %*% U

dim(U)
dim(A)

#plot of top 10 Lambda
plot(L[1:10], log="y")

#plot of explained variance (explvar, %) by each EOF
explvar <- L/sum(L) * 100
plot(explvar[1:20], log="y")


#plot original patterns versus those identified by EOF
layout(matrix(1:12, nrow=4, ncol=3, byrow=TRUE), widths=c(1,1,1), heights=c(1,0.5,1,0.5))
layout.show(12)

par(mar=c(4,4,3,1))
image(tmp1, main="pattern 1")
image(tmp2, main="pattern 2")
image(tmp3, main="pattern 3")

par(mar=c(4,4,0,1)) 
plot(T, tp1, t="l", xlab="", ylab="")
plot(T, tp2, t="l", xlab="", ylab="")
plot(T, tp3, t="l", xlab="", ylab="")

par(mar=c(4,4,3,1))
image(matrix(U[,1], length(x), length(y)), main="eof 1") 
image(matrix(U[,2], length(x), length(y)), main="eof 2")
image(matrix(U[,3], length(x), length(y)), main="eof 3")

par(mar=c(4,4,0,1)) 
plot(T, A[,1], t="l", xlab="", ylab="")
plot(T, A[,2], t="l", xlab="", ylab="")
plot(T, A[,3], t="l", xlab="", ylab="")

Ed ecco il metodo che ho usato per determinare il significato del PC. Fondamentalmente, la regola empirica è che la differenza tra Lambdas vicini deve essere maggiore del loro errore associato.

###Determine significant EOFs

#North's Rule of Thumb
Lambda_err <- sqrt(2/dim(F)[2])*L
upper.lim <- L+Lambda_err
lower.lim <- L-Lambda_err
NORTHok=0*L
for(i in seq(L)){
    Lambdas <- L
    Lambdas[i] <- NaN
    nearest <- which.min(abs(L[i]-Lambdas))
    if(nearest > i){
        if(lower.lim[i] > upper.lim[nearest]) NORTHok[i] <- 1
    }
    if(nearest < i){
        if(upper.lim[i] < lower.lim[nearest]) NORTHok[i] <- 1
    }
}
n_sig <- min(which(NORTHok==0))-1

plot(L[1:10],log="y", ylab="Lambda (dots) and error (vertical lines)", xlab="EOF")
segments(x0=seq(L), y0=L-Lambda_err, x1=seq(L), y1=L+Lambda_err)
abline(v=n_sig+0.5, col=2, lty=2)
text(x=n_sig, y=mean(L[1:10]), labels="North's Rule of Thumb", srt=90, col=2)

Ho trovato utile la sezione del capitolo di Björnsson e Venegas ( 1997 ) sui test di significatività - si riferiscono a tre categorie di test, di cui il tipo di varianza dominante è probabilmente quello che spero di usare. Si riferiscono a un tipo di approccio Monte Carlo di mescolare la dimensione temporale e ricalcolare le Lambdas su molte permutazioni. von Storch e Zweiers (1999) fanno anche riferimento a un test che confronta lo spettro Lambda con uno spettro di "rumore" di riferimento. In entrambi i casi, sono un po 'incerto su come ciò possa essere fatto, e anche su come viene eseguito il test di significatività alla luce degli intervalli di confidenza identificati dalle permutazioni.

Grazie per l'aiuto.

Riferimenti: Björnsson, H. e Venegas, SA (1997). "Un manuale per analisi EOF e SVD dei dati climatici", McGill University, Rapporto CCGCR n. 97-1, Montréal, Québec, 52pp. http://andvari.vedur.is/%7Efolk/halldor/PICKUP/eof.pdf

GR nord, TL Bell, RF Cahalan e FJ Moeng. (1982). Errori di campionamento nella stima delle funzioni ortogonali empiriche. Mon. Wea. Rev., 110: 699–706.

von Storch, H, Zwiers, FW (1999). Analisi statistiche nella ricerca sul clima. Cambridge University Press.

Cercherò di far avanzare un po 'il dialogo qui, anche se questa è la mia domanda. Sono passati 6 mesi da quando l'ho chiesto e sfortunatamente non sono state fornite risposte complete, cercherò di riassumere ciò che ho raccolto finora e vedere se qualcuno può approfondire le questioni rimanenti. Per favore, scusa la lunga risposta, ma non vedo altro modo ...

In primo luogo, mostrerò diversi approcci usando un set di dati sintetici forse migliore. Viene da un articolo di Beckers e Rixon ( 2003 ) che illustra l'uso di un algoritmo per condurre EOF su dati gappy. Ho riprodotto l'algoritmo in R se qualcuno è interessato ( link ).

Set di dati sintetici:

#color palette
pal <- colorRampPalette(c("blue", "cyan", "yellow", "red"))

#Generate data
m=50
n=100
frac.gaps <- 0.5 # the fraction of data with NaNs
N.S.ratio <- 0.25 # the Noise to Signal ratio for adding noise to data

x <- (seq(m)*2*pi)/m
t <- (seq(n)*2*pi)/n


#True field
Xt <- 
 outer(sin(x), sin(t)) + 
 outer(sin(2.1*x), sin(2.1*t)) + 
 outer(sin(3.1*x), sin(3.1*t)) +
 outer(tanh(x), cos(t)) + 
 outer(tanh(2*x), cos(2.1*t)) + 
 outer(tanh(4*x), cos(0.1*t)) + 
 outer(tanh(2.4*x), cos(1.1*t)) + 
 tanh(outer(x, t, FUN="+")) + 
 tanh(outer(x, 2*t, FUN="+"))

Xt <- t(Xt)
image(Xt, col=pal(100))

#Noise field
set.seed(1)
RAND <- matrix(runif(length(Xt), min=-1, max=1), nrow=nrow(Xt), ncol=ncol(Xt))
R <- RAND * N.S.ratio * Xt

#True field + Noise field
Xp <- Xt + R
image(Xp, col=pal(100))

Quindi, il campo dati vero Xtè composto da 9 segnali e ho aggiunto del rumore per creare il campo osservato Xp, che verrà utilizzato negli esempi seguenti. Gli EOF sono determinati come tali:

EOF

#make covariance matrix
C <- t(Xp) %*% Xp #cov(Xp)
image(C)

#Eigen decomposition
E <- svd(C)

#EOFs (U) and associated Lambda (L) 
U <- E$u
L <- E$d

#projection of data onto EOFs (U) to derive principle components (A)
A <- Xp %*% U

Seguendo l'esempio che ho usato nel mio esempio originale, determinerò EOF "significativi" tramite la regola empirica di North.

Regola del pollice del Nord

Lambda_err <- sqrt(2/dim(Xp)[2])*L
upper.lim <- L+Lambda_err
lower.lim <- L-Lambda_err
NORTHok=0*L
for(i in seq(L)){
    Lambdas <- L
    Lambdas[i] <- NaN
    nearest <- which.min(abs(L[i]-Lambdas))
    if(nearest > i){
        if(lower.lim[i] > upper.lim[nearest]) NORTHok[i] <- 1
    }
    if(nearest < i){
        if(upper.lim[i] < lower.lim[nearest]) NORTHok[i] <- 1
    }
}
n_sig <- min(which(NORTHok==0))-1
n_sig

plot(L[1:20],log="y", ylab="Lambda (dots) and error (vertical lines)", xlab="EOF")
segments(x0=seq(L), y0=L-Lambda_err, x1=seq(L), y1=L+Lambda_err)
abline(v=n_sig+0.5, col=2, lty=2)
text(x=n_sig, y=mean(L[1:10]), labels="North's Rule of Thumb", srt=90, col=2)

Poiché i valori di Lambda di 2: 4 sono molto vicini l'uno all'altro in ampiezza, questi sono considerati insignificanti dalla regola empirica - vale a dire che i loro rispettivi schemi EOF potrebbero sovrapporsi e mescolarsi date le loro ampiezze simili. Questo è un peccato dato che sappiamo che esistono effettivamente 9 segnali sul campo.

Un approccio più soggettivo è quello di visualizzare i valori Lambda trasformati in log ("Trama di ghiaione") e quindi di adattare una regressione ai valori finali. Uno può quindi determinare visivamente a quale livello si trovano i valori lambda sopra questa linea:

Trama ghiaione

ntrail <- 35
tail(L, ntrail)
fit <- lm(log(tail(L, ntrail)) ~ seq(length(L)-ntrail+1, length(L)))
plot(log(L))
abline(fit, col=2)

Quindi, i 5 EOF principali si trovano sopra questa linea. Ho provato questo esempio quando Xpnon è stato aggiunto alcun rumore aggiuntivo e i risultati rivelano tutti e 9 i segnali originali. Quindi, l'insignificanza degli EOF 6: 9 è dovuta al fatto che la loro ampiezza è inferiore al rumore nel campo.

Un metodo più obiettivo sono i criteri "Regola N" di Overland e Preisendorfer (1982). C'è un'implementazione all'interno del wqpacchetto, che mostro di seguito.

Regola N

library(wq)
eofNum(Xp, distr = "normal", reps = 99)

RN <- ruleN(nrow(Xp), ncol(Xp), type = "normal", reps = 99)
RN
eigs <- svd(cov(Xp))$d
plot(eigs, log="y")
lines(RN, col=2, lty=2)

La Regola N identificava 4 EOF significativi. Personalmente, ho bisogno di capire meglio questo metodo; Perché è possibile misurare il livello di errore in base a un campo casuale che non utilizza la stessa distribuzione di quella in Xp? Una variante di questo metodo sarebbe quella di ricampionare i dati in Xpmodo che ogni colonna venga rimescolata casualmente. In questo modo, ci assicuriamo che la varianza totale del campo casuale sia la stessa di Xp. Ricampionando più volte, siamo quindi in grado di calcolare un errore di base della decomposizione.

Monte Carlo con campo casuale (cioè confronto del modello Null)

iter <- 499
LAMBDA <- matrix(NaN, ncol=iter, nrow=dim(Xp)[2])

set.seed(1)
for(i in seq(iter)){
    #i=1

    #random reorganize dimensions of scaled field
    Xp.tmp <- NaN*Xp
    for(j in seq(dim(Xp.tmp)[2])){
        #j=1
        Xp.tmp[,j] <- Xp[,j][sample(nrow(Xp))]
    }

    #make covariance matrix
    C.tmp <- t(Xp.tmp) %*% Xp.tmp #cov(Xp.tmp)

    #SVD decomposition
    E.tmp <- svd(C.tmp)

    #record Lambda (L) 
    LAMBDA[,i] <- E.tmp$d

    print(paste(round(i/iter*100), "%", " completed", sep=""))
}

boxplot(t(LAMBDA), log="y", col=8, border=2, outpch="")
points(L)

Ancora una volta, 4 EOF sono al di sopra delle distribuzioni per i campi casuali. La mia preoccupazione per questo approccio, e quello della Regola N, è che questi non stanno veramente affrontando gli intervalli di confidenza dei valori Lambda; ad esempio, un primo valore Lambda elevato comporterà automaticamente una quantità inferiore di varianza spiegata da quelli finali. Pertanto, la Lambda calcolata da campi casuali avrà sempre una pendenza meno ripida e potrebbe comportare la selezione di troppo pochi EOF significativi. [NOTA: la eofNum()funzione presuppone che gli EOF siano calcolati da una matrice di correlazione. Questo numero potrebbe essere diverso se si utilizza ad esempio una matrice di covarianza (dati centrati ma non ridimensionati).]

Infine, @ tomasz74 ha menzionato l'articolo di Babamoradi et al. (2013), di cui ho avuto una breve occhiata. È molto interessante, ma sembra essere più focalizzato sul calcolo di CI di carichi e coefficienti EOF, piuttosto che su Lambda. Tuttavia, credo che potrebbe essere adottato per valutare l'errore Lambda usando la stessa metodologia. Un ricampionamento bootstrap viene eseguito sul campo dati ricampionando le righe fino a quando non viene prodotto un nuovo campo. La stessa riga può essere ricampionata più di una volta, il che è un approccio non parametrico e non è necessario fare ipotesi sulla distribuzione dei dati.

Bootstrap di valori Lambda

B <- 40 * nrow(Xp)
LAMBDA <- matrix(NaN, nrow=length(L), ncol=B)
for(b in seq(B)){
    samp.b <- NaN*seq(nrow(Xp))
    for(i in seq(nrow(Xp))){
        samp.b[i] <- sample(nrow(Xp), 1)
    }
    Xp.b  <- Xp[samp.b,]
    C.b  <- t(Xp.b) %*% Xp.b 
    E.b  <- svd(C.b)
    LAMBDA[,b] <- E.b$d
    print(paste(round(b/B*100), "%", " completed", sep=""))
}
boxplot(t(LAMBDA), log="y", col=8, outpch="", ylab="Lambda [log-scale]")
points(L, col=4)
legend("topright", legend=c("Original"), pch=1, col=4)

Anche se questo può essere più solido della regola empirica di North per il calcolo dell'errore dei valori Lambda, credo ora che la questione della rilevanza dell'EOF dipenda da opinioni diverse su ciò che ciò significa. Per i metodi della regola empirica e del bootstrap del Nord, il significato sembra essere più basato sul fatto che teere si sovrapponga o meno tra i valori Lambda. Se esiste, allora questi EOF possono essere mescolati nei loro segnali e non rappresentare schemi "veri". D'altra parte, questi due EOF possono descrivere una quantità significativa di varianza (rispetto alla decomposizione di un campo casuale - ad esempio la Regola N). Quindi, se si è interessati a filtrare il rumore (cioè tramite il troncamento EOF), allora la Regola N sarebbe sufficiente. Se si è interessati a determinare modelli reali in un set di dati, i criteri più rigorosi della sovrapposizione di Lambda potrebbero essere più robusti.

Ancora una volta, non sono un esperto di questi problemi, quindi spero ancora che qualcuno con più esperienza possa aggiungere questa spiegazione.

Riferimenti:

Beckers, Jean-Marie e M. Rixen. "Calcoli EOF e riempimento di dati da set di dati oceanografici incompleti." Journal of Atmospher and Oceanic Technology 20.12 (2003): 1839-1856.

Overland, J. e R. Preisendorfer, Un test di significatività per i componenti principali applicati a una ciclologia climatologica, lun. Wea. Rev., 110, 1-4, 1982.