.packageName <- "ACME"
setClass('aGFF',
         representation(annotation='data.frame',
                        data='matrix',
                        samples='data.frame'),
         prototype=list(annotation=NULL,
           data=matrix(nrow=0,ncol=0),
           samples=NULL)
         )
setClass('aGFFCalc',
         representation(call='call',
                        threshold='numeric',
                        cutpoints='numeric',
                        vals='matrix'),
         contains='aGFF')
printgff <- function(x) {
  numgenes <- dim(x@data)[1]
  numsamples <- dim(x@data)[2]
  cat("\n")
  cat("Array GFF object")
  cat("\n")
  cat(paste("Number of Samples:",numsamples))
  cat("\n")
  cat(paste("Number of probes: ",numgenes))
  cat("\n")
  cat("\n")
  cat("===== Data =====")
  cat("\n")
  print(cbind(x@annotation[1:5,c('Chromosome','Location')],x@data[1:5,]))
  cat(paste("With",numgenes-5,"more rows..."))
  cat("\n")
  cat("\n")
  cat("=== Samples ===")
  cat("\n")
  if (is.null(x@samples)) print ('No sample information')
  else print(x@samples)
  cat("\n")
  cat("\n")
  cat("== Annotation ==")
  cat("\n")
  print(x@annotation[1:5,])
  cat(paste("With",numgenes-5,"more rows..."))
  cat("\n")
}
setMethod("print","aGFF",printgff)
setMethod("show","aGFF",function(object) print(object))
printgffcalc <- function(x) {
  numgenes <- dim(x@data)[1]
  numsamples <- dim(x@data)[2]
  cat("\n")
  cat("Array GFF Calculation object")
  cat("\n")
  cat(paste("Number of Samples:",numsamples))
  cat("\n")
  cat(paste("Threshold: ",x@threshold))
  cat("\n")
  cat("Cutpoints:\n")
  print(x@cutpoints)
  cat("\n")
  cat("Call:\n")
  print(x@call)
  cat("\n")
  cat("===== Data =====")
  cat("\n")
  print(cbind(x@annotation[1:5,c('Chromosome','Location')],x@data[1:5,]))
  cat(paste("With",numgenes-5,"more rows..."))
  cat("\n")
  cat("\n")
  cat("=== Samples ===")
  cat("\n")
  if (is.null(x@samples)) print ('No sample information')
  else print(x@samples)
  cat("\n")
  cat("\n")
  cat("== Annotation ==")
  cat("\n")
  print(x@annotation[1:5,])
  cat(paste("With",numgenes-5,"more rows..."))
  cat("\n")
  cat("\n")
  cat("== Values ==")
  cat("\n")
  print(x@vals[1:5,])
  cat(paste("With",numgenes-5,"more rows..."))
  cat("\n")
}
setMethod("print","aGFFCalc",printgffcalc)
setMethod("show","aGFFCalc",function(object) print(object))
plotgff <- function(x,y='missing',chrom,samples=NULL,ask=FALSE,...) {
  nsamps <- 0
  if (is.null(samples)) {
    samples <- 1:dim(x@data)[2]
    nsamps <- length(samples)
  }
  if (!is.numeric(samples))
    samples <- which(colnames(x@data) %in% samples)
  sub <- x@annotation$Chromosome==chrom
  if (sum(sub)==0)
    stop('No matching chromosome in the data')
  if (nsamps>1) par(ask=ask)
  for (i in samples)
    plot(x@annotation$Location[sub],x@data[sub,i],...,
         main=paste('Chromosome:',chrom,', Sample:',colnames(x@data)[i]),
         ylab='Data',xlab='Chromosome Position')
  par(ask=F)
}
setMethod("plot","aGFF",plotgff)
plotgffcalc <- function(x,y='missing',chrom,samples=NULL,...) {
  nsamps <- 0
  if (is.null(samples)) {
    samples <- 1:dim(x@data)[2]
    nsamps <- length(samples)
  }
  if (!is.numeric(samples))
    samples <- which(colnames(x@data) %in% samples)
  sub <- x@annotation$Chromosome==chrom
  if (sum(sub)==0)
    stop('No matching chromosome in the data')
  if (nsamps>1) par(ask=T)
  par(mar=c(4,5,4,5))
  for (i in samples) {
    plot(x@annotation$Location[sub],x@data[sub,i],
         axes=F,col='gray85',pch=20,xlab="",ylab="",main="",...)
    axis(side=4)
    abline(h=0,col='gray85')
    abline(h=x@cutpoints[i],col='gray85',lty=2)
    par(new=T)
    plot(x@annotation$Location[sub],-log10(x@vals[sub,i]),
         main=paste('Chromosome:',chrom,', Sample:',colnames(x@data)[i]),
         ylab='-log10(p-value)',xlab='Chromosome Position',type='b',pch=20,
         col='red',...)
  }
  par(ask=F)
}
setMethod("plot","aGFFCalc",plotgffcalc)
assign('[.aGFF',function(object,i,j) {
  if (nargs()!=3) stop("two subscripts required",call.=FALSE)
  if(missing(i)) {
    if(missing(j)) {
      return(object)
    } else {
      object@data <- object@data[,j,drop=FALSE]
      object@annotation <- object@annotation
      if (!is.null(object@samples)) object@samples <- object@samples[j,]
      return(object)
    }
  } else {
    if (missing(j)) {
      object@data <- object@data[i,,drop=FALSE]
      object@annotation <- object@annotation[i,,drop=FALSE]
      return(object)
    }
  }
  object@data <- object@data[i,j,drop=FALSE]
  object@annotation <- object@annotation[i,,drop=FALSE]
  if (!is.null(object@samples)) object@samples <- object@samples[j,]
  return(object)
}
       )
"do.aGFF.calc" <-
function (x, window, thresh) 
{
    chroms <- unique(as.character(x@annotation$Chromosome))
    nsamps <- dim(x@data)[2]
    ngenes <- dim(x@data)[1]
    y <- x@data
    cutpoints <- vector()
    for (i in 1:nsamps) {
      writeLines(paste("Working on sample", i))
      cutpoints[i] <- quantile(x@data[, i], probs = thresh)
      vals <- x@data[,i]>cutpoints[i]
      vals[vals==TRUE] <- 1
      vals[vals==FALSE] <- 0
      positive.count <- sum(vals)
      for (j in chroms) {
        writeLines(paste("Working on chromosome", j))
        sub <- x@annotation$Chromosome == j
        z <- windowChisq(x@annotation$Location[sub],
                         vals[sub],
                         window,
                         length(vals),
                         positive.count)
        y[sub, i] <- z$p.vals;
      }
    }
    colnames(y) <- colnames(x@data)
    names(cutpoints) <- colnames(x@data)
    ret <- new("aGFFCalc", vals = y, threshold = thresh, cutpoints = cutpoints, 
               data = x@data, annotation = x@annotation, samples = x@samples, 
               call = match.call())
    return(ret)
  }

windowChisq <- function(locations,ratios,windowsize,totprobes,posprobes) {
  ret <- .Call('windowChisq',locations,ratios,windowsize,totprobes,posprobes,PACKAGE='ACME')
  return(list(posProbes=ret[[1]],
              nProbes=ret[[2]],
              chivals=ret[[3]],
              values =ret[[4]],
              p.vals=1-pchisq(ret[[3]],1)))
}
"findClosestGene" <-
  function(chrom,pos,genome="hg17",position='txStart') {
    if (!exists('refflat')) {
      refflat <<- list()
      refflat[[genome]] <<- getRefflat(genome)
    } else if (!match(genome,names(refflat))) {
      refflat[[genome]] <<- getRefflat(genome)
    }
    rf <- refflat[[genome]]
    chromsub <- rf$chrom==chrom
    diffdist <- rf[chromsub,position]-pos
    sub <- which(abs(diffdist)==min(abs(diffdist)))
    rf <- rf[chromsub,1:9][sub,]
    return(data.frame(rf,Distance=diffdist[sub]))
  }
"findRegions" <-
  function(calcobj,thresh=0.0001) {
    vals <- calcobj@vals
    cols <- colnames(calcobj@vals)
    annot <- calcobj@annotation
    regions <- list()
    for(i in cols) {
      for(chrom in unique(as.character(annot$Chromosome))) {
        chromSub <- which(annot$Chromosome==chrom)
        y <- rle(as.vector(vals[chromSub,i]<thresh))
        startind <- min(chromSub)+cumsum(y$lengths)-y$lengths
        endind <- min(chromSub)+cumsum(y$lengths)-1
        mat <- data.frame(Length=y$lengths,TF=y$values,
                          StartInd=startind,
                          EndInd=endind,
                          Sample=i,
                          Chromosome=calcobj@annotation[startind,'Chromosome'],
                          Start=calcobj@annotation[startind,'Location'],
                          End=calcobj@annotation[endind,'Location']
                          )
        if(length(regions[[i]])>0) {
          regions[[i]] <- rbind(regions[[i]],mat)
        } else {
          regions[[i]] <- mat
        }
      }
    }
    regions.df <- do.call('rbind',regions)
    meds <- apply(regions.df,1,function(x) {
      return(median(as.vector(vals[(as.numeric(x[3])):(as.numeric(x[4]))
                                   ,x[5]])))
    }
                  )
    means <- apply(regions.df,1,function(x) {
      return(mean(as.vector(vals[(as.numeric(x[3])):(as.numeric(x[4]))
                                 ,x[5]])))
    }
                   )
    regions.df <- data.frame(regions.df,Median=meds,Mean=means)
    return(regions.df)
  }

                        
"getRefflat" <-
  function(genome="hg17") {
    tmpfile <- tempfile()
    download.file(paste('http://hgdownload.cse.ucsc.edu/goldenPath/',
                        genome,'/database/refFlat.txt.gz',sep=""),
                  tmpfile,mode='wb')
    rf <- read.delim(gzfile(tmpfile),header=FALSE,sep="\t")
    colnames(rf) <- c('geneName','name','chrom','strand','txStart','txEnd',
                      'cdsStart','cdsEnd','exonCount','exonStarts','exonEnds')
    txEndNeg <- rf$txStart
    txStartNeg <- rf$txEnd
    cdsStartNeg <- rf$cdsEnd
    cdsEndNeg <- rf$cdsStart
    NegStrand <- rf$strand=='-'
    ## Fix negative strand stuff
    rf[NegStrand,'cdsEnd'] <- cdsEndNeg[NegStrand]
    rf[NegStrand,'cdsStart'] <- cdsStartNeg[NegStrand]
    rf[NegStrand,'txEnd'] <- txEndNeg[NegStrand]
    rf[NegStrand,'txStart'] <- txStartNeg[NegStrand]
    return(rf)
  }

"read.resultsGFF" <-
  function (fnames, path = NULL, samples = NULL, notes = NULL, skip = 0, 
            sep = "\t", quote = "\"", ...) 
{
  if (is.null(path)) 
    fullfnames <- fnames
  else fullfnames <- file.path(path, fnames)
  fname <- fullfnames[1]
  Chromosome <- Source <- Type <- Location <- End <- Score <- Phast <- Strand <- Comments <- NULL
  first.pass <- TRUE
  for (f in fullfnames) {
    print(paste("Reading", f))
    tmp <- read.delim(f, header = F, skip = skip, sep = sep, 
                      quote = quote, ...)
    if (first.pass) {
      Annotation <- data.frame(tmp[, c(1:5, 7:9)])
      colnames(Annotation) <- c("Chromosome", "Source", 
                                "Type", "Location", "End", "Phase", "Strand", "Comment")
      first.pass <- FALSE
    }
    Score <- cbind(Score, as.numeric(tmp[, 6]))
  }
  fnames <- gsub(".gff", "", fnames)
  ord <- order(Annotation$Chromosome, Annotation$Location)
  Score <- as.matrix(Score[ord,])
  colnames(Score) <- fnames
  ret <- new("aGFF", annotation = Annotation[ord, ],
             data = Score, samples = data.frame(samples))
  return(ret)
}
write.sgr <- function(agff,raw=TRUE,vals=TRUE,directory='.') {
  if (!(class(agff) %in% c('aGFF','aGFFCalc'))) {
    stop('Need agff to be an aGFF or aGFFCalc object')
  }
  sampnames <- colnames(agff@data)
  for(i in 1:ncol(agff@data)) {
    if (class(agff)=='aGFFCalc'){
      if(vals) {
        filename <- file.path(directory,sprintf("%s_thresh%3.2f.sgr",sampnames[i],agff@threshold))
        cat(filename,"\n")
        write.table(data.frame(agff@annotation[,c('Chromosome','Location')],-log10(agff@vals[,i]+min(agff@vals[agff@vals[,i]>0,i]))),file=filename,
                    sep="\t",col.names=FALSE,row.names=FALSE,quote=FALSE)
      }
    }
    if(raw) {
      filename <- file.path(directory,sprintf("%s_raw.sgr",sampnames[i]))
      cat(filename,"\n")
      write.table(data.frame(agff@annotation[,c('Chromosome','Location')],agff@data[,i]),file=filename,
                  sep="\t",col.names=FALSE,row.names=FALSE,quote=FALSE)
    }
  }
}
