65 lines
2.9 KiB
R
65 lines
2.9 KiB
R
|
#initialize model parameters
|
||
|
|
m<-500#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<-42#sample size
|
||
|
|
K<-70#number of arbitrary starting values for curvilinear optimization
|
||
|
|
MAXIT<-50#maximal number of iterations in curvilinear search algorithm
|
||
|
|
|
||
|
|
f_ln1<-function(x){return(2*log(abs(x)+1))}#link function
|
||
|
|
M5_JASA_lowN<-mat.or.vec(m,8)
|
||
|
|
colnames(M5_JASA_lowN)<-c('CVE1','CVE2','CVE3','meanMAVE','csMAVE','phd','sir','save')
|
||
|
|
for (i in 1:m){
|
||
|
|
#generate dat according to M5
|
||
|
|
dat<-creat_sample(b,N,f_ln1,sigma)
|
||
|
|
#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
|
||
|
|
M5_JASA_lowN[i,1]<-subspace_dist(CVE1$est_base[,1:truedim],b)
|
||
|
|
M5_JASA_lowN[i,2]<-subspace_dist(CVE2$est_base[,1:truedim],b)
|
||
|
|
M5_JASA_lowN[i,3]<-subspace_dist(CVE3$est_base[,1:truedim],b)
|
||
|
|
#meanMAVE
|
||
|
|
mod_t2<-mave(Y~.,data=as.data.frame(dat),method = 'meanMAVE')
|
||
|
|
M5_JASA_lowN[i,4]<-subspace_dist(mod_t2$dir[[truedim]],b)
|
||
|
|
#csMAVE
|
||
|
|
mod_t<-mave(Y~.,data=as.data.frame(dat),method = 'csMAVE')
|
||
|
|
M5_JASA_lowN[i,5]<-subspace_dist(mod_t$dir[[truedim]],b)
|
||
|
|
#phd
|
||
|
|
test4<-summary(dr(Y~.,data=as.data.frame(dat),method='phdy',numdir=truedim+1))
|
||
|
|
M5_JASA_lowN[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))
|
||
|
|
M5_JASA_lowN[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))
|
||
|
|
M5_JASA_lowN[i,8]<-subspace_dist(orth(test3$evectors[,1:truedim]),b)
|
||
|
|
|
||
|
|
print(paste(i,paste('/',m)))
|
||
|
|
}
|
||
|
|
boxplot(M5_JASA_lowN[,]/sqrt(2*truedim),names=colnames(M5_JASA_lowN),ylab='err',main='M5')
|
||
|
|
summary(M5_JASA_lowN[,])
|
||
|
|
|
||
|
|
####
|
||
|
|
|
||
|
|
# par(mfrow=c(1,2))
|
||
|
|
# boxplot(M3_JASA_L[,]/sqrt(2*1),names=colnames(M3_JASA_L),ylab='err',main='M3')
|
||
|
|
# boxplot(M5_JASA_lowN[1:100,-c(4,5,6)]/sqrt(2*1),names=colnames(M5_JASA_lowN)[-c(4,5,6)],ylab='err',main='M5')
|
||
|
|
# par(mfrow=c(1,1))
|