Como determinar componentes principais significativos usando o bootstrapping ou a abordagem de Monte Carlo?

Estou interessado em determinar o número de padrões significativos provenientes de uma Análise de Componentes Principais (PCA) ou de Função Ortogonal Empírica (EOF). Estou particularmente interessado em aplicar esse método aos dados climáticos. O campo de dados é uma matriz MxN, com M sendo a dimensão do tempo (por exemplo, dias) e N sendo a dimensão espacial (por exemplo, localizações long / lat). Eu li sobre um possível método de inicialização para determinar PCs significativos, mas não consegui encontrar uma descrição mais detalhada. Até agora, eu estava aplicando a Regra de Ouro de North (North et al ., 1982) para determinar esse ponto de corte, mas fiquei pensando se um método mais robusto estaria disponível.

Como um exemplo:

###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="")

E, aqui está o método que eu tenho usado para determinar o significado do PC. Basicamente, a regra geral é que a diferença entre os Lambdas vizinhos deve ser maior que o erro associado.

###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)

Eu achei útil a seção do capítulo de Björnsson e Venegas ( 1997 ) sobre testes de significância - eles se referem a três categorias de testes, dos quais a variância dominante - tipo é provavelmente o que eu espero usar. Eles se referem a um tipo de abordagem de Monte Carlo de embaralhar a dimensão do tempo e recalcular os Lambdas em várias permutações. von Storch e Zweiers (1999) também se referem a um teste que compara o espectro Lambda a um espectro de "ruído" de referência. Nos dois casos, estou um pouco inseguro sobre como isso pode ser feito, e também sobre como o teste de significância é feito, considerando os intervalos de confiança identificados pelas permutações.

Obrigado pela ajuda.

Referências: Björnsson, H. e Venegas, SA (1997). "Um manual para análises EOF e SVD de dados climáticos", Universidade McGill, Relatório CCGCR No. 97-1, Montreal, Québec, 52pp. http://andvari.vedur.is/%7Efolk/halldor/PICKUP/eof.pdf

GR North, TL Bell, RF Cahalan e FJ Moeng. (1982). Erros de amostragem na estimativa de funções ortogonais empíricas. Seg. Wea. Rev., 110: 699–706.

von Storch, H. Zwiers, FW (1999). Análise estatística em pesquisa climática. Cambridge University Press.

Vou tentar avançar um pouco o diálogo aqui, mesmo que essa seja a minha pergunta. Faz seis meses desde que perguntei isso e, infelizmente, nenhuma resposta completa foi dada. Tentarei resumir o que reuni até agora e ver se alguém pode elaborar as questões restantes. Por favor, desculpe a resposta longa, mas não vejo outra maneira ...

Primeiro, demonstrarei várias abordagens usando um conjunto de dados sintéticos possivelmente melhor. Ele vem de um artigo de Beckers e Rixon ( 2003 ) que ilustra o uso de um algoritmo para a realização de EOF em dados escassos. Eu reproduzi o algoritmo em R se alguém estiver interessado ( link ).

Conjunto de dados sintéticos:

#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))

Portanto, o verdadeiro campo de dados Xté composto por 9 sinais e eu adicionei algum ruído para criar o campo observado Xp, que será usado nos exemplos abaixo. Os EOFs são determinados como tais:

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

Seguindo o exemplo que usei no meu exemplo original, determinarei EOFs "significativos" por meio da regra de ouro de North.

Regra de ouro de North

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)

Como os valores Lambda de 2: 4 são muito próximos um do outro em amplitude, eles são considerados insignificantes pela regra geral - ou seja, seus respectivos padrões EOF podem se sobrepor e se misturar, devido a suas amplitudes semelhantes. Isso é lamentável, pois sabemos que 9 sinais realmente existem no campo.

Uma abordagem mais subjetiva é exibir os valores Lambda transformados em log ("Scree plot") e ajustar uma regressão aos valores finais. Pode-se determinar visualmente em que nível os valores lambda estão acima desta linha:

Scree plot

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)

Portanto, os 5 principais EOFs estão acima dessa linha. Eu tentei este exemplo quando Xpnão há ruído adicional adicionado e os resultados revelam todos os 9 sinais originais. Portanto, a insignificância das EOFs 6: 9 se deve ao fato de sua amplitude ser menor que o ruído no campo.

Um método mais objetivo é o critério da "Regra N" de Overland e Preisendorfer (1982). Há uma implementação dentro do wqpacote, que mostro abaixo.

Regra 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)

A Regra N identificou quatro EOFs significativos. Pessoalmente, preciso entender melhor esse método; Por que é possível avaliar o nível de erro com base em um campo aleatório que não usa a mesma distribuição que em Xp? Uma variação desse método seria fazer uma nova amostra dos dados Xppara que cada coluna seja embaralhada aleatoriamente. Dessa forma, garantimos que a variação total do campo aleatório seja a mesma que Xp. Ao reamostrar muitas vezes, conseguimos calcular um erro de linha de base da decomposição.

Monte Carlo com campo aleatório (isto é, comparação de modelos nulos)

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)

Novamente, 4 EOFs estão acima das distribuições para os campos aleatórios. Minha preocupação com essa abordagem e a da Regra N é que elas não estão realmente abordando os intervalos de confiança dos valores do Lambda; por exemplo, um primeiro valor alto do Lambda resultará automaticamente em uma menor quantidade de variação a ser explicada pelos valores à direita. Assim, o Lambda calculado a partir de campos aleatórios sempre terá uma inclinação menos acentuada e pode resultar na seleção de poucos EOFs significativos. [NOTA: A eofNum()função supõe que os EOFs sejam calculados a partir de uma matriz de correlação. Esse número pode ser diferente se você usar, por exemplo, uma matriz de covariância (dados centralizados, mas não dimensionados).]

Por fim, @ tomasz74 mencionou o artigo de Babamoradi et al. (2013), que eu tenho uma breve olhada. É muito interessante, mas parece estar mais focado no cálculo de ICs de cargas e coeficientes EOF, em vez de Lambda. No entanto, acredito que possa ser adotado para avaliar o erro Lambda usando a mesma metodologia. Uma reamostragem de autoinicialização é feita do campo de dados, reamostrando as linhas até que um novo campo seja produzido. A mesma linha pode ser reamostrada mais de uma vez, o que é uma abordagem não paramétrica e não é necessário fazer suposições sobre a distribuição de dados.

Bootstrap de valores 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)

Embora isso possa ser mais robusto do que a regra de ouro de North para calcular o erro dos valores Lambda, acredito agora que a questão do significado do EOF se resume a opiniões diferentes sobre o que isso significa. Para os métodos de regra de ouro e de autoinicialização do Norte, a significância parece ser mais baseada na sobreposição ou não da diferença entre os valores do Lambda. Se houver, esses EOFs podem ser misturados em seus sinais e não representar padrões "verdadeiros". Por outro lado, esses dois EOFs podem descrever uma quantidade significativa de variação (em comparação com a decomposição de um campo aleatório - por exemplo, Regra N). Portanto, se alguém estiver interessado em filtrar o ruído (ou seja, via truncamento EOF), a Regra N seria suficiente. Se alguém estiver interessado em determinar padrões reais em um conjunto de dados, os critérios mais rigorosos da sobreposição do Lambda poderão ser mais robustos.

Novamente, não sou especialista nessas questões, por isso ainda espero que alguém com mais experiência possa contribuir para essa explicação.

Referências:

Beckers, Jean-Marie e M. Rixen. "Cálculos EOF e preenchimento de dados de conjuntos de dados oceanográficos incompletos." Jornal da tecnologia atmosférica e oceânica 20.12 (2003): 1839-1856.

Overland, J. e R. Preisendorfer, Um teste de significância para componentes principais aplicados a uma climatologia de ciclones, Mon. Wea. Rev., 110, 1-4, 1982.