.packageName <- "LMGene"
"LMGene" <-
function(eS,level=.05)
#
#
#
{
  pvlist <- genediff(eS)
  apvlist <- pvadjust(pvlist)
  numeff <- ncol(apvlist$Posterior.FDR)
  for (effnum in 1:numeff)
  {
    tmp <- rowlist(eS@exprs,effnum,apvlist,level)
    if (effnum==1){
      if (length(tmp)>1  ){
        lmres <- list(tmp=tmp)
      }else if(tmp != -1){
        lmres <- list(tmp=tmp)
      }else{
        lmres <- list(tmp="No significant genes")
      }
    }else {
      if ( length(tmp)>1 ){
        lmres <- c(lmres,list(tmp=tmp))
      }else if(tmp != -1){
        lmres <- c(lmres,list(tmp=tmp))
      }else{
        lmres <- c(lmres,list(tmp="No significant genes"))
      }
    }
    effname <- colnames(apvlist$Posterior.FDR)[effnum]
    names(lmres)[effnum] <- effname
  }
  return(lmres)
}

"arrplot1" <-
function(eS)
{
  slides <- as.matrix(eS@exprs)
  
  # model information 
  for(i in 1:length(eS@phenoData@varLabels)){
  assign(paste('x', i, sep=''),as.factor(eS@phenoData@pData[,i]))
  }
  
  fchar=''
  for(i in 1:length(eS@phenoData@varLabels)){
  fchar=paste(fchar, paste('x', i, sep=''), ifelse(i<length(eS@phenoData@varLabels), '+', ''), sep='')
  }

  fchar2 <- paste("y ~",fchar)
  y <- t(slides)
  formobj <- as.formula(fchar2)

  n <- dim(slides)[2]
  p <- dim(slides)[1]
  tmp <- lm(formobj)
  for (i in 1:p)
  {
    tmp2 <- mlm2lm(tmp,i)
    tmp3 <- anova(tmp2)$Mean
    tmp4 <- msa(tmp3)
    if ( i == 1)
    {
      resmat <- tmp4
    }
    else
    {
      resmat <- cbind(resmat,tmp4)
    }
  }
  
  rownames(resmat)=c( names(eS@phenoData@varLabels) ,"Error")

  return(resmat)
}

"arrplotd" <-
function(eS,cs="")
{
#  if (high==-1) high=dim(slides)[1]
#  tmp <- rank(apply(slides,1,mean))
#  ind <- (tmp >= low) & (tmp <= high)
#  slides <- slides[ind,]

  tmp <- arrplot1(eS)
  dplot(tmp,cs)
#  return(tmp)
}

"arrplote" <-
function(eS,cs="")
{

#  slides <- log(as.matrix(slides))  # lee
#  slides <- lnorm(slides,span=0.1)  # lee

  tmp <- arrplot1(eS)
  dplote(tmp,cs)
}

"beams" <-
function(eS, startvar){

  startvar=as.numeric(startvar)
  
  range=rbind(c(0,2*exp(startvar[1])), c(0,2*startvar[2]))
  
  tempsol=msecalc(eS, exp(startvar[1]), startvar[2], FALSE)[1];
  
  pp = rbind(c(exp(startvar[1]), startvar[2])
            ,c(exp(startvar[1]), startvar[2]))
         
  intv1 = exp(startvar[1])*(2/3);
  intv2 = startvar[2]*(2/3);
      
  bestsol = c(pp[1,1], pp[1,2], tempsol);
  secondbestsol = c(pp[2,1], pp[2,2], tempsol);
  
  iteration =0;
  
  while(1){
    
    for (c in 1:2){
      sp = rbind(c(pp[c,1],       pp[c,2]), 
                 c(pp[c,1]+intv1, pp[c,2]), 
                 c(pp[c,1]-intv1, pp[c,2]), 
                 c(pp[c,1] ,      pp[c,2]+intv2), 
                 c(pp[c,1],       pp[c,2]-intv2), 
                 c(pp[c,1]+intv1, pp[c,2]+intv2), 
                 c(pp[c,1]+intv1, pp[c,2]-intv2), 
                 c(pp[c,1]-intv1, pp[c,2]+intv2), 
                 c(pp[c,1]-intv1, pp[c,2]-intv2))
      sp=ifelse(sp<1,1,sp)
      for(a in 1:9){
        tempsol=msecalc(eS, sp[a,1], sp[a,2], FALSE)[1]
        if (tempsol < bestsol[3]){
          secondbestsol=bestsol
          bestsol=c(sp[a,1], sp[a,2],tempsol)
        }
      }
    }
  
    pp[1,] = c(bestsol[1],bestsol[2]);
    pp[2,] = c(secondbestsol[1],secondbestsol[2]);
    intv1 = intv1/2;
    intv2 = intv2/2;
    
    iteration = iteration + 1;
         
    #print(c(iteration, intv1, intv2, pp[1,], pp[2,], bestsol[3], secondbestsol[3]))
    if( (intv1 < 1 & intv2 < 1 ) & (secondbestsol[3]-bestsol[3]<1) ){
      break;
    }
  
  
  }

  return(c(bestsol[1:2]))
}

"dplot" <-
function(scoef, cs ='')
{
  csum <- apply(scoef,2,sum)
  ind <- !is.na(csum)
  scoef <- scoef[,ind]
  cut <- .1
  
  ymax=0
  for(i in 1:dim(scoef)[1]){
    assign(paste('d', i, sep=''),density(scoef[i,]))
    ymax=max(ymax,get(paste('d', i, sep=''))$y)
  }

  ts <- paste("Smoothed Histogram",cs,sep=" ")
  
  plot(d1,ylim=c(0,ymax), xlab="Relative Mean Square",  main=ts, lwd=2, col=1)
  for(i in 2:dim(scoef)[1]){
    lines(get(paste('d', i, sep='')),col=i,lwd=2)
  }

  legend(.6,ymax*4/5,col=1:dim(scoef)[1],legend=rownames(scoef),  lty=1,lwd=2)

}

"dplote" <-
function(scoef,cs='')
{
  csum <- apply(scoef,2,sum)
  ind <- !is.na(csum)
  scoef <- scoef[,ind]
  for(i in 1:dim(scoef)[1]){
    assign(paste('d', i, sep=''),scoef[i,])
  }
  ts <- paste("Cumulative Frequency Distribution",cs,sep=" ")

  plot.stepfun(ecdf(d1),do.points=FALSE, main=ts,lwd=2,xlim=c(0,1), xlab="Relative Mean Square", ylab="Cumulative Density")
  for(i in 2:dim(scoef)[1]){
    plot.stepfun(ecdf(get(paste('d', i, sep=''))),do.points=FALSE,lwd=2,col.hor=i,col.vert=i,add=TRUE)
  }

  legend(.6,.4,col=1:dim(scoef)[1],legend=rownames(scoef), lty=1,lwd=2)
}

"genediff" <-
function(eS)
#
# computes two vectors of p-values per gene or probe
#   using gene-by-gene anova with individual gene MSE using 
#   both the gene-specific MSE and the posterior mean MSE for
#   each term in the anova. Assumes a fixed effects model and
#   the correct denominator for all comparisons is the MSE
# mat1 is a p by n matrix of expression values
# vlist is a list of the form list(v1=v1,v2=v2,..) of variables, 
#   each of length n, the number of chips
# fchar is the model for each gene in the form of a character 
#   string with variables from vlist. An example is "v1 + v2"
#
# create variables
#
{ 
  mat1 <- as.matrix(eS@exprs)
  
  # model information 
  for(i in 1:length(eS@phenoData@varLabels)){
  assign(paste('x', i, sep=''),as.factor(eS@phenoData@pData[,i]))
  }
  
  fchar=''
  for(i in 1:length(eS@phenoData@varLabels)){
  fchar=paste(fchar, paste('x', i, sep=''), ifelse(i<length(eS@phenoData@varLabels), '+', ''), sep='')
  }



  fchar2 <- paste("y ~",fchar)
  mat2 <- as.matrix(mat1)
  p <- dim(mat2)[1]
  n <- dim(mat2)[2]
#
# retrieve effect names
#
  owaov <- function(y)
  {
    formobj <- as.formula(fchar2)
    tmp <- row.names(anova(lm(formobj)))
    return(tmp)
  }
  effnames <- owaov(mat2[1,])
#
# Perform ANOVA's and retrieve mean squares and df's
#
  numeff <- length(effnames)
  tmp1 <- rowaov(eS)
  msmat <- tmp1[1:numeff,]
  dfmat <- tmp1[(numeff+1):(2*numeff),]
  numf <- numeff-1
  nu <- median(dfmat[numeff,])
  dfvec <- dfmat[numeff,]
  msevec <- msmat[numeff,]
#
# compute hyperparameters for prior
#
  mn <- mean(msevec)
  v <- var(msevec)
  alpha <- (mn^2-2*mn^2/nu +2*v)/(v-2*mn^2/nu)
  beta <- 1/(mn*(alpha-1))
  eta <- alpha*beta
  prior <- 1/eta
  df <- 2*alpha
#print(c(mn,v,alpha,beta,eta,prior,df))
#
# compute adjusted mean square errors
#
  adjdfvec <- dfvec+df
  adjmsevec <- (msevec*dfvec+prior*df)/adjdfvec
#
# compute F statistics and p-values
#
  pmat1 <- matrix(numeric(numf*p),ncol=numf)
  pmat2 <- pmat1
  for (i in 1:numf)
  { 
    pmat1[,i] <- 1-pf(msmat[i,]/msevec,dfmat[i,],dfvec) 
    pmat2[,i] <- 1-pf(msmat[i,]/adjmsevec,dfmat[i,],adjdfvec) 
  }
  colnames(pmat1) <- effnames[-numeff]
  colnames(pmat2) <- effnames[-numeff]
return(list("Gene.Specific"=pmat1,"Posterior"=pmat2))

}

"glog" <-
function(y,lambda)
{
  yt <- log(y+sqrt(y^2+lambda))
  return(yt)
}

"jggrad2" <-
function(y,lambda,alpha)
{
  ya <- y-alpha
  g <- glog(ya,lambda)
  z <- sqrt(ya^2+lambda)
  za <- -ya/z
  zl <- 1/(2*z)
  ga <- -1/z
  gl <- 2*z*(ya+z)
  gl <- 1/gl
  J <- exp(mean(log(z)))
  Ja <- J*mean(za/z)
  Jl <- J*mean(zl/z)
  jg <- g*J
  jga <- ga*J+g*Ja
  jgl <- gl*J+g*Jl
  return(cbind(jg,jgl,jga))
}

"jglog" <-
function(y,lambda)
{
  z <- sqrt(y^2+lambda)
  gmn <- exp(mean(log(z)))
  y1 <- glog(y,lambda)
  y1 <- y1*gmn
  return(y1)
}

"lnorm" <-
function(mat1,span=.1)
{
  mat2 <- as.matrix(mat1)
  p <- dim(mat2)[1]
  n <- dim(mat2)[2]
  rmeans <- apply(mat2,1,mean)
  rranks <- rank(rmeans,ties.method="first")
  matsort <- mat2[order(rranks),]  
  r0 <- 1:p
  lcol <- function(x)
  {
    lx <- lowess(r0,x,f=span)$y
  }
  lmeans <- apply(matsort,2,lcol)
  lgrand <- apply(lmeans,1,mean)
  lgrand <- matrix(rep(lgrand,n),byrow=FALSE,ncol=n)
  matnorm0 <- matsort-lmeans+lgrand
  matnorm1 <- matnorm0[rranks,]
  return(matnorm1)
}

"mlm2lm" <-
function(lmobj,i)
{
  lmobj2 <- lmobj
  lmobj2$coefficients <- (lmobj$coefficients)[,i]
  lmobj2$residuals <- (lmobj$residuals)[,i]
  lmobj2$effects <- (lmobj$effects)[,i]
  lmobj2$fitted.values <- (lmobj$fitted.values)[,i]
  class(lmobj2) <- "lm"
  return(lmobj2)
}

"msa" <-
function(v)
{
  tmp <- sum(v^2)
  if (tmp==0)tmp <- 1
  return(v/sum(v))
  
}

"msecalc" <-
function(eS,lam,alpha,lowessnorm)
#
# computes the mean square error and gradient for the global anova
#   Assumes a fixed effects model
# mat1 is a p by n matrix of expression values
# vlist is a list of the form list(v1=v1,v2=v2,..) of variables, 
#   each of length n, the number of chips
# fchar is the model for each gene in the form of a character 
#   string with variables from vlist. An example is "v1 + v2"
#
# returns the mse and gradient
#
# create variables
#
{ 
  starttime <- Sys.time()

  mat1 <- as.matrix(eS@exprs)
  
  # model information 
  for(i in 1:length(eS@phenoData@varLabels)){
  assign(paste('x', i, sep=''),as.factor(eS@phenoData@pData[,i]))
  }
  
  fchar=''
  for(i in 1:length(eS@phenoData@varLabels)){
  fchar=paste(fchar, paste('x', i, sep=''), ifelse(i<length(eS@phenoData@varLabels), '+', ''), sep='')
  }

  mat2 <- as.matrix(mat1)
  n <- dim(mat2)[2]
  p <- dim(mat2)[1]
  mat2 <- jggrad2(mat2,lam,alpha)
  if (lowessnorm)
  {
    mat2l <- lnorm(mat2[,(n+1):(2*n)])
    mat2a <- lnorm(mat2[,(2*n+1):(3*n)])
    mat2 <- lnorm(mat2[,1:n])
  }
  else
  {
    mat2l <- norm(mat2[,(n+1):(2*n)])
    mat2a <- norm(mat2[,(2*n+1):(3*n)])
    mat2 <- norm(mat2[,1:n])
  }
  #nvar <- length(vlist)
  #for (ivar in 1:nvar)
  #{
  #  assign(names(vlist)[ivar],vlist[[ivar]])
  #}


  fchar1 <- paste("y ~",fchar)
  y <- t(mat2)
  formobj <- as.formula(fchar1)
  lm1 <- lm(formobj)
  y <- t(mat2l)
  lm2 <- lm(formobj)
  y <- t(mat2a)
  lm3 <- lm(formobj)
  df <- p*lm1$df
  r1 <- sum( (lm1$resid)^2)/df
  r2 <- sum( 2*(lm1$resid)*(lm2$resid))/df
  r3 <- sum( 2*(lm1$resid)*(lm3$resid))/df
#  print(difftime(Sys.time(),starttime))
  return(c(r1,r2,r3))
}

"neweS" <-
function(mat, vlist, vlabel=as.list(names(vlist))){
names(vlabel)=names(vlist)
pdata <- new("phenoData", pData=as.data.frame(vlist), varLabels=vlabel)
thisExprs <- as.matrix(mat)
if(!identical(colnames(thisExprs), rownames(pdata)))
	colnames(thisExprs) <- NULL
eset <- new("exprSet", exprs=thisExprs, phenoData=pdata)
return(eset)
}

"norm" <-
function(mat1)
{
  mat2 <- as.matrix(mat1)
  p <- dim(mat2)[1]
  n <- dim(mat2)[2]
  cmean <- apply(mat2,2,mean)
  cmean <- cmean - mean(cmean)
  mnmat <- matrix(rep(cmean,p),byrow=TRUE,ncol=n)
  return(mat2-mnmat)
}

"pvadjust" <-
function(pvlist)
#
# pvlist is the output from genediff containing p-values from
#   gene-specific MSE's and posterior MSE's. This routine
#   adds FDR adjusted p-values using the multtest routine
#   rawp2adjp
#
{
  library(multtest)
  pv1 <- pvlist$Gene.Specific
  pv2 <- pvlist$Posterior
  nump <- dim(pv1)[2]
  for (i  in 1:nump)
  {
    ap <- mt.rawp2adjp(pv1[,i],"BH")
    pv1[,i] <- ap$adjp[order(ap$index),2]
    ap <- mt.rawp2adjp(pv2[,i],"BH")
    pv2[,i] <- ap$adjp[order(ap$index),2]
  }
  pvlist2 <- c(pvlist,list("Gene.Specific.FDR"=pv1,"Posterior.FDR"=pv2))
  return(pvlist2)
}

"rgplot" <-
function(eS, norm="lnorm",red=TRUE,green=TRUE,title="",span=.1)
# plots the individual dye/slide distributions either with or without 
# normalization

{
  slides <- as.matrix(eS@exprs)
  factor=as.factor(eS@phenoData@pData[,1])
  

  drawden<-function(slides){
    if(factor[1]==levels(factor)[1])
      plot(density(slides[,1]), main=title, ylab="Density", col=2)
    else
      plot(density(slides[,1]), main=title, ylab="Density", col=3)
    for(i in 2:length(factor)){
      if(factor[i]==levels(factor)[1]){
        lines(density(slides[,i]),col=2)
      }
      else{
        lines(density(slides[,i]),col=3)
      }    
    }
  }
  
  slides<-log(slides)
  if (norm=="norm")  {
    slides <- norm(slides)
  }
  else if (norm=="lnorm")   {
    slides <- lnorm(slides,span=span)
  }
  drawden(slides)

}

"rowaov" <-
function(eS)
#
# computes the mean squares and degrees of freedom for
#   gene-by-gene anovas. Assumes a fixed effects model and
#   the correct denominator for all comparisons is the MSE
# mat1 is a p by n matrix of expression values
# vlist is a list of the form list(v1=v1,v2=v2,..) of variables, 
#   each of length n, the number of chips
# fchar is the model for each gene in the form of a character 
#   string with variables from vlist. An example is "v1 + v2"
#
# returns matrix with p rows and as many twice as many columns 
#   as lines in the anova table
#
# create variables
#
{ 
  mat1 <- as.matrix(eS@exprs)
  
  # model information 
  for(i in 1:length(eS@phenoData@varLabels)){
  assign(paste('x', i, sep=''),as.factor(eS@phenoData@pData[,i]))
  }
  
  fchar=''
  for(i in 1:length(eS@phenoData@varLabels)){
  fchar=paste(fchar, paste('x', i, sep=''), ifelse(i<length(eS@phenoData@varLabels), '+', ''), sep='')
  }

  fchar2 <- paste("y ~",fchar)
  mat2 <- as.matrix(mat1)
  n <- dim(mat2)[2]
  p <- dim(mat2)[1]
#
# run regression and anovas
#

  y <- t(mat2)
   formobj <- as.formula(fchar2)
  tmp <- lm(formobj)
  for (i in 1:p)
  {
#    y <- mat2[i,]
#    tmp2 <- lm(formobj)
    tmp2 <- mlm2lm(tmp,i)
    tmp3 <- anova(tmp2)
    tmp4 <- c(tmp3$Mean,tmp3$Df)
     if ( i == 1)
    {
      resmat <- tmp4
    }
    else
    {
      resmat <- cbind(resmat,tmp4)
    }
  }
  return(resmat)
}

"rowlist" <-
function(genemat,effnum,apvlist,level,posterior=TRUE)
#
# genemat is an n-by-p matrix of expression values 
# effnum is the coumn number for the effect of interest
# apvlist is a matrix of p-values from pvadjust or genediff
# the routine returns a list of genes whose FDR p-value is 
#   less than level using either individual gene or posterior 
#   MSE's. This is gene names if rownames(genemat) is not null,
#   and gene numbers otherwise.
#
{
  if(posterior)
  {
    ind <- apvlist$Posterior.FDR[,effnum] < level
  }
  else
  {
    ind <- apvlist$Gene.Specific.FDR[,effnum] < level
  }
  numsig <- sum(ind)
  if (is.null(rownames(genemat)))
  {
    p <- dim(genemat)[1]
    if (numsig > 0)
    {
      return((1:p)[ind])
    }
    else
    {
      return(-1)
    }
  }
  else
  {
    if (numsig > 0)
    {
      return(rownames(genemat)[ind])
    }
    else
    {
      return(-1)
    }
  }
}

"tranest" <-
function(eS,ngenes=-1,starting=FALSE,lambda=1000,alpha=0,gradtol=1e-3,lowessnorm=FALSE)
{
  mat1 <- as.matrix(eS@exprs)
  
  n <- dim(mat1)[2]
  p <- dim(mat1)[1]
  
  if((ngenes < p)&(ngenes>0)) mat2=mat1[sample(p,ngenes),]
  else mat2=mat1
  
  eS2=new("exprSet", exprs=mat2, phenoData=eS@phenoData)
  tranpar <- tranest2(eS2,starting,lambda,alpha,gradtol,lowessnorm)
  #return(list(lambda=exp(tranpar[1]),alpha=tranpar[2]))
  return(list(lambda=(tranpar[1]),alpha=tranpar[2]))
}

"tranest2" <-
function(eS,starting=FALSE,lambda=1000,alpha=0,gradtol=1e-3,lowessnorm)
{
  starttime <- Sys.time()
  mat1 <- as.matrix(eS@exprs)
  
  like <- function(x)
  {
    lnlam <- x[1]
    alpha <- x[2]
    lam <- exp(lnlam)
print(c("lam lnlam alpha", format(lam, nsmall=2), format(lnlam, nsmall=2), format(alpha, nsmall=2)))
    tmp <- msecalc(eS,lam,alpha,lowessnorm)
    tmpv <- tmp[1]

    attr(tmpv,"gradient") <- c(tmp[2]*lam,tmp[3])
#    attr(tmpv,"gradient") <- c(tmp[2],tmp[3])

print(c("tmp", format(tmp[1:3],nsmall=2), lam))
print(c("tmpv",format(tmpv, nsmall=2), format(attr(tmpv,"gradient"), nsmall=2)) )
    return(tmpv)
  }

  if (starting)
  {
    lamstart <- log(lambda)
    alphastart <- alpha
  }
  else{
    lamstart <- log(median(abs(mat1))^2)
    alphastart <- quantile(abs(as.vector(mat1)),.1)
  }
  
  typsize <- c(lamstart,alphastart)
  startvar <- c(lamstart,alphastart)
  stepmax <- 3
  
  #opt <- nlm(like,startvar,stepmax=4,typsize=typsize,check.analyticals=FALSE,gradtol=gradtol, print.level = 2)
  #print(difftime(Sys.time(),starttime))
  #print(opt)
  #return(opt$estimate)
  
  ##
  return(beams(eS, startvar))
  ##
  
  
}

