77 lines
5.7 KiB
R
Executable File
77 lines
5.7 KiB
R
Executable File
#initialize model parameters
|
|
m<-100 #number of replications in simulation
|
|
dim<-12 #dimension of random variable X
|
|
truedim<-1#dimension of B=b
|
|
qs<-dim-truedim# dimension of orthogonal complement of B
|
|
b1=c(1,1,1,1,1,1,0,0,0,0,0,0)/sqrt(6)
|
|
b<-b1#B
|
|
P<-b%*%t(b)
|
|
sigma=0.5#error standard deviation
|
|
N<-100#sample size
|
|
K<-30#number of arbitrary starting values for curvilinear optimization
|
|
MAXIT<-30#maximal number of iterations in curvilinear search algorithm
|
|
|
|
para<-seq(0,1.5,0.5)#model parameter corresponding to lambda in M4
|
|
mix_prob<-seq(0.3,0.5,0.1) #model parameters corresponding to p_{mix}
|
|
M4_JASA<-array(data=NA,dim=c(length(para),length(mix_prob),m,5))
|
|
for(o in 1:length(mix_prob)){
|
|
for (u in 1:length(para)){
|
|
colnames(M4_JASA[u,o,,])<-c('CVE1','CVE2','CVE3','meanMAVE','csMAVE')
|
|
for (i in 1:m){
|
|
#generate dat according to M4 with p_{mix}=mix_prob[o] and lambda=para[u]
|
|
if(u==1){dat<-creat_sample(b,N,cos,sigma)}
|
|
else{dat<-creat_sample_noneliptic_gausmixture(b,N,cos,sigma,mix_prob[o],dispers_para = para[u])}
|
|
#est sample covariance matrix
|
|
Sig_est<-est_varmat(dat[,-1])
|
|
#est trace of sample covariance matrix
|
|
tr<-var_tr(Sig_est)
|
|
#CVE
|
|
#calculates Vhat_k for CVE1,CVE2, CVE3 for k=qs
|
|
CVE1<-stiefl_opt(dat,k=qs,k0=K,h=choose_h_2(dim,k=dim-truedim,N=N,nObs=(N)^(0.8),tr=tr),maxit = MAXIT,sclack_para = 0)
|
|
CVE2<-stiefl_opt(dat,k=qs,k0=K,h=choose_h_2(dim,k=dim-truedim,N=N,nObs=(N)^(2/3),tr=tr),maxit = MAXIT,sclack_para = 0)
|
|
CVE3<-stiefl_opt(dat,k=qs,k0=K,h=choose_h_2(dim,k=dim-truedim,N=N,nObs=(N)^(0.5),tr=tr),maxit = MAXIT,sclack_para = 0)
|
|
#calculate orthogonal complement of Vhat_k
|
|
#i.e. CVE1$est_base[,1:truedim] is estimator for B with dimension (dim times (dim-qs))
|
|
CVE1$est_base<-fill_base(CVE1$est_base)
|
|
CVE2$est_base<-fill_base(CVE2$est_base)
|
|
CVE3$est_base<-fill_base(CVE3$est_base)
|
|
# calculate distance between true B and estimated B
|
|
M4_JASA[u,o,i,1]<-subspace_dist(b,CVE1$est_base[,1:truedim])
|
|
M4_JASA[u,o,i,2]<-subspace_dist(b,CVE2$est_base[,1:truedim])
|
|
M4_JASA[u,o,i,3]<-subspace_dist(b,CVE3$est_base[,1:truedim])
|
|
#csMAVE
|
|
mod_t<-mave(Y~.,data=as.data.frame(dat),method = 'meanMAVE')
|
|
M4_JASA[u,o,i,4]<-subspace_dist(b,mod_t$dir[[truedim]])
|
|
#meanMAVE
|
|
mod_t2<-mave(Y~.,data=as.data.frame(dat),method = 'csMAVE')
|
|
M4_JASA[u,o,i,5]<-subspace_dist(b,mod_t2$dir[[truedim]])
|
|
|
|
}
|
|
print(paste(u,paste('/',length(para))))
|
|
}
|
|
}
|
|
|
|
par(mfrow=c(3,4))
|
|
boxplot(Exp_cook_square[1,1,,]/sqrt(2*truedim),names=c('CVE1','CVE2','CVE3','meanMAVE','csMAVE'),main=paste(paste('dispersion =',para[1]),paste('mixprob =',mix_prob[1]),sep=', '),ylim=c(0,1))
|
|
boxplot(Exp_cook_square[2,1,,]/sqrt(2*truedim),names=c('CVE1','CVE2','CVE3','mMAVE','csMAVE'),main=paste(paste('dispersion =',para[2]),paste('mixprob =',mix_prob[1]),sep=', '),ylim=c(0,1))
|
|
boxplot(Exp_cook_square[3,1,,]/sqrt(2*truedim),names=c('CVE1','CVE2','CVE3','mMAVE','csMAVE'),main=paste(paste('dispersion =',para[3]),paste('mixprob =',mix_prob[1]),sep=', '),ylim=c(0,1))
|
|
boxplot(Exp_cook_square[4,1,,]/sqrt(2*truedim),names=c('CVE1','CVE2','CVE3','mMAVE','csMAVE'),main=paste(paste('dispersion =',para[4]),paste('mixprob =',mix_prob[1]),sep=', '),ylim=c(0,1))
|
|
|
|
boxplot(Exp_cook_square[1,2,,]/sqrt(2*truedim),names=c('CVE1','CVE2','CVE3','mMAVE','csMAVE'),main=paste(paste('dispersion =',para[1]),paste('mixprob =',mix_prob[2]),sep=', '),ylim=c(0,1))
|
|
boxplot(Exp_cook_square[2,2,,]/sqrt(2*truedim),names=c('CVE1','CVE2','CVE3','mMAVE','csMAVE'),main=paste(paste('dispersion =',para[2]),paste('mixprob =',mix_prob[2]),sep=', '),ylim=c(0,1))
|
|
boxplot(Exp_cook_square[3,2,,]/sqrt(2*truedim),names=c('CVE1','CVE2','CVE3','mMAVE','csMAVE'),main=paste(paste('dispersion =',para[3]),paste('mixprob =',mix_prob[2]),sep=', '),ylim=c(0,1))
|
|
boxplot(Exp_cook_square[4,2,,]/sqrt(2*truedim),names=c('CVE1','CVE2','CVE3','mMAVE','csMAVE'),main=paste(paste('dispersion =',para[4]),paste('mixprob =',mix_prob[2]),sep=', '),ylim=c(0,1))
|
|
|
|
boxplot(Exp_cook_square[1,3,,]/sqrt(2*truedim),names=c('CVE1','CVE2','CVE3','mMAVE','csMAVE'),main=paste(paste('dispersion =',para[1]),paste('mixprob =',mix_prob[3]),sep=', '),ylim=c(0,1))
|
|
boxplot(Exp_cook_square[2,3,,]/sqrt(2*truedim),names=c('CVE1','CVE2','CVE3','mMAVE','csMAVE'),main=paste(paste('dispersion =',para[2]),paste('mixprob =',mix_prob[3]),sep=', '),ylim=c(0,1))
|
|
boxplot(Exp_cook_square[3,3,,]/sqrt(2*truedim),names=c('CVE1','CVE2','CVE3','mMAVE','csMAVE'),main=paste(paste('dispersion =',para[3]),paste('mixprob =',mix_prob[3]),sep=', '),ylim=c(0,1))
|
|
boxplot(Exp_cook_square[4,3,,]/sqrt(2*truedim),names=c('CVE1','CVE2','CVE3','mMAVE','csMAVE'),main=paste(paste('dispersion =',para[4]),paste('mixprob =',mix_prob[3]),sep=', '),ylim=c(0,1))
|
|
#boxplot(Exp_cook_square[5,3,,]/sqrt(2*truedim),names=c('CVE1','CVE2','CVE3','mMAVE','csMAVE'),main=paste(paste('dispersion =',para[5]),paste('mixprob =',mix_prob[3]),sep=', '),ylim=c(0,1))
|
|
|
|
boxplot(Exp_cook_square[1,4,,]/sqrt(2*truedim),names=c('CVE1','CVE2','CVE3','mMAVE','csMAVE'),main=paste(paste('dispersion =',para[1]),paste('mixprob =',mix_prob[4]),sep=', '),ylim=c(0,1))
|
|
boxplot(Exp_cook_square[2,4,,]/sqrt(2*truedim),names=c('CVE1','CVE2','CVE3','mMAVE','csMAVE'),main=paste(paste('dispersion =',para[2]),paste('mixprob =',mix_prob[4]),sep=', '),ylim=c(0,1))
|
|
boxplot(Exp_cook_square[3,4,,]/sqrt(2*truedim),names=c('CVE1','CVE2','CVE3','mMAVE','csMAVE'),main=paste(paste('dispersion =',para[3]),paste('mixprob =',mix_prob[4]),sep=', '),ylim=c(0,1))
|
|
boxplot(Exp_cook_square[4,4,,]/sqrt(2*truedim),names=c('CVE1','CVE2','CVE3','mMAVE','csMAVE'),main=paste(paste('dispersion =',para[4]),paste('mixprob =',mix_prob[4]),sep=', '),ylim=c(0,1))
|
|
|
|
par(mfrow=c(1,1))
|