.packageName <- "affyQCReport"
##  arrayReport.R
##  09-Jun-2005
##
##  Craig Parman craig.parman@bifix.org
##  Conrad Halling conrad.halling@bifx.org

QCReport <-
function(
    object,
    file    = "AffyQCReport.pdf",
    ... )
{
    pdf(
        file    = file,
        width   = 8,
        height  = 11,
        onefile = TRUE )
    plot.window(
        c( 1, 1 ),
        c( 0, 1 ) )
    plot.new()
    titlePage( object )
    signalDist( object )
    plot( qc( object ) )
    borderQC1( object )
    borderQC2( object )
    correlationPlot( object )
    dev.off()
    return( TRUE )
}

          correlationPlot <-function(object)
                  {

                   ArrayIndex = as.character(1:length(sampleNames(object)))
			 pmat<-as.matrix(pData(object@phenoData))
                   phenodepth<-min(ncol(pmat),3)  #allow up to three levels for sorting
                   
                   order<-switch(phenodepth+1, 
                                ArrayIndex,
                                order(pmat[,1]),
                                order(pmat[,1],pmat[,2]),
                                order(pmat[,1],pmat[,2],pmat[,3])
                                )

                   
                   arraypos <- (1:length(ArrayIndex))     *  ( 1/(length(ArrayIndex)-1)) - (1/(length(ArrayIndex)-1))
                  arraypos2=seq(1:length(ArrayIndex)-1)
			for(i in 2:length(ArrayIndex)) 
                  {arraypos2[i-1] <- (arraypos[i]+arraypos[i-1])/2
                  }

                   #win.graph()
                  layout(matrix(c(1,1,1,2,1,1,1,2,1,1,1,2,3,3,3,4), 4, 4, byrow = TRUE))
                     
                  c<-cor(object@exprs[ ,order],method = "spearman")
                  
                   image(c ,xaxt="n",yaxt="n",xlab="Array Index"
                        ,ylab="Array Index" , main="Array-Array Intensity Correlation")

                    abline(h = arraypos2, v = arraypos2)
                    


                 axis(1, labels=as.character(order)   , at=arraypos)
                   axis(2, labels=as.character(order)   , at=arraypos)
                    
                     
                    m=matrix(pretty(c,10),nrow=1,ncol=length(pretty(c,10)))

                    image(m,xaxt="n",yaxt="n",ylab="Correlation Coefficient")

                 axis(2, label= as.list(pretty(c,10)),at=seq(0,1,by=  (1/  ( length (pretty(c,10)) -1 )   )) )
                       
                     abline( h= seq( (1/  ( length (pretty(c,10)) -1 )   )/2, 1-(1/  ( length (pretty(c,10)) -1 )   ),by=(1/  ( length (pretty(c,10)) -1 )   )))
 




                   plot(1,1, type="n",xlim=c(0,length(ArrayIndex)),ylim=c(0,phenodepth),
                       xlab="Array Index", ylab="",yaxt="n",xaxt="n",xaxs="i" )
         
              axis(1, labels=as.character(order),at=seq(1-.5,length(ArrayIndex)-.5))
               axis(4, label= as.list(attr(object@phenoData,which="varLabels")[1:phenodepth]),at=seq(1-.5,phenodepth-.5),las=1)
             #  axis(3,label= as.list(substr(sampleNames(object)[order],1,8)), at=seq(1-.5,length(ArrayIndex)-.5),las=3,cex=.2)
  


              abline(h = seq(1,phenodepth), v = seq(1,length(ArrayIndex)), col = "lightgray")
               for(i in 1:phenodepth)
			{

                   text(seq(.5,length(ArrayIndex)-.5,by=1),rep(i-1+.5,length(ArrayIndex)),pmat[order,i],cex=0.7)



                  }

                
                    return(TRUE)
    }
         
        



#correlationPlot(pdata)


        
  borderQC1 <-  function(object)
     {
           
            #get array dimensions 
                 
                 n <- object@nrow
                
            #create indices for sides
                  
                 left  <-  seq(0,n-1)*n+1
                 right <-  seq(1,n)*n

                 top   <-  seq(1,n)
                 bottom<-  seq(1,n)+(n*(n-1)) 
                 
            #the sides will be split into on and off based on intensity
		  #the first array will be used

                 leftmean   <-mean(intensity(object)[left,1])
                 rightmean  <-mean(intensity(object)[right,1])
                 topmean    <-mean(intensity(object)[top,1]) 
                 bottommean <-mean(intensity(object)[bottom,1])

                 lefton     <- left[intensity(object)[left,1]  >1.2*leftmean]
                 righton    <- right[intensity(object)[right,1] >1.2*rightmean]
                 topon      <- top[intensity(object)[top,1]   >1.2*topmean]
                 bottomon   <- bottom[intensity(object)[bottom,1]>1.2*bottommean]
 
		     leftoff     <- left[intensity(object)[left,1] < .8*leftmean]
                 rightoff    <- right[intensity(object)[right,1] <.8*rightmean]
                 topoff      <- top[intensity(object)[top,1]   <.8*topmean]
                 bottomoff   <- bottom[intensity(object)[bottom,1]<.8*bottommean]

                 on<-c(lefton,righton,topon,bottomon)
                 off<-c(leftoff,rightoff,topoff,bottomoff)

             #calculate center of intensity
                  
                 
                 rmon<-mean(data.frame(intensity(object)[righton,]))
                 lmon<-mean(data.frame(intensity(object)[lefton,]))
                 xcmon<- (rmon - lmon)/(rmon+lmon)
                    
                 tmon<-mean(data.frame(intensity(object)[topon,]))
                 bmon<-mean(data.frame(intensity(object)[bottomon,]))
                 ycmon<- (tmon-bmon)/(tmon+bmon)
 


                 rmoff<-mean(data.frame(intensity(object)[rightoff,]))
                 lmoff<-mean(data.frame(intensity(object)[leftoff,]))
                 xcmoff<- (rmoff - lmoff)/(rmoff+lmoff)
                    
                 tmoff<-mean(data.frame(intensity(object)[topoff,]))
                 bmoff<-mean(data.frame(intensity(object)[bottomoff,]))
                 ycmoff<- (tmoff-bmoff)/(tmoff+bmoff)


       #check for out of bounds xcm or ycm

                 ArrayIndex = as.character(1:length(sampleNames(object)))
                 flagcmoff <- ArrayIndex[xcmoff < -.5 | xcmoff > .5 | ycmoff < -.5 | ycmoff > .5 ] 
                 flagcmon <- ArrayIndex[xcmon < -.5 | xcmon > .5 | ycmon < -.5 | ycmon > .5 ] 


                 

                  #win.graph()
                  layout(matrix(c(1,1,2,2,1,1,2,2,3,3,3,3), 3, 4, byrow = TRUE))
                  
                    
                  boxplot(data.frame(intensity(object)[on,]),
                          xlab="Array Index",ylab="Intensity",main="Positive Border Elements",
                          names=ArrayIndex
                          )
                 

                  boxplot(data.frame(intensity(object)[off,]),
                          xlab="Array Index",ylab="Intensity",main="Negative Border Elements",
                           names=ArrayIndex
                          )
                 
                 
                 
                 
                  plot(ArrayIndex,ArrayIndex, type="n",xlim=c(0,length(ArrayIndex)),ylim=c(0,1),
                       xlab="Array Index",ylab="Sample Name",yaxt="n", xaxt="n",xaxs="i" )
              midpoint<-seq(1,length(ArrayIndex)) -0.5
            
               axis(1,label= ArrayIndex, at=seq(1-.5,length(ArrayIndex)-.5),cex=.2)

              abline(v = ArrayIndex)
              for(i in 1:length(ArrayIndex))
			{
                text(midpoint[i],.5,substr(sampleNames(object)[i],1,10),cex=.7)

                }
                 
                 
                 
                 
                 
                 
                 
                 
                    return(TRUE)
                 
         
        }





#borderQC1(pdata)

      
  borderQC2 <-  function(object)
  
               {
              
            #get array dimensions 
                 
                 n <- object@nrow
                
            #create indices for sides
                  
                 left  <-  seq(0,n-1)*n+1
                 right <-  seq(1,n)*n

                 top   <-  seq(1,n)
                 bottom<-  seq(1,n)+(n*(n-1)) 
                 
            #the sides will be split into on and off based on intensity
		  #the first array will be used

                 leftmean   <-mean(intensity(object)[left,1])
                 rightmean  <-mean(intensity(object)[right,1])
                 topmean    <-mean(intensity(object)[top,1]) 
                 bottommean <-mean(intensity(object)[bottom,1])

                 lefton     <- left[intensity(object)[left,1]  >1.2*leftmean]
                 righton    <- right[intensity(object)[right,1] >1.2*rightmean]
                 topon      <- top[intensity(object)[top,1]   >1.2*topmean]
                 bottomon   <- bottom[intensity(object)[bottom,1]>1.2*bottommean]
 
		     leftoff     <- left[intensity(object)[left,1] < .8*leftmean]
                 rightoff    <- right[intensity(object)[right,1] <.8*rightmean]
                 topoff      <- top[intensity(object)[top,1]   <.8*topmean]
                 bottomoff   <- bottom[intensity(object)[bottom,1]<.8*bottommean]

                 on<-c(lefton,righton,topon,bottomon)
                 off<-c(leftoff,rightoff,topoff,bottomoff)

             #calculate center of intensity
                  
                 
                 rmon<-mean(data.frame(intensity(object)[righton,]))
                 lmon<-mean(data.frame(intensity(object)[lefton,]))
                 xcmon<- (rmon - lmon)/(rmon+lmon)
                    
                 tmon<-mean(data.frame(intensity(object)[topon,]))
                 bmon<-mean(data.frame(intensity(object)[bottomon,]))
                 ycmon<- (tmon-bmon)/(tmon+bmon)
 


                 rmoff<-mean(data.frame(intensity(object)[rightoff,]))
                 lmoff<-mean(data.frame(intensity(object)[leftoff,]))
                 xcmoff<- (rmoff - lmoff)/(rmoff+lmoff)
                    
                 tmoff<-mean(data.frame(intensity(object)[topoff,]))
                 bmoff<-mean(data.frame(intensity(object)[bottomoff,]))
                 ycmoff<- (tmoff-bmoff)/(tmoff+bmoff)


       #check for out of bounds xcm or ycm

                 ArrayIndex = as.character(1:length(sampleNames(object)))
                 flagcmoff <- ArrayIndex[xcmoff < -.5 | xcmoff > .5 | ycmoff < -.5 | ycmoff > .5 ] 
                 flagcmon <- ArrayIndex[xcmon < -.5 | xcmon > .5 | ycmon < -.5 | ycmon > .5 ] 


                 

                  #win.graph()
     
                 
                 
                 
                 
                 
                 layout(matrix(c(1,1,2,2,1,1,2,2,3,3,3,3), 3, 4, byrow = TRUE))
                 
                
                  plot(xcmon,ycmon,xlim=c(-1,1),ylim=c(-1,1),
                       xlab="X Center of Intensity position",ylab="Y Center of Intensity position",
                       main="Positive Elements"  
                       )
                     
                   if(length(flagcmon) > 0) {

                                        text(xcmon[as.numeric(flagcmon)],ycmon[as.numeric(flagcmon)],ArrayIndex[as.numeric(flagcmon)],pos=2)
                   
                                          }
                plot(xcmoff,ycmoff,xlim=c(-1,1),ylim=c(-1,1),
                     xlab="X Center of Intensity position",ylab="Y Center of Intensity position",
                       main="Negative Elements" 
                      )
                 

                if(length(flagcmoff) > 0) {
                                  text(xcmoff[as.numeric(flagcmoff)],ycmoff[as.numeric(flagcmoff)],ArrayIndex[as.numeric(flagcmoff)],pos=2)
                                     }


               plot(ArrayIndex,ArrayIndex, type="n",xlim=c(0,length(ArrayIndex)),ylim=c(0,1),
                       xlab="Array Index",ylab="Sample Name",yaxt="n", xaxt="n",xaxs="i" )
              midpoint<-seq(1,length(ArrayIndex)) -0.5
            
               axis(1,label= ArrayIndex, at=seq(1-.5,length(ArrayIndex)-.5),cex=.2)

              abline(v = ArrayIndex)
              for(i in 1:length(ArrayIndex))
			{
                text(midpoint[i],.5,substr(sampleNames(object)[i],1,10),cex=.7)

                }

                 




                
                 
                    return(TRUE)
                 }
         
        





#borderQC2(pdata)










         titlePage<- function(object)


{
#plot.new()

polygon(c(.0,.0,.9,.9,.0),c(.05,.95,.95,.05,.05))
polygon(c(.45,.45),c(.05,.95))

polygon(c(0,.9),c(.88,.88))
polygon(c(0,.9),c(.87,.87))

text(.5,1,"AffyBatch QC Report",cex=1.5)
text(.4,0,"Produced by AffyQCReport R Package", cex=.5)
text(.4,.03,date(),cex=.5)
text(.45/2, .9, "Array Index")
text(3*.45/2, .9, "Array Name")



n<-length(sampleNames(object))
cexval <- min(10/n,1)
	for( i in 1:n)
	{	

	text(.45/2, .9-i*(.9-.01)/(n+1)  ,as.character(i),cex=cexval)
      
      polygon(c(0,.9),c(.9-(i+.5)*(.9-.01)/(n+1),.9-(i+.5)*(.9-.01)/(n+1))  )

	text(3*.45/2,.9-i*(.9-.01)/(n+1), sampleNames(object)[i],cex=cexval)
     

	}

return(TRUE)
}




  signalDist<- function(object)


{

par(mfrow=c(2, 1))
ArrayIndex = as.character(1:length(sampleNames(object)))
boxplot(object,names=ArrayIndex,ylab="Log2(Intesity)",xlab="Array Index")

hist(x=object,lt=1:length(ArrayIndex),col=1:length(ArrayIndex),which="both")
temppar<-par()

legend(   ((temppar$xaxp[2]-temppar$xaxp[1])/temppar$xaxp[3])*(temppar$xaxp[3]-1) +temppar$xaxp[1]
         ,temppar$yaxp[2]
         ,as.character(ArrayIndex),lt=1:length(ArrayIndex),col=1:length(ArrayIndex)
        ,cex=.5  
        )



}
.First.lib <-
function( libname, pkgname )
{
    require( simpleaffy, quietly = TRUE );
    require( affy,       quietly = TRUE );
    cat( "Welcome to 'affyQCReport' V 1.6-1\n" );
    cat( "Further information available at: www.bifix.org\n");
    cat( "      mailto: craig.parman@bifix.org\n" );
}
