Bagaimana menentukan komponen utama yang signifikan menggunakan pendekatan bootstrap atau Monte Carlo?

Saya tertarik untuk menentukan jumlah pola signifikan yang keluar dari Analisis Komponen Utama (PCA) atau Analisis Fungsi Orthogonal Empiris (EOF). Saya khususnya tertarik menerapkan metode ini pada data iklim. Bidang data adalah matriks MxN dengan M sebagai dimensi waktu (misalnya hari) dan N menjadi dimensi spasial (misalnya lokasi lon / lat). Saya telah membaca tentang metode bootstrap yang mungkin untuk menentukan PC yang signifikan, tetapi tidak dapat menemukan deskripsi yang lebih rinci. Sampai sekarang, saya telah menerapkan Rule of Thumb Utara (North et al ., 1982) untuk menentukan cutoff ini, tapi saya bertanya-tanya apakah metode yang lebih kuat tersedia.

Sebagai contoh:

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

Dan, inilah metode yang telah saya gunakan untuk menentukan signifikansi PC. Pada dasarnya, aturan praktisnya adalah bahwa perbedaan antara Lambda yang berdekatan harus lebih besar daripada kesalahan yang terkait.

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

Saya telah menemukan bagian bab oleh Björnsson dan Venegas ( 1997 ) tentang tes signifikansi untuk membantu - mereka merujuk pada tiga kategori tes, di mana varian dominan- jenis mungkin apa yang saya harapkan untuk digunakan. Rujukan ke jenis pendekatan Monte Carlo mengocok dimensi waktu dan mengkomputasi ulang Lambdas melalui banyak permutasi. von Storch dan Zweiers (1999) juga merujuk pada tes yang membandingkan spektrum Lambda dengan referensi "noise". Dalam kedua kasus, saya agak tidak yakin bagaimana ini bisa dilakukan, dan juga bagaimana uji signifikansi dilakukan mengingat interval kepercayaan yang diidentifikasi oleh permutasi.

Terima kasih atas bantuan Anda.

Referensi: Björnsson, H. dan Venegas, SA (1997). "Manual untuk analisis data iklim EOF dan SVD", McGill University, CCGCR Laporan No. 97-1, Montréal, Québec, 52pp. http://andvari.vedur.is/%7Efolk/halldor/PICKUP/eof.pdf

GR Utara, TL Bell, RF Cahalan, dan FJ Moeng. (1982). Kesalahan pengambilan sampel dalam estimasi fungsi ortogonal empiris. Senin Wea. Pdt., 110: 699–706.

von Storch, H, Zwiers, FW (1999). Analisis statistik dalam penelitian iklim. Cambridge University Press.

Saya akan mencoba dan memajukan dialog di sini meskipun ini adalah pertanyaan saya. Sudah 6 bulan sejak saya menanyakan hal ini dan sayangnya tidak ada jawaban lengkap yang diberikan saya akan mencoba dan meringkas apa yang telah saya kumpulkan sejauh ini dan melihat apakah ada yang bisa mengelaborasi masalah yang tersisa. Maafkan jawaban yang panjang, tapi saya tidak melihat cara lain ...

Pertama, saya akan menunjukkan beberapa pendekatan menggunakan set data sintetis yang mungkin lebih baik. Itu berasal dari sebuah makalah oleh Beckers dan Rixon ( 2003 ) yang menggambarkan penggunaan suatu algoritma untuk melakukan EOF pada data gappy. Saya telah mereproduksi algoritme dalam R jika ada yang tertarik ( tautan ).

Kumpulan data sintetis:

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

Jadi, bidang data yang sebenarnya Xtterdiri dari 9 sinyal dan saya telah menambahkan beberapa noise padanya untuk membuat bidang yang diamati Xp, yang akan digunakan dalam contoh di bawah ini. EOF ditentukan sebagai berikut:

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

Mengikuti contoh yang saya gunakan dalam contoh asli saya, saya akan menentukan EOF "signifikan" melalui aturan praktis North.

Aturan Utara Jempol

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)

Karena nilai-nilai Lambda dari 2: 4 sangat dekat satu sama lain dalam amplitudo, ini dianggap tidak signifikan oleh aturan praktis - yaitu masing-masing pola EOF mereka mungkin tumpang tindih dan bercampur dengan memberikan amplitudo yang serupa. Sangat disayangkan mengingat kita tahu bahwa 9 sinyal benar-benar ada di lapangan.

Pendekatan yang lebih subyektif adalah dengan melihat nilai-nilai Lambda yang ditransformasikan-log ("Scree plot") dan kemudian menyesuaikan regresi dengan nilai-nilai trailing. Satu kemudian dapat menentukan secara visual pada tingkat apa nilai lambda berada di atas garis ini:

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)

Jadi, 5 EOF terkemuka berada di atas garis ini. Saya telah mencoba contoh ini ketika Xptidak ada noise tambahan yang ditambahkan dan hasilnya mengungkapkan semua 9 sinyal asli. Jadi, tidak signifikannya EOFs 6: 9 adalah karena fakta bahwa amplitudo mereka lebih rendah daripada kebisingan di lapangan.

Metode yang lebih objektif adalah kriteria "Aturan N" oleh Overland dan Preisendorfer (1982). Ada implementasi di dalam wqpaket, yang saya tunjukkan di bawah ini.

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

Aturan N mengidentifikasi 4 EOF yang signifikan. Secara pribadi, saya perlu lebih memahami metode ini; Mengapa mungkin untuk mengukur tingkat kesalahan berdasarkan bidang acak yang tidak menggunakan distribusi yang sama dengan yang ada di Xp? Salah satu variasi pada metode ini adalah dengan mengetes ulang data Xpsehingga setiap kolom diacak ulang secara acak. Dengan cara ini, kami memastikan bahwa total varians dari bidang acak sama dengan Xp. Dengan melakukan resampling berkali-kali, kami kemudian dapat menghitung kesalahan baseline dekomposisi.

Monte Carlo dengan bidang acak (yaitu perbandingan model 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)

Sekali lagi, 4 EOF berada di atas distribusi untuk bidang acak. Kekhawatiran saya dengan pendekatan ini, dan bahwa Aturan N, adalah bahwa ini tidak benar-benar membahas interval kepercayaan dari nilai-nilai Lambda; misalnya nilai Lambda pertama yang tinggi secara otomatis akan menghasilkan jumlah varians yang lebih rendah untuk dijelaskan oleh yang tertinggal. Dengan demikian Lambda yang dihitung dari bidang acak akan selalu memiliki kemiringan yang kurang curam dan dapat mengakibatkan terlalu sedikit memilih EOF yang signifikan. [CATATAN: eofNum()Fungsi ini mengasumsikan bahwa EOF dihitung dari matriks korelasi. Angka ini mungkin berbeda jika menggunakan misalnya matriks kovarians (data terpusat tetapi tidak diskalakan).]

Akhirnya, @ tomasz74 menyebutkan karya Babamoradi et al. (2013), yang saya telah melihat sekilas. Sangat menarik, tetapi tampaknya lebih fokus pada perhitungan CI tentang pemuatan dan koefisien EOF, daripada Lambda. Namun demikian, saya percaya bahwa itu mungkin diadopsi untuk menilai kesalahan Lambda menggunakan metodologi yang sama. Bootstrap resampling dilakukan pada bidang data dengan resampling baris sampai bidang baru diproduksi. Baris yang sama dapat diresampled lebih dari sekali, yang merupakan pendekatan non-parametrik dan orang tidak perlu membuat asumsi tentang distribusi data.

Bootstrap nilai 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)

Meskipun ini mungkin lebih kuat daripada aturan praktis North untuk menghitung kesalahan nilai Lambda, saya percaya sekarang bahwa pertanyaan tentang signifikansi EOF bermuara pada pendapat yang berbeda tentang apa artinya ini. Untuk aturan main of thumb dan metode bootstrap Utara, signifikansi tampaknya lebih didasarkan pada apakah ada tumpang tindih atau tidak antara nilai-nilai Lambda. Jika ada, maka EOF ini dapat dicampur dalam sinyalnya dan tidak mewakili pola "benar". Di sisi lain, kedua EOF ini dapat menggambarkan sejumlah varians yang signifikan (dibandingkan dengan dekomposisi bidang acak - mis. Peraturan N). Jadi jika seseorang tertarik untuk menyaring kebisingan (yaitu melalui pemotongan EOF) maka Aturan N akan cukup. Jika seseorang tertarik untuk menentukan pola nyata dalam kumpulan data, maka kriteria Lambda yang tumpang tindih mungkin lebih kuat.

Sekali lagi, saya bukan ahli dalam masalah ini, jadi saya masih berharap bahwa seseorang dengan pengalaman lebih banyak dapat menambah penjelasan ini.

Referensi:

Beckers, Jean-Marie, dan M. Rixen. "Perhitungan EOF dan Pengisian Data dari Kumpulan Data Oseanografi Tidak Lengkap." Jurnal Teknologi Atmosfer dan Kelautan 20.12 (2003): 1839-1856.

Overland, J., dan R. Preisendorfer, Tes signifikansi untuk komponen utama yang diterapkan pada klimatologi siklon, Mon. Wea. Pdt., 110, 1-4, 1982.