.packageName <- "affycomp"
affycomp <- function(d,s,method.name=NULL,verbose=TRUE,return.it=TRUE){
  if(is.null(method.name)) method.name <- "New expression measure"
  l <- assessAll(d,s,method.name=method.name,verbose=verbose)
  data(mas5.assessment)
  affycompPlot(mas5.assessment,l)
  tmp <- affycompTable(mas5.assessment,l)
  print(format(tmp,digits=2))
  if(return.it) return(l)
  else return(NULL)
}
        
assessSpikeIn <- function(s,method.name=NULL,verbose=TRUE){
  if(verbose) cat("Performing 6 assessments that will take a few minutes")
  tmp1 <- assessFC(s,method.name=method.name)
  if(verbose) cat("...")
  tmp2 <- assessFC2(s,method.name=method.name)
  if(verbose) cat(".")
  tmp3 <- assessMA(s,method.name=method.name)
  if(verbose) cat(".")
  tmp4 <- assessSignal(s,method.name=method.name)
  if(verbose) cat(".\n")
  return(list(MA=tmp3,Signal=tmp4,FC=tmp1,FC2=tmp2,what="SpikeIn",
              method.name=method.name))
}

assessAll <- function(d,s,method.name=NULL,verbose=TRUE){
  if(verbose) cat("Performing 9 assessments that will take a few minutes\nWe start with 3 on dilution data")
  tmp1 <- assessDilution(d,method.name=method.name)
  cat("...\n")
  tmp2 <- assessSpikeIn(s,verbose=verbose,method.name=method.name) 
  tmp <- c(Dilution=list(tmp1),tmp2)
  tmp["what"] <- "All"
  return(tmp)
}

assessDilution <- function(exprset,method.name=NULL){
  require(splines,quietly = TRUE)

  e <- exprs(exprset)
  pdata <- pData(exprset)
  ##GET R^2: depends on the right order
  o <- c()
  for(j in 1:12) o <- rbind(o,expand.grid( ( (j-1)*5+1 ):( j*5),( (j-1)*5+1 ):( j*5)))
  o <- o[o[,1]< o[,2],] ##o gives us all replicate pairs
  o <- as.matrix(o)
  rownames(o) <- NULL
  R2 <- apply(o,1,function(x) (cor((e[,x]))[1,2])^2)
  
  ##average per concentration group
  tmp <- cbind(c(1.25,0,2.5,0,5,0,7.5,0,10,0,20,0),
               c(0,1.25,0,2.5,0,5,0,7.5,0,10,0,20))
  m <- apply(tmp,1,function(x){
    o <- which(pdata[,1]==x[1] & pdata[,2]==x[2])
    apply(e[,o],1,mean)
  })
  ##sd per concentration group
  s <- apply(tmp,1,function(x){
    o <- which(pdata[,1]==x[1] & pdata[,2]==x[2])
    apply(e[,o],1,sd)
  })
  
  ##we will "normalize" using the spike-in
  spikedin <- colnames(pdata)[-c(1:2,ncol(pdata))]
  for(j in 1:2){ ##1 is CNS and 2 liver
    Index <- tmp[,j]==0 ##first for liver
    k <- apply(m[spikedin,Index],2,mean) ##these should be the same
    k <- k-mean(k)##so let's make them the same
    m[,Index] <- sweep(m[,Index],2,k)
  }
  
  ##regression coef for each gene for liver and cns. get slope
     
  o <- which(tmp[,1]!=0)
  x <- log2(tmp[o,1])
  x <- x-mean(x)
  x2 <- sum(x^2)
  beta1 <- apply(m[,o],1,function(y) sum((y-mean(y))*x)/x2)##fast regression
  o <- which(tmp[,2]!=0)
  x <- log2(tmp[o,2])
  x <- x-mean(x)
  x2 <- sum(x^2)
  beta2 <- apply(m[,o],1,function(y) sum((y-mean(y))*x)/x2)
  
  ##consistency
  fc1.25 <- m[,1]-m[,2]
  fc20 <- m[,11]-m[,12]
  
  ##things to keep: curves, etc..
  ##sd vs mean plot
  x <- as.vector(m)
  y <- as.vector(s)
  smooth1 <- lm(y~ns(x,7))
  x1 <- sort(x)[seq(1,length(x),length=100)]
  y1 <- smooth1$fitted[order(x)][seq(1,length(x),length=100)]
  ##took out this plot. will keep actual points instead.
  ##beta vs mean plot
  x <- apply(m,1,mean); x <- c(x,x)
  y <- c(beta1,beta2)
  smooth1 <- lm(y~ns(x,7))
  x2 <- sort(x)[seq(1,length(x),length=100)]
  y2 <- smooth1$fitted[order(x)][seq(1,length(x),length=100)]
  
  list(R2=R2,sdplotx=x1,sdploty=y1,slopeplotx=x,slopeploty=y,
       mediansd=median(s),medianbeta=median( c(beta1,beta2)),
       fc1.25=fc1.25,fc20=fc20,
       consitency=cor(fc1.25,fc20)^2,
       two.fold.discrepancy=sum(abs(fc1.25-fc20)>1),
       three.fold.discrepancy=sum(abs(fc1.25-fc20)>log2(3)),
       slopesmoothx=x2,slopesmoothy=y2,what="Dilution",method.name=method.name)
}

assessSignal <- function(exprset,method.name=NULL){
  e <- exprs(exprset)
  pdata <- pData(exprset)
  genenames <- colnames(pdata)
  y <- as.vector(t(e[match(genenames,geneNames(exprset)),]))
  names(y) <- rep(colnames(pdata),nrow(pdata))
  x <- log2(as.vector(as.matrix(pdata)))
  names(x) <- names(y)
  tmp <- tapply(y,x,mean)
  fit1 <- lm(y~x,subset=x>-Inf)
  list(slope=fit1$coef[2],R2=summary(fit1)$r.squared,
       plotx=x,ploty=y,linex=names(tmp),liney=as.numeric(tmp),what="Signal",method.name=method.name)
}

assessFC2 <- function(exprset,method.name=NULL){
  e <- exprs(exprset)
  pdata <- pData(exprset)

  ##this is bad, but works
  if(ncol(e)==59)
    WHICHSPIKEIN <- "HGU95A"
  else{
    if(ncol(e)==42){
      WHICHSPIKEIN <- "HGU133A"
    }
    else
      stop("Not the right number of columns in expression matrix\n")
  }
  


  if(WHICHSPIKEIN=="HGU95A"){
    e <- e[,-grep("2353d99hpp_av08",colnames(e))] ##take d_08 because it has no pair
    o1 <- c(2 ,4 ,6 ,8 ,10,12,17,18,19,20)
    o1 <- c(o1,o1+20,c(42,44,46,48,50,55,56,57)) ##took out 58 and 54.. 54 is bad
    o2 <- c(1,3,5,7, 9,11,13,14,15,16)
    o2 <- c(o2,o2+20,c(41,43,45,47,49,51,52,53))##took out 54.see above
  }
  else{
    o1 <- seq(2,42,2)
    o2 <- seq(1,41,2)
  }
  
  m <- e[,o1]-e[,o2]
  a <- (e[,o1] + e[,o2])/2
  
  fc2 <- apply(m,2,function(x){
    tp <- sum(abs(x[match(colnames(pdata),names(x))]) >= 1) ##true positives
    fp <- sum(abs(x[-match(colnames(pdata),names(x))]) >= 1) ##false positives
    c(fp=fp,tp=tp)
  })
  
  rocs <- apply(m,2,function(x){
    x <- sort(-abs(x))
    y <- rep(0,length(x))
    y[match(colnames(pdata),names(x))] <- 1
    return(cumsum(y)) ##this is number of true positive
  })
  tp <- apply(rocs,1,mean)
  fp <- seq(along=tp)-tp ##total calls minus true positives
  
  N <- ncol(pdata)
  return(list(fc2=t(fc2),m=m,a=a,fp=fp,tp=tp,
              area=c(a10=mean(tp[fp<10]/N),
                a15=mean(tp[fp<15]/N),
                a25=mean(tp[fp<25]/N),
                a100=mean(tp[fp<100]/N)),what="FC2",method.name=method.name))
}
  

assessFC <- function(exprset,method.name=NULL){
  e <- exprs(exprset)
  pdata <- pData(exprset)

  ##this is not good but works..
  if(ncol(e)==59)
    WHICHSPIKEIN <- "HGU95A"
  else{
    if(ncol(e)==42)
      WHICHSPIKEIN <- "HGU133A"
    else
      stop("Not the right number of columns in expression matrix\n")
  }

  
  genenames <- colnames(pdata)
  N <- length(genenames)
  M <- nrow(e) - N
  intended <- array(0,dim=c(570,N,2)) ##570 is a maximum.. later reduced
  observed <- matrix(0,570,N)
  fc2 <- matrix(0,570,2)
  probs <- c(0,25/M,100/M,.25,.75,1-100/M,1-25/M,1)
  quantiles <- matrix(0,570,length(probs))
  pdata <- as.matrix(pdata)
  spikeindex <- match(genenames,rownames(e))
  roc <- vector(mode="numeric",length=nrow(e))
  Count <- 0

  if(WHICHSPIKEIN=="HGU95A") J <- 20 else J <- 14
  for(i in 1:(J-1)){
    for(j in (i+1):J){
      i1 <- pdata[i,]
      i2 <- pdata[j,]
      if(!all(i1-i2==0)){ ##if not reps lets do it
        Count <- Count + 1
        intended[Count,,1] <- i1
        intended[Count,,2] <- i2
        m <- e[,j]-e[,i]
        quantiles[Count,] <- quantile(m[-spikeindex],prob=probs)
        fc2[Count,1] <- sum(abs(m[-spikeindex]) >= 1) 
        fc2[Count,2] <- sum(abs(m[spikeindex]) >= 1) 
        observed[Count,] <- m[genenames]
        m <- sort(-abs(m))
        y <- rep(0,length(m))
        y[match(genenames,names(m))] <- 1
        roc <- roc + cumsum(y) ##this is number of true positive
      }
    }
  }

  
  for(i in (J+1):(2*J-1)){
    for(j in (i+1):(2*J)){
      i1 <- pdata[i,]
      i2 <- pdata[j,]
      if(!all(i1-i2==0)){ ##if not reps lets do it
        Count <- Count + 1
        intended[Count,,1] <- i1
        intended[Count,,2] <- i2
        m <- e[,j]-e[,i]
        quantiles[Count,] <- quantile(m[-spikeindex],prob=probs)
        fc2[Count,1] <- sum(abs(m[-spikeindex]) >= 1) 
        fc2[Count,2] <- sum(abs(m[spikeindex]) >= 1) 
        observed[Count,] <- m[genenames]
        m <- sort(-abs(m))
        y <- rep(0,length(m))
        y[match(genenames,names(m))] <- 1
        roc <- roc + cumsum(y) ##this is number of true positive
      }
    }
  }

  if(WHICHSPIKEIN=="HGU95A"){
    J1 <- 41; J2 <- 58
  }
  else{
    J1 <- 29; J2 <- 42
  }

  for(i in J1:(J2-1)){
    for(j in (i+1):J2){
      i1 <- pdata[i,]
      i2 <- pdata[j,]
      if(!all(i1-i2==0) & i!=54 & j!=54){ ##if not reps lets do it
        Count <- Count + 1
        intended[Count,,1] <- i1
        intended[Count,,2] <- i2
        m <- e[,j]-e[,i]
        quantiles[Count,] <- quantile(m[-spikeindex],prob=probs)
        fc2[Count,1] <- sum(abs(m[-spikeindex]) >= 1) 
        fc2[Count,2] <- sum(abs(m[spikeindex]) >= 1) 
        observed[Count,] <- m[genenames]
        m <- sort(-abs(m))
        y <- rep(0,length(m))
        y[match(genenames,names(m))] <- 1
        roc <- roc + cumsum(y) ##this is number of true positive
      }
    }
  }
  
  intended <- intended[1:Count,,]
  observed <- observed[1:Count,]
  fc2 <- fc2[1:Count,]
  quantiles <- quantiles[1:Count,]
  quantiles <- apply(quantiles,2,mean)
  tp <- roc/Count
  fp <- seq(along=tp)-tp ##total calls minus true positives

  colnames(observed) <- genenames
  dimnames(intended) <- list(NULL,genenames,NULL)
  names(quantiles) <- c("lowest","lowest25","lowest100","25",
                     "75","highest100","highest25","highest")
  

  intended.log.ratios <- log2(intended[,,2]/intended[,,1])
  x <- as.vector(intended.log.ratios)
  y <- as.vector(observed)
  Index <- as.vector(intended[,,2])<=2 & as.vector(intended[,,1])<=2 &
  as.vector(intended[,,2])>0 & as.vector(intended[,,1])>0 ##small signal
  
  N <- ncol(pdata)
  list(signal=intended,
       intended.log.ratios=intended.log.ratios,
       observed.log.ratios=observed,
       quantiles=quantiles,
       fc2=fc2,
       tp=tp,fp=fp,
       area=c(a10=mean(tp[fp<10]/N),
         a15=mean(tp[fp<15]/N),
         a25=mean(tp[fp<25]/N),
         a100=mean(tp[fp<100]/N)),
       slope=lm(y~x,subset=abs(x)<Inf)$coef[2],
       low.signal.slope= lm(y~x,subset=Index)$coef[2],
       index.low.signal=Index,what="FC",method.name=method.name)
}


assessMA<- function(exprset,method.name=NULL){
  e <- exprs(exprset)
  pdata <- pData(exprset)

  if(ncol(e)==59)
    WHICHSPIKEIN <- "HGU95A"
  else{
    if(ncol(e)==42)
      WHICHSPIKEIN <- "HGU133A"
    else
      stop("Not the right number of columns in expression matrix\n")
  }
  
  N <- nrow(e)
  genenames <- colnames(pdata)
  spikeindex <- match(genenames,rownames(e))
  M <- length(genenames)
  
  thearray <- 1
  if(WHICHSPIKEIN=="HGU95A"){
    thearray <- 1
    otherarrays <-  c(2:12,13,17)
  }
  else{
    thearray <- 1
    otherarrays <- 2:14#c(1:4,6:14)
  }
  L <- length(otherarrays)
  m <- matrix(0,N,L)
  a <- matrix(0,N,L)
  intended <- matrix(0,M,L)

  for(i in 1:L){
    m[,i] <- e[,otherarrays[i]] - e[,thearray]
    a[,i] <- (e[,otherarrays[i]]+e[,thearray])/2
    intended[,i] <- log2(as.numeric(pdata[otherarrays[i],])/as.numeric(pdata[thearray,]))
  }
  rownames(m) <- rownames(e)
  rownames(a) <- rownames(e)
  rownames(intended) <- genenames
  colnames(m) <- colnames(e)[otherarrays]
  colnames(a) <- colnames(e)[otherarrays]
  colnames(intended) <- colnames(e)[otherarrays]
  
  list(m=m,a=a,intended=intended,index=spikeindex,what="MA",method.name=method.name)
}

assessSD <- function(exprset,method.name=NULL,logx=FALSE){
  e <- exprs(exprset)
  se <- se.exprs(exprset)
  pdata <- pData(exprset)
  
  tmp <- cbind(c(1.25,0,2.5,0,5,0,7.5,0,10,0,20,0),
               c(0,1.25,0,2.5,0,5,0,7.5,0,10,0,20))
  
  m <- apply(tmp,1,function(x){
    o <- which(pdata[,1]==x[1] & pdata[,2]==x[2])
    apply(e[,o],1,mean)
  })
  ##sd per concentration group
  observed <- apply(tmp,1,function(x){
    o <- which(pdata[,1]==x[1] & pdata[,2]==x[2])
    apply(e[,o],1,sd)
  })

  nominal <- apply(tmp,1,function(x){
    o <- which(pdata[,1]==x[1] & pdata[,2]==x[2])
    sqrt(apply(se[,o]^2,1,mean))
  })

  tmp1 <- log2(as.vector(nominal))
  tmp2 <- log2(as.vector(observed))
  y <- tmp1-tmp2
  x <- as.vector(m)
  if(logx) x <- log2(x)
  
  list(average.log.expression=x,log.ratio=y,what="SD",
       corr=cor(tmp1,tmp2),method.name=method.name)
}









affycomp.compfigs <- function(l,method.names=NULL,
                              figure1.xlim=c(-4,15),figure1.ylim=c(-10,12),
                              figure1b.xlim=c(-4,15),figure1b.ylim=c(-4,4),
                              figure6a.xlim=c(-12,12),figure6a.ylim=c(-12,12),
                              figure6b.xlim=c(-3,3),figure6b.ylim=c(-6,6)){
  ##if spikein or all take out the what. otherwise make list
  N <- length(l)
  if(is.null(method.names)) method.names <- 1:N
  n <- length(l[[1]])
  
  scn <- prod(par("mfrow"))
  ask <- dev.interactive()
  which.plot <- 0

  ##next block is just so that figures appear in order
  fororder <- c()
  calls <- c()
  is <- c()
  for(i in 1:n){
    tmp <- affycomp.compfigs.calls(l[[1]][[i]]$what)
    calls <- c(calls,tmp)
    fororder <- c(fororder,affycomp.figure.calls(l[[1]][[i]]$what))
    is <- c(is,rep(i,length(tmp)))
  }
  is <- is[order(fororder)]
  calls <- calls[order(fororder)]

  
  for(i in seq(along=calls)){
    if(length(grep("compfig",calls[i]))>0){
      thelist <- vector(mode="list",length=N)
      for(j in 1:N) thelist[[j]] <- l[[j]][[ is[i] ]]
      which.plot <- which.plot+1
      if(trunc((which.plot-1)/scn)==(which.plot-1)/scn && which.plot>1 && ask)
        par(ask=TRUE)
      do.call(calls[i],list(thelist,method.names=method.names))
      par(ask=FALSE)
    }
    else{
      for(j in 1:N){
        which.plot <- which.plot+1;
        if(trunc((which.plot-1)/scn)==(which.plot-1)/scn && which.plot>1 && ask) par(ask=TRUE)
        tmp <- strsplit(calls[i],"\\.")[[1]][2]
        do.call(calls[i],
                list(l[[j]][[ is[i] ]],main=method.names[j],
                     xlim=get(paste(tmp,"xlim",sep=".")),
                     ylim=get(paste(tmp,"ylim",sep="."))))
        par(ask=FALSE)
      }
    }
  }
}

affycomp.compfigs.calls <- function(what){  
  args <- c("MA","Dilution","Dilution","Signal",
            "Dilution","FC","FC2","FC","FC","SD",
            "MA2","SpikeInSD","LS",
            "MA2","MA2","MA2","MA2")
  fignames <- c("figure1","compfig2","compfig3","compfig4a","compfig4b",
                "compfig5a","compfig5b","figure6a","figure6b","compfig7",
                "figure1b","compfig2b","compfig4c",
                "compfig5c","compfig5d","compfig5e","compfig5f")
  paste("affycomp.",fignames[args%in%what],sep="")
}  

   
affycomp.compfig2 <- function(l,method.names=as.character(1:length(l)),add.legend=TRUE,main="Figure 2"){
  N <- length(l)
  XLIM <- NA
  YLIM <- NA
  for(i in 1:N){
    XLIM <- range(c(XLIM,l[[i]]$sdplotx),finite=TRUE,na.rm=TRUE)
    YLIM <- range(c(YLIM,l[[i]]$sdploty),finite=TRUE,na.rm=TRUE)
  }
  plot(1,1,xlim=XLIM,ylim=YLIM,xlab="log expression",ylab="standard error across replicates",type="n",main=main)
  for(i in 1:N)
    lines(l[[i]]$sdplotx,l[[i]]$sdploty,col=i+1,lty=i,lwd=3)
  if(add.legend)
    legend(XLIM[1]+.6*(XLIM[2]-XLIM[1]),
           YLIM[1]+.9*(YLIM[2]-YLIM[1]),
           method.names,col=2:(N+1),lty=1:N,lwd=2)
}

affycomp.compfig3 <- function(l,method.names=as.character(1:length(l)),main="Figure 3"){
  N <- length(l)
  tmp <- vector(mode="list",length=N)
  for(i in 1:N){
    x <- l[[i]]$fc1.25
    y <- l[[i]]$fc20
    tmp[[i]] <- x-y
  }
  boxplot(tmp,names=method.names,range=0,col=2:(N+1),main=main,ylab="Difference between log fold changes")
}

affycomp.compfig4b <- function(l,method.names=as.character(1:length(l)),add.legend=TRUE,main="Figure 4b"){
  N <- length(l)
  XLIM <- c(NA,1)
  YLIM <- c(NA,1)
  for(i in 1:N){
    XLIM <- range(c(XLIM,l[[i]]$slopesmoothx),finite=TRUE,na.rm=TRUE)
    YLIM <- range(c(YLIM,l[[i]]$slopesmoothy),finite=TRUE,na.rm=TRUE)
  }
  plot(1,1,xlim=XLIM,ylim=YLIM,xlab="log expression",ylab="regression slopes",type="n",main=main)
  for(i in 1:N)
    lines(l[[i]]$slopesmoothx,l[[i]]$slopesmoothy,col=i+1,lty=i,lwd=3)
  if(add.legend)
    legend(XLIM[1]+.7*(XLIM[2]-XLIM[1]),
           YLIM[1]+.98*(YLIM[2]-YLIM[1]),
           method.names,col=2:(N+1),lty=1:N,lwd=2)
  abline(h=1)
}

affycomp.compfig4a <- function(l,method.names=as.character(1:length(l)),add.legend=TRUE,main="Figure 4a"){
  N <- length(l)
  XLIM <- NA
  YLIM <- NA
  for(i in 1:N){
    XLIM <- range(c(XLIM,as.numeric(l[[i]]$linex)),finite=TRUE,na.rm=TRUE)
    YLIM <- range(c(YLIM,as.numeric(l[[i]]$liney)),finite=TRUE,na.rm=TRUE)
  }
  plot(1,1,xlim=XLIM,ylim=YLIM,,xlab="Nominal concentration (in picoMolar)", ylab="Observed expression",type="n",main=main)
  for(i in 1:N)
    lines(l[[i]]$linex,l[[i]]$liney,col=i+1,lty=i,lwd=3)
  if(add.legend)
    legend(XLIM[1]+.6*(XLIM[2]-XLIM[1]),
           YLIM[1]+.4*(YLIM[2]-YLIM[1]),
           method.names,col=2:(N+1),lty=1:N,lwd=2)
}

affycomp.compfig5a <- function(l,method.names=as.character(1:length(l)),add.legend=TRUE,main="Figure 5a",maxfp=100){
  N <- length(l)
  FP <- vector(mode="list",length=N)
  TP <- vector(mode="list",length=N)
  for(i in 1:N){
    x <- l[[i]]$fp
    y <- l[[i]]$tp
    Index <- x<=maxfp
    TP[[i]] <- y[Index]
    FP[[i]] <- x[Index]
  }
  XLIM <- range(unlist(FP))
  YLIM <- range(unlist(TP))
  plot(1,1,xlab="False Positives",ylab="True Positives",type="n",xlim=XLIM,ylim=YLIM,main=main)
  for(i in 1:N)
    lines(FP[[i]],TP[[i]],col=i+1,lty=i,lwd=3)
  if(add.legend)
    legend(XLIM[1]+.6*(XLIM[2]-XLIM[1]),
           YLIM[1]+.3*(YLIM[2]-YLIM[1]),
           method.names,col=2:(N+1),lty=1:N,lwd=2)

}

affycomp.compfig5b <- function(l,method.names=as.character(1:length(l)),add.legend=TRUE,main="Figure 5b",maxfp=100){
  N <- length(l)
  FP <- vector(mode="list",length=N)
  TP <- vector(mode="list",length=N)
  for(i in 1:N){
    x <- l[[i]]$fp
    y <- l[[i]]$tp
    Index <- x<=maxfp
    TP[[i]] <- y[Index]
    FP[[i]] <- x[Index]
  }
  XLIM <- range(unlist(FP))
  YLIM <- range(unlist(TP))
  plot(1,1,xlab="False Positives",ylab="True Positives",type="n",xlim=XLIM,ylim=YLIM,main=main)
  for(i in 1:N)
    lines(FP[[i]],TP[[i]],col=i+1,lty=i,lwd=3)
  if(add.legend)
    legend(XLIM[1]+.6*(XLIM[2]-XLIM[1]),
           YLIM[1]+.6*(YLIM[2]-YLIM[1]),
           method.names,col=2:(N+1),lty=1:N,lwd=2)
}

affycomp.compfig7 <- function(l,method.names=as.character(1:length(l)),
                              main="Figure 7"){
  N <- length(l)
  tmp <- vector(mode="list",length=N)
  for(i in 1:N) tmp[[i]] <- l[[i]]$log.ratio
  boxplot(tmp,names=method.names,range=0,col=2:(N+1),main=main,ylab="Log ratio of nominal SD and observed SD")
}

affycompPlot <- function(...,assessment.list=NULL,method.names=NULL,
                         figure1.xlim=c(-4,15),figure1.ylim=c(-10,12),
                         figure1b.xlim=c(-4,15),figure1b.ylim=c(-6,5),
                         figure6a.xlim=c(-12,12),figure6a.ylim=c(-12,12),
                         figure6b.xlim=c(-3,3),figure6b.ylim=c(-6,6)){
  if(is.null(assessment.list)) l<-list(...) else l <- assessment.list
  N <- length(l)

  if(is.null(method.names)){
    method.names <- vector(mode="character",len=N)
    for(i in 1:N){
      tmp <- l[[i]]$method.name
      if(is.null(tmp)) method.names[i] <- i else method.names[i] <- tmp
    }
  }  

  for(i in 1:N){
    tmp <- l[[i]]
    if(tmp$what=="All") tmp <- tmp[1:5]
    else{
      if(tmp$what=="SpikeIn")
        tmp <- tmp[1:4]
      else{
        if(tmp$what=="SpikeIn2")
          tmp <- tmp[1:3]
        else
          tmp <- list(tmp)
      }
    }
    l[[i]] <- tmp
  }
  
  if(N==1) affycomp.figures(l[[1]])
  else{
    if(is.null(method.names)) method.names <- 1:N
    affycomp.compfigs(l,method.names=method.names,
                      figure1.xlim=figure1.xlim,figure1.ylim=figure1.ylim,
                      figure1b.xlim=figure1b.xlim,figure1b.ylim=figure1b.ylim,
                      figure6a.xlim=figure6a.xlim,figure6a.ylim=figure6a.ylim,
                      figure6b.xlim=figure6b.xlim,figure6b.ylim=figure6b.ylim)
  }
}

affycomp.figures <- function(l){
  n <- length(l)
  
  scn <- prod(par("mfrow"))
  ask <- dev.interactive()
  which.plot <- 0

  ##next block is just so that figures appear in order
  calls <- c()
  is <- c()
  for(i in 1:n){
    tmp <- affycomp.figure.calls(l[[i]]$what)
    calls <- c(calls,tmp)
    is <- c(is,rep(i,length(tmp)))
  }
  is <- is[order(calls)]
  calls <- sort(calls)

  for(i in seq(along=calls)){
    which.plot <- which.plot+1
    if(trunc((which.plot-1)/scn)==(which.plot-1)/scn && which.plot>1 && ask)
      par(ask=TRUE)
    do.call(calls[i],list(l[[is[i]]]))
    par(ask=FALSE)
  }
}


affycomp.figure.calls <- function(what){  
  args <- c("MA","Dilution","Dilution","Signal",
            "Dilution","FC","FC2","FC","FC","SD",
            "MA2","SpikeInSD","LS",
            "MA2","MA2","MA2","MA2")
  fignames <- c("1","2","3","4a","4b","5a","5b","6a","6b","7",
                "1b","2b","4c",
                "5c","5d","5e","5f")
  
  paste("affycomp.figure",fignames[args%in%what],sep="")
}  
  


###MvA plot
affycomp.figure1 <- function(l,main="Figure 1",xlim=NULL,ylim=NULL){
  x <- l$a
  y <- l$m
  if(is.null(ylim)) ylim <- range(y,na.rm=TRUE,finite=TRUE)
  if(is.null(xlim)) xlim <- range(x,na.rm=TRUE,finite=TRUE)
  Index <- match(rownames(l$intended),rownames(x))
  xx <- x[Index,]
  yy <- y[Index,]
  x <- x[-Index,]
  y <- y[-Index,]
  fc <- as.character(l$intended)
  colors <- abs(l$intended)
  colors[colors>11] <- 11
  Colors <- rev((c(topo.colors(8)[1:6],rev(heat.colors(8))[4:8])))

  oo <- sample(1:length(x),12000) #pick a few so the plot isnt too busy
  plot(x[oo],y[oo],pch=".",xlim=xlim,ylim=ylim,main=main,xlab="A",ylab="M",
       las=1)
  o <- abs(y[oo])>1
  points((x[oo])[o],(y[oo])[o],pch=".",col="red")
  o1 <- fc=="Inf"
  o2 <- fc=="-Inf"
  text(xx[!o1 & !o2],yy[!o1 & !o2],fc[!o1 & !o2],col=Colors[colors[!o1 & !o2]])
  text(xx[o1],yy[o1],expression(infinity),col="black")
  text(xx[o2],yy[o2],expression(-infinity),col="black")
}


###Variance across replicates
affycomp.figure2 <- function(l,main="Figure 2")
  plot(l$sdplotx,l$sdploty,xlab="log expression",ylab="standard error across replicates",main=main,type="l",lwd=3)

##Sensitivity to amount of RNA
affycomp.figure3 <- function(l,main="Figure 3"){
  x <- l$fc1.25
  y <- l$fc20
  plot(x,y,xlab="Log fold change estimate for 1.25 ug",ylab="Log fold change estimate for 20 ug",main=main,pch=".")
  abline(0,1)
  o <- abs(x-y)>1
  points(x[o],y[o],pch=15,col="orange")
  o <- abs(x-y)>log2(3)
  points(x[o],y[o],pch=16,col="red")
}

##obersved expression v nominal expression
affycomp.figure4a <- function(l,main="Figure 4a"){
  x <- l$plotx
  y <- l$ploty
  cols <- as.numeric(as.factor(names(x)))
  plot(x,y,col=cols,xlab="Nominal concentration (in picoMolar)", ylab="Observed expression",main=main,pch=16)
  lines(l$linex,l$liney,lwd=3)
}

##slope vs concentration
affycomp.figure4b <- function(l,main="Figure 4b"){
  plot(l$slopeplotx,l$slopeploty,xlab="log expression",ylab="slopes of log expression vs log concentration regresssion",main=main,pch=".")
  abline(h=1)
}

###ROC all FC
affycomp.figure5a <- function(l,main="Figure 5a",maxfp=100){
  x <- l$fp
  y <- l$tp
  Index <- x<=maxfp
  y <- y[Index]
  x <- x[Index]
  plot(x,y,xlab="False Positives",ylab="True Positives",main=main,type="l",lwd=3)
}

##ROC FC=2
affycomp.figure5b <- function(l,main="Figure 5b",maxfp=100)
  affycomp.figure5a(l,main=main,maxfp=maxfp)

##observed FC v intendended
affycomp.figure6a <-function(l,main="Figure 6a",xlim=NULL,ylim=NULL){
  x <- l$intended.log.ratios
  y <- l$observed.log.ratios
  if(is.null(ylim)) ylim <- range(y,na.rm=TRUE,finite=TRUE)
  if(is.null(xlim)) xlim <- range(x,na.rm=TRUE,finite=TRUE)
  matplot(x,y,xlab="Nominal log ratio",ylab="observed log ratio",main=main,pch=1:ncol(x),xlim=xlim,ylim=ylim)
  tmp <- tapply(y,x,mean)
  lines(as.numeric(names(tmp)),tmp,lwd=3)
   hs <- l$quantiles
  N <- length(hs)/2
  abline(h=hs,lty=c(N:1,1:N))
}

##observed FC v intendended low conc
affycomp.figure6b <-function(l,main="Figure 6b",xlim=NULL,ylim=NULL){
  x <- l$intended.log.ratios
  y <- l$observed.log.ratios
  Names <- rep(colnames(x),rep(nrow(x),ncol(x)))[l$index.low.signal]
  x <- as.vector(x)[l$index.low.signal]
  y <- as.vector(y)[l$index.low.signal]
  cols <- as.numeric(as.factor(Names))
  if(is.null(ylim)) ylim <- range(y,na.rm=TRUE,finite=TRUE)
  if(is.null(xlim)) xlim <- range(x,na.rm=TRUE,finite=TRUE)
  plot(x,y,col=cols,xlab="Nominal log ratio",ylab="observed log ratio",main=main,xlim=xlim,ylim=ylim)
  tmp <- tapply(y,x,mean)
  lines(as.numeric(names(tmp)),tmp,lwd=3)
  hs <- l$quantiles
  N <- length(hs)/2
  abline(h=hs,lty=c(N:1,1:N))
}

###SD assessment
affycomp.figure7 <- function(l,main="Figure 7"){
  require(splines,quietly = TRUE)
  x <- l$average.log.expression;y <- l$log.ratio
  o <- sample(1:length(x),5000)
  x <- x[o];y <- y[o]
  oo <- which(!is.na(x) & !abs(x)==Inf)
  x <- x[oo]
  y <- y[oo]
  smooth1 <- lm(y~ns(x,7))
  x1 <- sort(x)[seq(1,length(x),length=100)]
  y1 <- smooth1$fitted[order(x)][seq(1,length(x),length=100)]

  set.seed(1)
  o <- sample(1:length(x),5000)
  plot(x[o],y[o],pch=".",xlab="Log expression",ylab="Log (Nominal SD/Observed SD)",main=main)
  lines(x1,y1,lwd=3,col="red")
  abline(h=0)
}
                               

######
##ASSESSMENTS
#######
assessSpikeIn2 <- function(s,method.name=NULL,verbose=TRUE){
  if(ncol(exprs(s))==59){
    s <- s[,c(1:13,17,21:33,37)]
    cat("Using only a subset of the spike in data\n")
  }
  if(verbose) cat("Performing 3 assessments that will take a few seconds")
  tmp1 <- assessSpikeInSD(s,method.name=method.name)
  if(verbose) cat(".")
  tmp2 <- assessLS(s,method.name=method.name)
  if(verbose) cat(".")
  tmp3 <- assessMA2(s,method.name=method.name)
  if(verbose) cat(".\n")
  return(list(MA2=tmp3,SpikeInSD=tmp1,LS=tmp2,what="SpikeIn2",
              method.name=method.name))
}

assessSpikeInSD <- function(exprset,method.name=NULL,span=1/3){
  require(splines,quietly = TRUE)
  require(modreg,quietly = TRUE)
  genenames <- colnames(pData(exprset))
  spikein <-match(genenames,geneNames(exprset))
  y <- esApply(exprset[-spikein,],1,sd)
  x <- esApply(exprset[-spikein,],1,mean)
  smooth1 <- loess(y~x,span=span,family="gaussian",degree=1)
  x2 <- sort(x)[seq(1,length(x),length=100)]
  y2 <- smooth1$fitted[order(x)][seq(1,length(x),length=100)]
  
  list(x=x,y=y,xsmooth=x2,ysmooth=y2,loess=smooth1,method.name=method.name,what="SpikeInSD")
}

assessLS <-  function(exprset,method.name=NULL){
  e <- exprs(exprset)
  pdata <- pData(exprset)
  genenames <- colnames(pdata)
  y <- as.vector(t(e[match(genenames,geneNames(exprset)),]))
  names(y) <- rep(colnames(pdata),nrow(pdata))
  x <- log2(as.vector(as.matrix(pdata)))
  names(x) <- names(y)
  tmp <- tapply(y,x,mean)
  fit1 <- lm(y~x,subset=x>-Inf)

  nc <- unique(x)
  localslope <- rep(0,length(nc)-1)
  localr2 <- rep(0,length(nc)-1)
  for(i in 1:(length(nc)-1)){
    Index1 <- which(x==nc[i])
    Index2 <- which(x==nc[i+1])
    localslope[i] <- mean(y[Index2])-mean(y[Index1])
    localr2[i]<-cor(c(rep(nc[i+1],length(Index2)),
                      rep(nc[i],length(Index1))),
                    c(y[Index2],y[Index1]))^2
  }
  list(slope=fit1$coef[2],R2=summary(fit1)$r.squared,
       plotx=x,ploty=y,linex=names(tmp),liney=as.numeric(tmp),
       localslopes=localslope,localr2s=localr2,method.name=method.name,
       what="LS")
}

assessMA2<-function(exprset,method.name=NULL){
  mat <- exprs(exprset)

  ##this is not good but works..
  if(ncol(mat)==28){
    WHICHSPIKEIN <- "HGU95A"
    NCOMP <- 91*2
  }
  else{
    if(ncol(mat)==42){
      WHICHSPIKEIN <- "HGU133A"
      NCOMP <- 91*3
    }
    else
      stop("Not the right number of columns in expression matrix\n")
  }
 
  pdata <- pData(exprset)
  genenames <- colnames(pdata)
  spikein <-match(genenames,geneNames(exprset))
  
  quants <- matrix(0,nrow(mat)-length(spikein),NCOMP)
  m <- matrix(0,nrow(mat),NCOMP)
  a <- matrix(0,nrow(mat),NCOMP)
  intended <- matrix(0,length(spikein),NCOMP)
  denom <-  matrix(0,length(spikein),NCOMP)
  num <-  matrix(0,length(spikein),NCOMP)
  count <- 0
  for(i in 1:13){
    for(j in (i+1):14){
      count <- count+1
      fc <- mat[,j]-mat[,i]
      quants[,count] <- sort(fc[-spikein])#,probs=seq(0,1,len=1001))
      a[,count] <- (mat[,i]+mat[,j])/2
      m[,count] <- fc
      num[,count] <- as.numeric(pdata[j,])
      denom[,count] <- as.numeric(pdata[i,])
      intended[,count] <- log2(as.numeric(pdata[j,])/as.numeric(pdata[i,]))
    }
  }
  for(i in 15:27){
    for(j in (i+1):28){
      count <- count+1
      fc <- mat[,i]-mat[,j]
      quants[,count] <- sort(fc[-spikein])#,probs=seq(0,1,len=1001))
      a[,count] <- (mat[,i]+mat[,j])/2
      m[,count] <- fc
      num[,count] <- as.numeric(pdata[j,])
      denom[,count] <- as.numeric(pdata[i,])
      intended[,count] <- log2(as.numeric(pdata[i,])/as.numeric(pdata[j,]))
    }
  }

  if(WHICHSPIKEIN=="HGU133A"){
    for(i in 29:41){
      for(j in (i+1):42){
        count <- count+1
        fc <- mat[,i]-mat[,j]
        quants[,count] <- sort(fc[-spikein])#,probs=seq(0,1,len=1001))
        a[,count] <- (mat[,i]+mat[,j])/2
        m[,count] <- fc
        num[,count] <- as.numeric(pdata[j,])
        denom[,count] <- as.numeric(pdata[i,])
        intended[,count] <- log2(as.numeric(pdata[i,])/as.numeric(pdata[j,]))
      }
    }
  }
  
  Index <- spikein
  lowIndex     <- which(as.vector(num) <= 1 & as.vector(denom) <= 1)
  medlowIndex  <- which(as.vector(num) >= 2 & as.vector(denom) >= 2 &
                        as.vector(num) <= 8 & as.vector(denom) <= 8)
  medhighIndex <- which(as.vector(num) >= 16 & as.vector(denom) >= 16 &
                        as.vector(num) <= 64 & as.vector(denom) <= 64)
  highIndex    <- which(as.vector(num) >= 128 & as.vector(denom) >= 128)
  spikes <- as.vector(m[Index,])
  
  nulls <-  m[-Index,]
  nulls <- nulls[seq(1,length(nulls),len=50000)] #resample because its 2mil!
  
  tp.low <- sort(abs(spikes[lowIndex]),decreasing = TRUE)
  fp.low <- sapply(tp.low,function(k) sum(nulls>=k))
  tp.low <- seq(along=tp.low)/length(tp.low)*10
  
  tp.medlow <- sort(abs(spikes[medlowIndex]),decreasing = TRUE)
  fp.medlow <- sapply(tp.medlow,function(k) sum(nulls>=k))
  tp.medlow <- seq(along=tp.medlow)/length(tp.medlow)*10
  
  tp.medhigh <- sort(abs(spikes[medhighIndex]),decreasing = TRUE)
  fp.medhigh <- sapply(tp.medhigh,function(k) sum(nulls>=k))
  tp.medhigh <- seq(along=tp.medhigh)/length(tp.medhigh)*10
  
  tp.high <- sort(abs(spikes[highIndex]),decreasing = TRUE)
  fp.high <- sapply(tp.high,function(k) sum(nulls>=k))
  tp.high <- seq(along=tp.high)/length(tp.high)*10
  
  rownames(m) <- rownames(mat)
  rownames(a) <- rownames(mat)
  rownames(intended) <- genenames
 
  return(list(qs=apply(quants,1,mean),m=m,a=a,
              spikein=spikein,intended=intended,num=num,denom=denom,
              fp.low=fp.low,        tp.low=tp.low,
              fp.medlow=fp.medlow,  tp.medlow=tp.medlow,
              fp.medhigh=fp.medhigh,tp.medhigh=tp.medhigh,
              fp.high=fp.high,      tp.high=tp.high,
              method.name=method.name,what="MA2"))
}


######
## FIGURES
#######
affycomp.compfig4c <- function(l,method.names=as.character(1:length(l)),
                               add.legend=TRUE,rotate=TRUE, main="Figure 4c"){
  xs <- c()
  ys <- c()
  
  for(i in seq(along=l)){
    if(rotate){
      x <- as.numeric(l[[i]]$linex)[-c(1,2)]
      y <- l[[i]]$localslopes[-1]-1 ##take out the ones related to -Inf
      ylab="Bias"
    }
    else{
      x <- as.numeric(l[[i]]$linex)
      y <- l[[i]]$liney
      In<- which(abs(x)<Inf)
      x<- x[In];y<-y[In]
      ylab<-"Observed log expression"
    }
    xs <- rbind(xs,x)
    ys <- rbind(ys,y)
  }
  if(length(l)==1){ xs <- matrix(xs,nrow=1);ys <- matrix(ys,nrow=1); }
  plot(0,0,type="n",ylim=range(ys),xlim=range(xs),ylab=ylab,
       xlab="Log nominal concentration",main=main,las=1)
  
  for(i in seq(along=l))
    lines(xs[i,],ys[i,],col=i+1,lty=i,lwd=3)

  if(add.legend){
    if(rotate){
      legend(max(xs)*.7,max(ys)*.95,method.names,lwd=2,col=seq(along=l)+1,lty=seq(along=l))
      abline(h=0)
    }
    else
      legend(min(xs),max(ys)*.95,method.names,lwd=2,col=seq(along=l)+1,lty=seq(along=l))
  }
}
affycomp.figure4c <- function(l,rotate=TRUE, main="Figure 4c")
  affycomp.compfig4c(list(l),method.names=l$method.name,add.legend=FALSE,
                     main=main,rotate=rotate)

affycomp.compfig2b <- function(l,method.names=as.character(1:length(l)),
                              add.legend=TRUE,main="Figure 2b"){
  xs <- c()
  ys <- c()
  for(i in seq(along=l)){
    x <- l[[i]]$xsmooth
    y <- l[[i]]$ysmooth
    xs <- rbind(xs,x)
    ys <- rbind(ys,y)
  }
  plot(0,0,type="n",ylim=range(ys),xlim=range(xs),xlab="Average log expression",ylab="Log expression SD", main=main,las=1)
  
  for(i in seq(along=l))
    lines(xs[i,],ys[i,],col=i+1,lty=i,lwd=3)
  
  if(add.legend)
    legend(max(xs)*.7,max(ys)*.95,method.names,lwd=2,col=seq(along=l)+1,lty=seq(along=l))
}
affycomp.figure2b <- function(l,main="Figure 2b")
  affycomp.compfig2b(list(l),method.name=l$method.name,add.legend=FALSE,
                     main=main)

affycomp.compfig5cdef <- function(l,method.names=as.character(1:length(l)),
                                 add.legend=TRUE,main="Figure 5c",maxfp=100,
type=c("low","medlow","medhigh","high")){
  type <- match.arg(type)
  tp.type <- paste("tp.",type,sep="")
  fp.type <- paste("fp.",type,sep="")
  N <- length(l)
  FP <- vector(mode="list",length=N)
  TP <- vector(mode="list",length=N)
  MIN <- 10
  MAX <- 0
  for(i in 1:N){
    x <- l[[i]][[fp.type]]
    y <- l[[i]][[tp.type]]
    Index <- x<=maxfp
    if(any(Index)){
      MIN <- min(MIN,min(y[Index]))
      MAX <- max(MAX,max(y[Index]))
      TP[[i]] <- c(0,y[Index])
      FP[[i]] <- c(0,x[Index])
    }
    else{ ##there are no true positives!
      TP[[i]] <- c(0,0)
      FP[[i]] <- c(0,maxfp)
      MIN <- 0
    }
  }
  XLIM <- c(0,maxfp)
  YLIM <- c(MIN,MAX)
  plot(1,1,xlab="False Positives",ylab="True Positives",type="n",xlim=XLIM,ylim=YLIM,main=main,las=1)
  for(i in 1:N)
    lines(FP[[i]],TP[[i]],col=i+1,lty=i,lwd=3)
  if(add.legend)
    legend(XLIM[1]+.6*(XLIM[2]-XLIM[1]),
           YLIM[1]+.3*(YLIM[2]-YLIM[1]),
           method.names,col=2:(N+1),lty=1:N,lwd=1)
  
}

affycomp.compfig5c <- function(l,method.names=as.character(1:length(l)),
                              add.legend=TRUE,main="Figure 5c",maxfp=100)
  affycomp.compfig5cdef(l,method.names=method.names,add.legend=add.legend,
                       main=main,maxfp=100,type="low")
affycomp.figure5c <- function(l,main="Figure 5c",maxfp=100)
  affycomp.compfig5c(list(l),method.names=l$method.name,main=main,maxfp=maxfp,
                     add.legend=FALSE)

affycomp.compfig5d <- function(l,method.names=as.character(1:length(l)),
                               add.legend=TRUE,main="Figure 5d",maxfp=100)
  affycomp.compfig5cdef(l,method.names=method.names,add.legend=add.legend,
                       main=main,maxfp=100,type="medlow")
affycomp.figure5d <- function(l,main="Figure 5d",maxfp=100)
  affycomp.compfig5d(list(l),method.names=l$method.name,main=main,maxfp=maxfp,
                     add.legend=FALSE)

affycomp.compfig5e <- function(l,method.names=as.character(1:length(l)),
                              add.legend=TRUE,main="Figure 5e",maxfp=100)
  affycomp.compfig5cdef(l,method.names=method.names,add.legend=add.legend,
                       main=main,maxfp=100,type="medhigh")
affycomp.figure5e <- function(l,main="Figure 5e",maxfp=100)
  affycomp.compfig5e(list(l),method.names=l$method.name,main=main,maxfp=maxfp,
                     add.legend=FALSE)

affycomp.compfig5f <- function(l,method.names=as.character(1:length(l)),
                               add.legend=TRUE,main="Figure 5f",maxfp=100)
  affycomp.compfig5cdef(l,method.names=method.names,add.legend=add.legend,
                       main=main,maxfp=100,type="high")
affycomp.figure5f <- function(l,main="Figure 5f",maxfp=100)
  affycomp.compfig5f(list(l),method.names=l$method.name,main=main,maxfp=maxfp,
                     add.legend=FALSE)


###MvA plot
affycomp.figure1b <- function(l,main="Figure 1b",xlim=NULL,ylim=NULL){
  x <- l$a
  y <- l$m
  Index <- match(rownames(l$intended),rownames(x))
  xx <- as.vector(x[Index,])
  yy <- as.vector(y[Index,])
  x <- as.vector(x[-Index,])
  y <- as.vector(y[-Index,])

  num <- as.vector(l$num); denom <- as.vector(l$denom)
  tmplist <- list()
  tmplist[[1]]     <- which(as.vector(num) <= 1 & as.vector(denom) <= 1)
  tmplist[[2]] <- which(as.vector(num) >= 2 & as.vector(denom) >= 2 &
                        as.vector(num) <= 8 & as.vector(denom) <= 8)
  tmplist[[3]] <- which(as.vector(num) >= 16 & as.vector(denom) >= 16 &
                        as.vector(num) <= 64 & as.vector(denom) <= 64)
  tmplist[[4]]   <- which(as.vector(num) >= 128 & as.vector(denom) >= 128)

  if(is.null(ylim))
    ylim <- range(c(y,yy[unlist(tmplist)]),na.rm=TRUE,finite=TRUE)
  if(is.null(xlim))
    xlim <- range(c(x,xx[unlist(tmplist)]),na.rm=TRUE,finite=TRUE)
  
  oo <- sample(1:length(x),12000) #pick a few so the plot isnt too busy
  plot(x[oo],y[oo],pch=".",xlim=xlim,ylim=ylim,main=main,xlab="A",ylab="M",
       las=1)
  o <- abs(y[oo])>1
  points((x[oo])[o],(y[oo])[o],pch=".",col="red")

  colors <- c("red","orange","green","blue")
  FC <- as.character(l$intended)
  for(i in 1:4){
    fc <- FC[ tmplist[[i]] ]
    xxx <- xx[ tmplist[[i]] ]
    yyy <- yy[ tmplist[[i]] ]
    o1 <- fc=="Inf"
    o2 <- fc=="-Inf"
    text(xxx[!o1 & !o2],yyy[!o1 & !o2],fc[!o1 & !o2],col=colors[i])
    text(xxx[o1],yyy[o1],expression(infinity),col=colors[i])
    text(xxx[o2],yyy[o2],expression(-infinity),col=colors[i])
  }
}


#########
## TABLES
#########

tableOverallSNR <- function(...,assessment.list=NULL,method.names=NULL,
                            ngenes=12626){
  if(is.null(assessment.list)) l<-list(...) else l <- assessment.list
  N <- length(l)
  
  if(is.null(method.names)){
    method.names <- vector(mode="character",len=N)
    for(i in 1:N){
      tmp <- l[[i]]$method.name
      if(is.null(tmp)) method.names[i] <- i else method.names[i] <- tmp
    }
  }  
  
  results <- matrix(0,length(l),6)
  colnames(results) <- c("slope","R2","25thSD","medianSD","75thSD","Rank")
  rownames(results) <- method.names
  for(i in 1:N){
    results[i,1] <- l[[i]]$LS$slope
    results[i,2] <- l[[i]]$LS$R2
    results[i,3] <- quantile(l[[i]]$SpikeInSD$y,prob=.25)
    results[i,4] <- median(l[[i]]$SpikeInSD$y)
    results[i,5] <- quantile(l[[i]]$SpikeInSD$y,prob=.75)
    qs <- l[[i]]$MA2$qs
    tmp <- abs(qs-results[i,1])
    tmp <- which(tmp==min(tmp))/length(qs)
    results[i,6] <- round(ngenes-tmp*ngenes)
  }
  return(results)
}

tableLS <- function(...,assessment.list=NULL,method.names=NULL,
                            ngenes=12626,rank=TRUE){
  if(is.null(assessment.list)) l<-list(...) else l <- assessment.list
  N <- length(l)
  
  if(is.null(method.names)){
    method.names <- vector(mode="character",len=N)
    for(i in 1:N){
      tmp <- l[[i]]$method.name
      if(is.null(tmp)) method.names[i] <- i else method.names[i] <- tmp
    }
  }  

  results <- matrix(0,length(l[[1]]$LS$localslopes),N)
  colnames(results) <- method.names
  tmp <-  as.character((2^as.numeric(l[[1]]$LS$linex)))
  rownames(results) <- paste(tmp[-1],tmp[-length(tmp)],sep=":")

  for(i in 1:N)
    results[,i] <- l[[i]]$LS$localslopes

  if(!rank) return(results)
  else{
    for(i in 1:N){
       qs <- l[[i]]$MA2$qs
       results[,i] <- sapply(results[,i],function(x){
         tmp <- abs(qs-x)
         tmp <- which(tmp==min(tmp))/length(qs)
         round(ngenes-tmp*ngenes)
       })
     }
    return(results)
  }
}
                             
     












read.spikein <- function(filename,cdfName=c("hgu95a","hgu133a")){
#######################################################
###prep spike in exprSet
#######################################################
  cdfName <- match.arg(cdfName)
  s <- read.csv(filename,check.names=FALSE,row.names=1)
  samplenames <- colnames(s)
  ##remove the .cel if its there
  samplenames <- sub("\\.gz$","",samplenames,ignore.case=TRUE)
  samplenames <- sub("\\.Z$","",samplenames,ignore.case=TRUE)
  samplenames <- sub("\\.cel$","",samplenames,ignore.case=TRUE)
  colnames(s) <- samplenames
  ##read phenodata
  if(cdfName=="hgu95a"){
    data(spikein.phenodata)
    pd <- spikein.phenodata
  }
  if(cdfName=="hgu133a"){
    data(hgu133a.spikein.phenodata)
    pd <- hgu133a.spikein.phenodata  
  }
  ##putit in order
  s <- s[,rownames(pData(pd))]
  s <- new("exprSet",exprs=as.matrix(s),phenoData=pd)
  s <- exprset.log(s) ##take log
  return(s)
}

read.newspikein <- function(filename)
  read.spikein(filename,cdfName="hgu133a")
                                                  
read.dilution <- function(filename){
#######################################################
###prep dilution exprSet
#######################################################
  d <- read.csv(filename,check.names=FALSE,row.names=1)
  
  samplenames <- colnames(d)
  ##remove the .cel if its there
  samplenames <- sub("\\.gz$","",samplenames,ignore.case=TRUE)
  samplenames <- sub("\\.Z$","",samplenames,ignore.case=TRUE)
  samplenames <- sub("\\.cel$","",samplenames,ignore.case=TRUE)
  colnames(d) <- samplenames
  ##read phenodata
  data(dilution.phenodata)
  ##putit in order
  d <- d[,rownames(pData(dilution.phenodata))]
  d <- new("exprSet",exprs=as.matrix(d),phenoData=dilution.phenodata)
  d <- exprset.log(d) ##take log
  return(d)
}


exprset.log <- function(exprset){
    e <- exprs(exprset)
    e <- log2(e)
    o <- abs(e)==Inf | is.na(e)
    e[o] <- min(e[!o])
    exprset@exprs <- e
    return(exprset)
  }
affycompTable <- function(...,Table=NULL,
                          assessment.list=NULL,method.names=NULL){
  if(is.null(Table)) tmp <- tableAll(...,assessment.list=assessment.list,method.names=method.names) else tmp <- Table
  tmp <- tmp[c(1,2, 3,4,5, 7,8, 6, 12,13,14, 21,22,23, 15,16,17),]
  tmp <- data.frame(tmp)
  tmp$whatsgood <- c(0,1,1,0,0,1,1,1,1,0,16,1,0,16,0,1,1)
  tmp$Figure <- c("2","2","3","3","3","4a","4a","4b","5a","5a","5a",
                  "5b","5b","5b","6","6a","6b")
  tmp
}
  
tableAll <- function(...,assessment.list=NULL,method.names=NULL){
  if(is.null(assessment.list)) l<-list(...) else l <- assessment.list
  N <- length(l)
  
  if(is.null(method.names)){
    method.names <- vector(mode="character",len=N)
    for(i in 1:N){
      tmp <- l[[i]]$method.name
      if(is.null(tmp)) method.names[i] <- i else method.names[i] <- tmp
    }
  }  

  for(i in 1:N){
    tmp <- l[[i]]
    if(tmp$what=="All") tmp <- tmp[1:5]
    else{
      if(tmp$what=="SpikeIn")
        tmp <- tmp[1:4]
      else{
        tmp <- list(tmp)
        names(tmp) <- tmp[[1]]$what
      }
    }
    l[[i]] <- tmp
  }

  auxcalls <- names(l[[1]])
  auxcalls <- auxcalls[!auxcalls%in%"MA"]
  calls <- paste("table",auxcalls,sep="")
  
  results <- c()
  for(i in seq(along=calls)){
    thelist <- vector(mode="list",length=N)
    for(j in 1:N) thelist[[j]] <- l[[j]][[auxcalls[i]]]
    tmp <- do.call(calls[i],list(thelist,method.names=method.names))
    results <- rbind(results,tmp)
  }
  results
}

tableDilution <- function(l,method.names=NULL){
  N <- length(l)
  if(is.null(method.names)) method.names <- 1:N
  results <- matrix(0,6,length(l))
  colnames(results) <- method.names
  rownames(results) <- c("Median SD",
                         "R2",
                         "1.25v20 corr",
                         "2-fold discrepancy",
                         "3-fold discrepancy",
                         "Median slope")

  for(i in 1:length(l)){
    results[1,i] <- l[[i]]$mediansd
    results[2,i] <- mean(l[[i]]$R2)
    results[3,i] <- l[[i]]$consitency
    results[4,i] <- l[[i]]$two.fold.discrepancy
    results[5,i] <- l[[i]]$three.fold.discrepancy
    results[6,i] <- l[[i]]$medianbeta

  }
  return(results)
}

tableFC <- function(l,method.names=NULL){
  N <- length(l)
  if(is.null(method.names)) method.names <- 1:N
  results <- matrix(0,9,length(l))
  colnames(results) <- method.names
  rownames(results) <- c("AUC (FP<10)",
                         "AUC (FP<15)",
                         "AUC (FP<25)",
                         "AUC (FP<100)",
                         "AFP, call if fc>2",
                         "ATP, call if fc>2",
                         "IQR",
                         "Obs-intended-fc slope",
                         "Obs-(low)int-fc slope")
  
  for(i in 1:length(l)){
    results[1:4,i] <- unlist(l[[i]]$area)
    results[5,i] <- mean(l[[i]]$fc2[,1])
    results[6,i] <- mean(l[[i]]$fc2[,2])
    results[7,i] <- -diff(l[[i]]$quantiles[4:3])
    results[8,i] <- mean(l[[i]]$slope)
    results[9,i] <- mean(l[[i]]$low.signal.slope)
  }
  return(results)
}

tableFC2 <- function(l,method.names=NULL){
  N <- length(l)
  if(is.null(method.names)) method.names <- 1:N
  results <- matrix(0,6,length(l))
  colnames(results) <- method.names
  rownames(results) <- c("FC=2, AUC (FP<10)",
                         "FC=2, AUC (FP<15)",
                         "FC=2, AUC (FP<25)",
                         "FC=2, AUC (FP<100)",
                         "FC=2, AFP, call if fc>2",
                         "FC=2, ATP, call if fc>2")
  
  for(i in 1:length(l)){
    results[1:4,i] <- unlist(l[[i]]$area)
    results[5,i] <- mean(l[[i]]$fc2[,1])
    results[6,i] <- mean(l[[i]]$fc2[,2])
  }
  return(results)
}


tableSignal <- function(l,method.names=NULL){
  N <- length(l)
  if(is.null(method.names)) method.names <- 1:N
  results <- matrix(0,2,length(l))
  colnames(results) <- method.names
  rownames(results) <- c("Signal detect slope",
                         "Signal detect R2")
  for(i in 1:length(l)){
    results[1,i] <- mean(l[[i]]$slope)
    results[2,i] <- l[[i]]$R2
  }
  return(results)
}


tableSD <- function(l,method.names=NULL){
  N <- length(l)
  if(is.null(method.names)) method.names <- 1:N
  results <- matrix(0,2,length(l))
  colnames(results) <- method.names
  rownames(results) <- c("IQR of log ratio",
                         "Correlation")
  for(i in 1:length(l)){
    results[1,i] <- IQR(l[[i]]$log.ratio)
    results[2,i] <- l[[i]]$corr
  }
  return(results)
}

.First.lib <- function(libname, pkgname, where) {
  

  where <- match(paste("package:", pkgname, sep=""), search())

  require(Biobase, quietly=TRUE) ##Biobase uses methods

  cacheMetaData(as.environment(where))

}
