.packageName <- "pcot2"
"Cor" <-
function(x, ind1, ind2){
  dat.n <- x[,ind1]
  dat.d <- x[,ind2]
  nn <- length(ind1)
  nd <- length(ind2) 
  SN <- var(t(dat.n))
  SD <- var(t(dat.d))
  S <- ((nd-1)*SD + (nn-1)*SN)/(nd+nn-2)
  return(cov2cor(S))
}

"aveExprs" <-
function(x, ind.cla, subgene){
  subx <- x[match(subgene, rownames(x)),ind.cla]
  return(rowMeans(subx))
}

"aveProbe" <-
function(x, imat=NULL, ids){
  if (!setequal(rownames(x), names(ids))) cat("Warnings: The names of identifiers should be matched up with the names of probes in the data", "\n")
  if (is.list(ids)) cat("Warnings: The variable ids should be converted to a vector", "\n")
  uu <- unique(ids);  uu <- uu[!is.na(uu)]   
  if (is.null(imat)){
    newx <- matrix(0, nrow=length(uu), ncol=ncol(x))
    rownames(newx) <- uu; colnames(newx) <- colnames(x)
    for (i in 1:length(uu)){
      ind <- which(uu[i]==ids)
      if (length(ind)==1) newx[i,] <- x[ind,] else newx[i,] <- apply(x[ind,],2,median)}
    list(newx=newx)}
  else{
    newx <- matrix(0, nrow=length(uu), ncol=ncol(x))
    newimat <- matrix(0, nrow=length(uu), ncol=ncol(imat))
    rownames(newx) <- rownames(newimat) <- uu
    colnames(newx) <- colnames(x); colnames(newimat) <- colnames(imat)    
    for (i in 1:length(uu)){
      ind <- which(uu[i]==ids)
      if (length(ind)==1) newx[i,] <- x[ind,] else newx[i,] <- apply(x[ind,],2,median)
      if (length(ind)==1) newimat[i,] <- imat[ind,] else newimat[i,] <- apply(imat[ind,],2,median)}
    list(newx=newx, newimat=newimat)}
}

"corplot" <-
function(x, sel, cla=NULL, inputP=NULL, main, gene.locator=FALSE, add.name=TRUE, font.size=1, dist.method="euclidean"){
  if (!is.null(cla)) clab <- cla else clab <- colnames(x)
  if(length(levels(as.factor(clab)))!=2) stop("The 'class' argument may only have two levels")
  lab <- levels(as.factor(clab)); lab1 <- lab[1]; lab2 <- lab[2]
  ind1 <- which(clab==lab1); ind2 <- which(clab==lab2)

  mat <- x[match(sel,rownames(x)),]
  rr <- Cor(mat, ind1, ind2)
  d <- Dist(rr, method=dist.method)
  hc<-hclust(d,"ave")
  ord<-hc$order
  lname <- hc$label[ord]
  av1 <- aveExprs(mat, ind1, lname)
  av2 <- aveExprs(mat, ind2, lname)
  av3 <- av1-av2

  range.x <- range(x)  
  dif <- rowMeans(x[,ind1])-rowMeans(x[,ind2])
  range.dif <- c(-max(abs(dif)), max(abs(dif)))

  if (!gene.locator) plotCor(rr[ord,ord], inputP, av1, av2, av3, range.x, range.dif, labels=lname, main=main, add.name=add.name, font.size=font.size) else {
    out <- geneLocator(x=rr[ord,ord],main=main)
    cat("You have chosen", length(out), "genes", "\n")
    return(out)}
}

"corplot2" <-
function(x, sel, cla=NULL, inputP=NULL, main, gene.locator=FALSE, add.name=TRUE, font.size=1, dist.method="euclidean"){

    lab <- levels(as.factor(cla)); lab1 <- lab[1]; lab2 <- lab[2]
    ind1 <- which(cla==lab1); ind2 <- which(cla==lab2)
    library(amap)
    mm.cor<- max(c(cor(t(x[match(sel, rownames(x)),ind1])),cor(t(x[match(sel, rownames(x)),ind2]))))
    
  if (!gene.locator){
    if (!is.null(inputP)) layout(matrix(c(14,1,3,11,14,5,8,12,14,7,10,12,14,6,9,12,14,4,2,13),4,5), heights=c(0.8,5,5,1), widths=c(4,0.3,0.6,0.3,4)) else if (add.name) layout(matrix(c(14,1,3,11,14,5,8,12,14,7,10,12,14,6,9,12,14,4,2,13),4,5), heights=c(0.8,5,5,1), widths=c(4,0.3,0.5,0.3,4)) else layout(matrix(c(14,1,3,11,14,5,8,12,14,7,10,12,14,6,9,12,14,4,2,13),4,5), heights=c(0.8,5,5,1), widths=c(4,0.3,0.3,0.3,4))
    
    nrgcols <- 15
    par(tcl=0.4)
    
    #1:ClassI
    par(mar=c(1,3,1,1),mgp=c(1,0,0))
    rr <- cor(t(x[match(sel, rownames(x)),ind1]))
    hc <- hclust(Dist(rr, method=dist.method),"ave")
    ord1<-hc$order
    rr.ord <- rr[ord1, ord1]; n <- ncol(rr.ord)
    image(1:n, 1:n, rr.ord[,n:1], col = rb(nrgcols), axes = FALSE, xlab = "", ylab = paste("Ordered by genes in Class",lab1), zlim=c(-mm.cor, mm.cor), main=paste("Class", lab1))

    #2:ClassIV
    par(mar=c(1,1,1,3),mgp=c(0,0,0))
    rr <- cor(t(x[match(sel, rownames(x)),ind2]))
    hc <- hclust(Dist(rr, method=dist.method),"ave")
    ord2<-hc$order
    rr.ord <- rr[ord2, ord2]; n <- ncol(rr.ord)
    image(1:n, 1:n, rr.ord[,n:1], col = rb(nrgcols), axes = FALSE, xlab = "", ylab = "", zlim=c(-mm.cor, mm.cor), main=paste("Class", lab2))

    #3:ClassI, ordered by genes in ClassIV
    par(mar=c(1,3,1,1),mgp=c(1,0,0))
    rr <- cor(t(x[match(sel, rownames(x)),ind1]))
    hc <- hclust(Dist(rr, method=dist.method),"ave")
    rr.ord <- rr[ord2, ord2]; n <- ncol(rr.ord)
    image(1:n, 1:n, rr.ord[,n:1], col = rb(nrgcols), axes = FALSE, xlab = "", ylab = paste("Ordered by genes in Class",lab2), zlim=c(-mm.cor, mm.cor), main=paste("Class", lab1))

    #4:ClassIV, ordered by genes in ClassI
    par(mar=c(1,1,1,3),mgp=c(0,0,0))
    rr <- cor(t(x[match(sel, rownames(x)),ind2]))
    hc <- hclust(Dist(rr, method=dist.method),"ave")
    rr.ord <- rr[ord1, ord1]; n <- ncol(rr.ord)
    image(1:n, 1:n, rr.ord[,n:1], col = rb(nrgcols), axes = FALSE, xlab = "", ylab = "", zlim=c(-mm.cor, mm.cor), main=paste("Class", lab2))

    #5:average expression profiles in ClassI, ordered by ClassI
    par(mar=c(1,0,1,1.5),mgp=c(0,0,0))
    range.x <- range(x)
    av1 <- t(rowMeans(x[match(hc$label[ord1], rownames(x)),ind1])[n:1])
    image(1:1, 1:n, as.matrix(av1), col = wb(nrgcols), axes = FALSE, xlab = "", ylab = "", zlim=range.x)
    title(paste("",lab1, sep=""))
    box(col="black")

    #6:average expression profiles in ClassIV, ordered by ClassI
    par(mar=c(1,1.5,1,0),mgp=c(0,0,0))
    av2 <- t(rowMeans(x[match(hc$label[ord1], rownames(x)),ind2])[n:1])
    image(1:1, 1:n, as.matrix(av2), col = wb(nrgcols), axes = FALSE, xlab = "", ylab = "", zlim=range.x)
    title(paste("",lab2, sep=""))
    box(col="black")

    #7:Difference, ordered by classI
    av3 <- av1-av2
    dif <- rowMeans(x[,ind1])-rowMeans(x[,ind2])  #difference for all the genes
    range.dif <- c(-max(abs(dif)), max(abs(dif)))  
    if(!is.null(inputP)){
       if (add.name) {
         par(mar=c(1,4,1,1),mgp=c(1,0.5,0))
         image(1:1, 1:n, as.matrix(av3), col = rg(nrgcols), axes = FALSE, xlab = "", ylab = "", zlim=range.dif)
         axis(2, at = n:1, labels = hc$label[ord1], las = 2, cex.axis = 0.5, col.axis = 1, cex=.1, cex.axis=font.size)} else {
           par(mar=c(1,0,1,1),mgp=c(1,0.5,0))
           image(1:1, 1:n, as.matrix(av3), col = rg(nrgcols), axes = FALSE, xlab = "", ylab = "", zlim=range.dif)}       
       axis(4, at = n:1, labels = inputP[match(hc$label[ord1],names(inputP))], las = 2, cex.axis = 0.5, col.axis = 1, cex=.1, cex.axis=font.size)
       ii <- which(inputP[match(hc$label[ord1],names(inputP))]<=0.05)
       if(length(ii)!=0) axis(4, at = length(hc$label)+1-ii, labels = inputP[match(hc$label[ord1],names(inputP))][ii], las = 2, cex.axis = 0.5, col.axis = "red", cex=.1, col="red", cex.axis=font.size)} else if (add.name){
         par(mar=c(1,4,1,0),mgp=c(1,0.5,0))
         image(1:1, 1:n, as.matrix(av3), col = rg(nrgcols), axes = FALSE, xlab = "", ylab = "", zlim=range.dif)
         axis(2, at = n:1, labels = hc$label[ord1], las = 2, cex.axis = 0.5, col.axis = 1, cex=.1, cex.axis=font.size)
       } else {
         par(mar=c(1,0,1,0),mgp=c(1,0.5,0))
         image(1:1, 1:n, as.matrix(av3), col = rg(nrgcols), axes = FALSE, xlab = "", ylab = "", zlim=range.dif)
       }   
    title(paste(lab1, "-", lab2, sep=""))
    box(col="black")

    #8:average expression profiles in ClassI, ordered by ClassIV
    par(mar=c(1,0,1,1.5),mgp=c(0,0,0))
    av1 <- t(rowMeans(x[match(hc$label[ord2], rownames(x)),ind1])[n:1])
    image(1:1, 1:n, as.matrix(av1), col = wb(nrgcols), axes = FALSE, xlab = "", ylab = "", zlim=range.x)
    box(col="black")

    #9:average expression profiles in ClassIV, ordered by ClassIV
    par(mar=c(1,1.5,1,0),mgp=c(0,0,0))
    av2 <- t(rowMeans(x[match(hc$label[ord2], rownames(x)),ind2])[n:1])
    image(1:1, 1:n, as.matrix(av2), col = wb(nrgcols), axes = FALSE, xlab = "", ylab = "", zlim=range.x)
    box(col="black")

    #10:Difference, ordered by classIV
    av3 <- av1-av2  
    if(!is.null(inputP)){
       if (add.name){
         par(mar=c(1,4,1,1),mgp=c(1,0.5,0))
         image(1:1, 1:n, as.matrix(av3), col = rg(nrgcols), axes = FALSE, xlab = "", ylab = "", zlim=range.dif)
         axis(2, at = n:1, labels = hc$label[ord2], las = 2, cex.axis = 0.5, col.axis = 1, cex=.1, cex.axis=font.size)} else {
           par(mar=c(1,0,1,1),mgp=c(1,0.5,0))
           image(1:1, 1:n, as.matrix(av3), col = rg(nrgcols), axes = FALSE, xlab = "", ylab = "", zlim=range.dif)}
       axis(4, at = n:1, labels = inputP[match(hc$label[ord2],names(inputP))], las = 2, cex.axis = 0.5, col.axis = 1, cex=.1, cex.axis=font.size)
       ii <- which(inputP[match(hc$label[ord2],names(inputP))]<=0.05)
       if(length(ii)!=0) axis(4, at = length(hc$label)+1-ii, labels = inputP[match(hc$label[ord2],names(inputP))][ii], las = 2, cex.axis = 0.5, col.axis = "red", cex=.1, col="red", cex.axis=font.size)
    } else if (add.name){
         par(mar=c(1,4,1,0),mgp=c(1,0.5,0))
         image(1:1, 1:n, as.matrix(av3), col = rg(nrgcols), axes = FALSE, xlab = "", ylab = "", zlim=range.dif)
         axis(2, at = n:1, labels = hc$label[ord2], las = 2, cex.axis = 0.5, col.axis = 1, cex=.1, cex.axis=font.size)
       } else {
         par(mar=c(1,0,1,0),mgp=c(1,0.5,0))
         image(1:1, 1:n, as.matrix(av3), col = rg(nrgcols), axes = FALSE, xlab = "", ylab = "", zlim=range.dif)
       }
    box(col="black")

    #11: color key (grey)
    par(mar=c(3,3,1,1),mgp=c(1,0.5,0))
    image(1:nrgcols, 1:1,  as.matrix(round(seq(min(range.x), max(range.x), len=nrgcols),1)), col = wb(nrgcols),axes = FALSE, xlab="", ylab = "")
    axis(1, at = 1:nrgcols, labels = round(seq(min(range.x), max(range.x), len=nrgcols),1), las = 1, cex.axis = 0.5, col.axis = 1, cex=.1, cex.axis=font.size)
    box(col="black")

    #12: color key (red-green)
    par(mar=c(3,0,1,0),mgp=c(1,0.5,0))
    image(1:nrgcols, 1:1, as.matrix(round(seq(min(range.dif),max(range.dif), len=nrgcols),1)), col = rg(nrgcols), axes = FALSE, xlab="", ylab = "")
    axis(1, at = 1:nrgcols, labels = round(seq(min(range.dif),max(range.dif), len=nrgcols),1), las = 1, cex.axis = 0.5, col.axis = 1, cex=.1, cex.axis=font.size)
    box(col="black")

    #13: color key (red-blue)
    par(mar=c(3,1,1,2),mgp=c(1,0.5,0))
    image(1:nrgcols,1:1, as.matrix(round(seq(-mm.cor,mm.cor, len=nrgcols),1)), col = rb(nrgcols),axes = FALSE, xlab="", ylab = "")
    axis(1, at = 1:nrgcols, labels = round(seq(-mm.cor,mm.cor,len=nrgcols),1), las = 1, cex.axis = 0.5, col.axis = 1, cex=.1, cex.axis=font.size)
    box(col="black")

    #14: title of the whole plot
    plot.new()
    par(mar=c(0,3,3,3),mgp=c(1,0,0))
    title(main = list(main, cex=1.8, col="Black", font=2))
  }
  if (gene.locator){
    ### In Class1
    rr <- cor(t(x[match(sel, rownames(x)),ind1]))
    hc <- hclust(Dist(rr, method=dist.method),"ave")
    ord1<-hc$order
    rr.ord <- rr[ord1, ord1]
    out1 <- geneLocator(rr.ord,main=paste(main,"---Class", lab1, sep=""))
    
    ### In Class2
    rr <- cor(t(x[match(sel, rownames(x)),ind2]))
    hc <- hclust(Dist(rr, method=dist.method),"ave")
    ord2<-hc$order
    rr.ord <- rr[ord2, ord2]
    out2 <- geneLocator(rr.ord,main=paste(main,"---Class", lab2, sep=""))

    cat("You have chosen", length(out1), "genes in", paste("Class", lab1, sep=""), "\n")
    cat("You have chosen", length(out2), "genes in", paste("Class", lab2, sep=""), "\n")
    list(out1=out1, out2=out2)
  }
  }

"geneLocator" <-
function(x,nrgcols=15,main=main){
  n <- ncol(x)
  ids <- colnames(x)
  plot.new() 
  par(mar=c(4,3,3,3),mgp=c(1,0,0))
  image(1:n, 1:n, x[,n:1], col = rb(nrgcols), axes = FALSE, xlab = "", ylab = "", zlim=c(-max(x), max(x)))
  title(main=main)
  axis(1, at = 1:n, labels = ids, las = 2, cex.axis = 0.5, col.axis = 1, cex=.1) 
  aa <- round(locator(2, type="n")$x)
  return(ids[aa[1]:aa[2]])
}

"getImat" <-
function(x, pathlist, ms=10){
  gname1 <- rownames(x); gname2 <- names(pathlist)
  gname <- intersect(gname1, gname2)
  if (is.na(gname[1])) stop("The row (gene) names of the data matrix do not match the names in the 'pathlist' argument")
  gset <- unique(unlist(pathlist))
  pname <- gset[!is.na(gset)]
  imat <- matrix(0, nrow=length(gname), ncol=length(pname))

  for (i in 1:length(gname)){
    ind <- match(gname[i],gname2)
    if(!is.na(pathlist[[ind]][1])) imat[i,match(pathlist[[ind]], pname)] <- 1
  }
  dimnames(imat) <- list(gname, pname)
  imat <- imat[,colSums(imat)>=ms]
  return(imat)
}

"pco" <-
function(x,ncomp,dist.method){
  d <- Dist(t(x),method=dist.method)
  pco <- cmdscale(d, k=ncomp, eig=TRUE)
  newx <- pco$points 
  return(newx)
}

"pcot2" <-
function(emat, class=NULL, imat, permu="ByColumn", iter=1000, alpha=0.05, adjP.method="BY", var.equal=TRUE, ncomp=2, dist.method="euclidean"){
   if (!is.null(class)) cla <- class else cla <- colnames(emat)
   if (length(cla)!=ncol(emat)) stop("The length of the 'class' argument must equal the number of columns (samples) in the 'emat' (expression matrix) argument")
   if (length(levels(as.factor(cla)))!=2) stop("The 'class' argument may only have two levels")
   lab <- levels(as.factor(cla)); lab1 <- lab[1]; lab2 <- lab[2]; lab.print <- paste("Comparison: ", lab1, "-", lab2, sep="")
   ind1 <- which(cla==lab1); ind2 <- which(cla==lab2)
    
   npath <- ncol(imat)
   num <- colSums(imat)
   tstat <- p.nor <- double(npath)

   for (i in 1:npath){
    dat <- emat[as.logical(imat[,i]),]
    newdat <- pco(dat, ncomp,dist.method)
    if (var.equal){
      output <- t2(x=newdat,ind1,ind2)
      tstat[i] <- output[1]
      p.nor[i] <- output[2]} else tstat[i] <- t2.unequ(newdat,ind1,ind2)
  }
   if(var.equal) p.adj <- p.adjust(p.nor, adjP.method)
   p.per <- t2.permu(emat,imat,tstat,ind1,ind2,permu,iter,ncomp,dist.method)
   p.per.adj <- p.adjust(p.per, adjP.method)

   if(var.equal) res <- data.frame(Num=num, T2=tstat, P.nor=p.nor, P.adj=p.adj, P.permu=p.per, P.permu.adj=p.per.adj) else res <- data.frame(Num=num, T2=tstat, P.permu=p.per, P.permu.adj=p.per.adj)
   res.all <- res[order(p.per),]                
   res.sig <- res.all[res.all$P.permu<=alpha,]
   cat(lab.print,"\n")
   list(res.all=res.all, res.sig=res.sig)
 }

"plotCor" <-
function(x, inputP, av1, av2, av3, range.x, range.dif, nrgcols = 15, labels = FALSE, labcols = 1,main, add.name, font.size, ...){
    par(tcl=0.4)
    n <- ncol(x)
    if (!is.null(inputP)) layout(matrix(c(1:4,4,5,5,5,6,7),5,2), heights=c(1.3,1,3, 5,5), widths=c(12,1)) else if (add.name) layout(matrix(c(1:4,4,5,5,5,6,7),5,2), heights=c(1.5,1,2.5,5,5), widths=c(12,1)) else  layout(matrix(c(1:4,4,5,5,5,6,7),5,2), heights=c(1.5,1,1,5,5), widths=c(12,1)) 

    mm.cor <- max(x)
    
    #1
    if (!is.null(inputP)) par(mar=c(1,3,1.5,1),mgp=c(1,0,0)) else par(mar=c(1,3,2.5,1),mgp=c(1,0,0))
    image(1:n, 1:1, as.matrix(av1), col = wb(nrgcols), axes = FALSE, xlab = "", ylab = "A(a)", zlim=range.x)
    title(main = main)
    box(col="black")
    #2
    par(mar=c(1,3,0,1),mgp=c(1,0,0))
    image(1:n, 1:1, as.matrix(av2), col = wb(nrgcols), axes = FALSE, xlab = "", ylab = "A(b)", zlim=range.x)
    box(col="black")
    #3
    if (!is.null(inputP)){
      pvalues <- round(inputP, digits=2)
      ids <- names(inputP)
      if (add.name){
        par(mar=c(7,3,2,1),mgp=c(1,0.5,0))
        image(1:n, 3:3, as.matrix(av3), col = rg(nrgcols), axes = FALSE, xlab = "", ylab = "B", zlim=range.dif)
        axis(1, at = 1:n, labels = labels, las = 2, cex.axis = 0.5, col.axis = labcols, cex=.1, cex.axis=font.size)} else {
          par(mar=c(1,3,2,1),mgp=c(1,0.5,0))
          image(1:n, 3:3, as.matrix(av3), col = rg(nrgcols), axes = FALSE, xlab = "", ylab = "B", zlim=range.dif)}
      axis(3, at = 1:n, labels = pvalues[match(labels, ids)], las = 2, cex.axis = 0.5, col.axis = labcols, cex=.1, cex.axis=font.size)  #adding limma pvalues
      ii <- which(pvalues[match(labels, ids)]<=0.05)
      axis(3, at = ii, labels = pvalues[match(labels, ids)][ii], las = 2, cex.axis = 0.5, col.axis = "red", cex=.1, col="red", cex.axis=font.size)  #sig pvalues
    } else if (add.name){
        par(mar=c(7,3,0,1),mgp=c(1,0.5,0))
        image(1:n, 1:1, as.matrix(av3), col = rg(nrgcols), axes = FALSE, xlab = "", ylab = "B", zlim=range.dif)
        axis(1, at = 1:n, labels = labels, las = 2, cex.axis = 0.5, col.axis = labcols, cex=.1, cex.axis=font.size)
      } else {
          par(mar=c(1,3,0,1),mgp=c(1,0.5,0))
          image(1:n, 1:1, as.matrix(av3), col = rg(nrgcols), axes = FALSE, xlab = "", ylab = "B", zlim=range.dif)
        }
    box(col="black")
    #4
    par(mar=c(1,3,0,1),mgp=c(1,0,0))
    image(1:n, 1:n, x[,n:1], col = rb(nrgcols), axes = FALSE, xlab = "", ylab = "C", zlim=c(-mm.cor, mm.cor))
    box(col="black")

    ### color scale panel ###
    #5
    par(mar=c(1,2,2.5,3),mgp=c(1,0.5,0))
    image(1:1, 1:nrgcols, t(as.matrix(round(seq(min(range.x), max(range.x), len=nrgcols),1))), ylab = "A", col = wb(nrgcols), axes = FALSE)
    title(main = "Color Key")
    axis(4, at = 1:nrgcols, labels = round(seq(min(range.x), max(range.x), len=nrgcols),1), las = 2, cex.axis = 0.5, col.axis = labcols, cex=.1, cex.axis=font.size)
    box(col="black")
    #6
    par(mar=c(1,2,1,3),mgp=c(1,0.5,0))
    image(1:1, 1:nrgcols, t(as.matrix(round(seq(min(range.dif),max(range.dif), len=nrgcols),1))), ylab = "B", col = rg(nrgcols), axes = FALSE)
    axis(4, at = 1:nrgcols, labels = round(seq(min(range.dif),max(range.dif), len=nrgcols),1), las = 2, cex.axis = 0.5, col.axis = labcols, cex=.1, cex.axis=font.size)
    box(col="black")
    #7
    par(mar=c(2,2,1,3),mgp=c(1,0.5,0))
    image(1:1, 1:nrgcols, t(as.matrix(round(seq(-mm.cor,mm.cor, len=nrgcols),1))), col = rb(nrgcols), ylab = "C", xlab="", axes = FALSE)
    axis(4, at = 1:nrgcols, labels = round(seq(-mm.cor,mm.cor,len=nrgcols),1), las = 2, cex.axis = 0.5, col.axis = labcols, cex=.1, cex.axis=font.size)
    box(col="black")
    
  }

"rb" <-
function(n) c(rgb(0,0,seq(3,0,l=n)/3),rgb(1-seq(3,0,l=n)/3,0,0))

"rg" <-
function(n) c(rgb(0,sqrt(1-dnorm(seq(3,0,l=n))/dnorm(0)),0),rgb(sqrt(1-dnorm(seq(0,3,l=n))/dnorm(0)),0,0))

"t2" <-
function(x, ind1, ind2){
  dat1 <- x[ind1,]
  dat2 <- x[ind2,]
  nn <- length(ind1)
  nd <- length(ind2) 
  SN <- var(dat1)
  SD <- var(dat2)
  S <- ((nd-1)*SD + (nn-1)*SN)/(nd+nn-2)

  xbar1 <- colMeans(dat1)
  xbar2 <- colMeans(dat2)
  xdiff <- xbar1 - xbar2

  t2 <- ((nd*nn)/(nd+nn))*(xdiff %*% solve(S) %*% xdiff)
  p <- length(xdiff)
  f <- (nd+nn-p-1)*t2/((nd+nn-2)*p)
  pvalue <- 1-pf(f,p, nd+nn-p-1)
  return(cbind(t2, pvalue))  
}

"t2.permu" <-
function(x,imat,tstat,ind1,ind2,permu,iter,ncomp,dist.method){
  npath <- ncol(imat)
  tmat <- matrix(0, nrow=iter, ncol=npath)
  
  for (k in 1:iter){
    if (trunc(k/50) == k/50) cat("iter=", k, "\n")
    if (permu=="ByColumn"){
      nn <- ncol(x)
      newD <- x[,sample(1:nn,nn)]}
    if (permu=="ByRow"){
      nn <- nrow(x)
      newD <- x[sample(1:nn,nn),]}
    
    dimnames(newD) <- dimnames(x)
    
    for (i in 1:npath){
      dat <- newD[as.logical(imat[,i]),]
      newdat <- pco(dat,ncomp,dist.method)
      tmat[k,i] <- t2(newdat,ind1,ind2)[1]
    }
  }
  
  p.per <- double(npath)
  for (i in 1:npath)
    p.per[i] <- (sum(abs(tmat[-1,i])>=abs(tstat[i]))+1)/iter
  return(p.per)
}

"t2.unequ" <-
function(x, ind1, ind2){
  dat1 <- x[ind1,]
  dat2 <- x[ind2,]
  nn <- length(ind1)
  nd <- length(ind2) 
  SN <- var(dat1)
  SD <- var(dat2)
  S <- SD/nd + SN/nn

  xbar1 <- colMeans(dat1)
  xbar2 <- colMeans(dat2)
  xdiff <- xbar1 - xbar2
  t2 <- xdiff %*% solve(S) %*% xdiff
  return(t2)
}

"wb" <-
function(n) c(rgb(0,0,0), rgb(sqrt(1-dnorm(seq(0,3,l=n))/dnorm(0)),sqrt(1-dnorm(seq(0,3,l=n))/dnorm(0)),sqrt(1-dnorm(seq(0,3,l=n))/dnorm(0))))

