User Tools

Site Tools


lab:projects:02robust_growth_curve_modeling_using_student-t_distribution:r_codes_to_process_the_coda_files

2010 Sep 20

geweke<-function(x, frac1 = 0.2, frac2 = 0.5){

	xstart <- c(start(x), end(x) - frac2 * (end(x) - start(x)))[c(1,3)]
   xend <- c(start(x) + frac1 * (end(x) - start(x)), end(x))[c(1,3)]

   y.variance <- y.mean <- vector("list", 2)
   for (i in 1:2) {
        y <- window(x, start = xstart[i], end = xend[i])
        y.mean[[i]] <- apply(as.matrix(y), 2, mean)
        y.variance[[i]] <- apply(as.matrix(y), 2, var)
    }
    z <- (y.mean[[1]] - y.mean[[2]])/sqrt(y.variance[[1]] + y.variance[[2]])
    z    
	}

HPD <- function(obj, prob = 0.95, ...)
{
    obj <- as.matrix(obj)
    vals <- apply(obj, 2, sort)
    if (!is.matrix(vals)) stop("obj must have nsamp > 1")
    nsamp <- nrow(vals)
    npar <- ncol(vals)
    gap <- max(1, min(nsamp - 1, round(nsamp * prob)))
    init <- 1:(nsamp - gap)
    inds <- apply(vals[init + gap, ,drop=FALSE] - vals[init, ,drop=FALSE],
                  2, which.min)
    ans <- cbind(vals[cbind(inds, 1:npar)],
                 vals[cbind(inds + gap, 1:npar)])
    ans
}


res<-NULL

stem<-'Tdata'

for (i in 1001:2000){
  codafile<-paste("/pscratch/zzhang4/Private/student-grm/CODA/TdataR/TdataCODAN300I",i,".txt",sep='')
  
  if (file.exists(codafile)){
     codasamp<-read.table(codafile)

     par<-matrix(c(codasamp[,2]),ncol=7)

     gew.max<- max(geweke(par))

     m.par<-apply(par,2,mean)
     sd.par<-apply(par,2,sd)
     p025.par<-apply(par,2,quantile,.025)
     p975.par<-apply(par,2,quantile,.975)
     
     hpd.ci<-c(t(HPD(par)))
     
     par.i<-c(m.par,sd.par,p025.par,p975.par,hpd.ci, gew.max,i)
     
     res<-rbind(res,par.i)
  }
  file.res<-paste('res-Tdata-T-N-300-Wishart.txt', sep='')

}

  write.table(res, file.res) 
  • T model results
## process the results
## 1) convergence diagnostic

## geweke function
geweke<-function(x, frac1 = 0.2, frac2 = 0.5){

	xstart <- c(start(x), end(x) - frac2 * (end(x) - start(x)))[c(1,3)]
   xend <- c(start(x) + frac1 * (end(x) - start(x)), end(x))[c(1,3)]

   y.variance <- y.mean <- vector("list", 2)
   for (i in 1:2) {
        y <- window(x, start = xstart[i], end = xend[i])
        y.mean[[i]] <- apply(as.matrix(y), 2, mean)
        y.variance[[i]] <- apply(as.matrix(y), 2, var)
    }
    z <- (y.mean[[1]] - y.mean[[2]])/sqrt(y.variance[[1]] + y.variance[[2]])
    z    
	}

HPD <- function(obj, prob = 0.95, ...)
{
    obj <- as.matrix(obj)
    vals <- apply(obj, 2, sort)
    if (!is.matrix(vals)) stop("obj must have nsamp > 1")
    nsamp <- nrow(vals)
    npar <- ncol(vals)
    gap <- max(1, min(nsamp - 1, round(nsamp * prob)))
    init <- 1:(nsamp - gap)
    inds <- apply(vals[init + gap, ,drop=FALSE] - vals[init, ,drop=FALSE],
                  2, which.min)
    ans <- cbind(vals[cbind(inds, 1:npar)],
                 vals[cbind(inds + gap, 1:npar)])
    ans
}


res<-NULL

stem<-'Tdata'

for (i in 1001:2000){
  codafile<-paste(stem,"CODAN500I",i,".txt",sep='')
  
  if (file.exists(codafile)){
     codasamp<-read.table(codafile)

     par<-matrix(c(codasamp[,2]),ncol=7)

     gew.max<- max(geweke(par))

     m.par<-apply(par,2,mean)
     sd.par<-apply(par,2,sd)
     p025.par<-apply(par,2,quantile,.025)
     p975.par<-apply(par,2,quantile,.975)
     
     hpd.ci<-c(t(HPD(par)))
     
     par.i<-c(m.par,sd.par,p025.par,p975.par,hpd.ci, gew.max,i)
     
     res<-rbind(res,par.i)
  }
  file.res<-paste('res-',stem,'.txt', sep='')

}

  write.table(res, file.res) 

Normal model results

## process the results
## 1) convergence diagnostic

## geweke function
geweke<-function(x, frac1 = 0.2, frac2 = 0.5){

	xstart <- c(start(x), end(x) - frac2 * (end(x) - start(x)))[c(1,3)]
   xend <- c(start(x) + frac1 * (end(x) - start(x)), end(x))[c(1,3)]

   y.variance <- y.mean <- vector("list", 2)
   for (i in 1:2) {
        y <- window(x, start = xstart[i], end = xend[i])
        y.mean[[i]] <- apply(as.matrix(y), 2, mean)
        y.variance[[i]] <- apply(as.matrix(y), 2, var)
    }
    z <- (y.mean[[1]] - y.mean[[2]])/sqrt(y.variance[[1]] + y.variance[[2]])
    z    
	}

HPD <- function(obj, prob = 0.95, ...)
{
    obj <- as.matrix(obj)
    vals <- apply(obj, 2, sort)
    if (!is.matrix(vals)) stop("obj must have nsamp > 1")
    nsamp <- nrow(vals)
    npar <- ncol(vals)
    gap <- max(1, min(nsamp - 1, round(nsamp * prob)))
    init <- 1:(nsamp - gap)
    inds <- apply(vals[init + gap, ,drop=FALSE] - vals[init, ,drop=FALSE],
                  2, which.min)
    ans <- cbind(vals[cbind(inds, 1:npar)],
                 vals[cbind(inds + gap, 1:npar)])
    ans
}


res<-NULL

stem<-'Tdata'

for (i in 1001:2000){
  
codafile<-paste("/pscratch/zzhang4/Private/student-grm/CODA/Tdata/TdataCODAN400I",i,".txt",sep=''
)
  
  if (file.exists(codafile)){
     codasamp<-read.table(codafile)

     par<-matrix(c(codasamp[,2]),ncol=6)

     gew.max<- max(geweke(par))

     m.par<-apply(par,2,mean)
     sd.par<-apply(par,2,sd)
     p025.par<-apply(par,2,quantile,.025)
     p975.par<-apply(par,2,quantile,.975)
     
     hpd.ci<-c(t(HPD(par)))
     
     par.i<-c(m.par,sd.par,p025.par,p975.par,hpd.ci, gew.max,i)
     
     res<-rbind(res,par.i)
  }
  file.res<-paste('res-Tdata-N-N-400-Uniform.txt', sep='')

}

  write.table(res, file.res) 

Page Tools