2
0
Fork 0
CVE/CVE_legacy/M1.R

67 lines
2.8 KiB
R
Raw Normal View History

2019-08-09 21:34:37 +00:00
#initialize model parameterss
m<-100 #number of replications in simulation
dim<-12 #dimension of random variable X
truedim<-2 #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)
b2=c(1,-1,1,-1,1,-1,0,0,0,0,0,0)/sqrt(6)
b<-cbind(b1,b2)
P<-b%*%t(b)
sigma=0.5 #error standard deviation
N<-200 #sample size
K<-30 #number of arbitrary starting values for curvilinear optimization
MAXIT<-50 #maximal number of iterations in curvilinear search algorithm
##initailaize true covariancematrix of X
Sig<-mat.or.vec(dim,dim)
for (i in 1:dim){
for (j in 1:dim){
Sig[i,j]<-sigma^abs(i-j)
}
}
Sroot<-chol(Sig)
M1_JASA<-mat.or.vec(m,8)
colnames(M1_JASA)<-c('CVE1','CVE2','CVE3','meanMAVE','csMAVE','phd','sir','save')
#link function for M1
fM1<-function(x){return(x[1]/(0.5+(x[2]+1.5)^2))}
for (i in 1:m){
#generate dat according to M1
dat<-creat_sample_nor_nonstand(b,N,fM1,t(Sroot),sigma)
#est sample covariance matrix
Sig_est<-est_varmat(dat[,-1])
#est trace of sample covariance matrix
tr<-var_tr(Sig_est)
#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
M1_JASA[i,1]<-subspace_dist(CVE1$est_base[,1:truedim],b)
M1_JASA[i,2]<-subspace_dist(CVE2$est_base[,1:truedim],b)
M1_JASA[i,3]<-subspace_dist(CVE3$est_base[,1:truedim],b)
#meanMAVE
mod_t2<-mave(Y~.,data=as.data.frame(dat),method = 'meanMAVE')
M1_JASA[i,4]<-subspace_dist(mod_t2$dir[[truedim]],b)
#csMAVE
mod_t<-mave(Y~.,data=as.data.frame(dat),method = 'csMAVE')
M1_JASA[i,5]<-subspace_dist(mod_t$dir[[truedim]],b)
#phd
test4<-summary(dr(Y~.,data=as.data.frame(dat),method='phdy',numdir=truedim+1))
M1_JASA[i,6]<-subspace_dist(orth(test4$evectors[,1:truedim]),b)
#sir
test5<-summary(dr(Y~.,data=as.data.frame(dat),method='sir',numdir=truedim+1))
M1_JASA[i,7]<-subspace_dist(orth(test5$evectors[,1:truedim]),b)
#save
test3<-summary(dr(Y~.,data=as.data.frame(dat),method='save',numdir=truedim+1))
M1_JASA[i,8]<-subspace_dist(orth(test3$evectors[,1:truedim]),b)
print(paste(i,paste('/',m)))
}
boxplot(M1_JASA[,]/sqrt(2*truedim),names=colnames(M1_JASA),ylab='err',main='M1')
summary(M1_JASA[,])