.packageName <- "encoDnaseI"
setClass("hg18track", 
	representation(name="character"), contains="eSet")

setClass("hg18track",       
         contains = "eSet",
         prototype = prototype(
           new("VersionedBiobase",
               versions=c(classVersion("eSet"), hg18track="1.0.0"))))


setMethod("initialize", "hg18track",
          function(.Object,
                   assayData = assayDataNew(
                     dataVals = dataVals, ...),
                   featureData = annotatedDataFrameFrom(assayData, byrow=TRUE),
                   experimentData = new("MIAME"),
                   annotation = character(),
                   dataVals = matrix(), 
                   ... ) {
			   callNextMethod(.Object,
                           assayData = assayData,
                           featureData = featureData,
                           experimentData = experimentData,
                           annotation = annotation)
          })

makeHg18track = function(dataVals, featureDataFrame, fvarMetadata = NULL, ... ) {
 if (length(dataVals) != nrow(featureDataFrame)) stop("dataVals vector length != nrow featureDataFrame")
 dv = matrix(dataVals, nc=1)
 rownames(featureDataFrame)  = rownames(dv) = 1:length(dataVals)
 if (is.null(fvarMetadata))
      adf = new("AnnotatedDataFrame", data=featureDataFrame)
 else adf = new("AnnotatedDataFrame", data=featureDataFrame, 
              varMetadata=fvarMetadata)
 new("hg18track", dataVals=dv, featureData=adf, ...)
}

setGeneric("dataVals", function(object)standardGeneric("dataVals"))
setMethod("dataVals", "hg18track", function(object) {
 get("dataVals", assayData(object))
})

setGeneric("chrnum", function(object)standardGeneric("chrnum"))
setMethod("chrnum", "hg18track", function(object) {
 cn = pData(featureData(object))$chrom
 if (any(cn == "chrX")) {
     cn[ cn == "chrX" ] = "chr23"
     if (options()$verbose) warning("chrX recoded to chr23")
     }
 as.numeric(gsub("chr", "", cn))
})

setClass("chrnum", contains="numeric")
setMethod("chrnum", "numeric", function(object)
  new("chrnum", object))

setMethod("[", "hg18track", function(x, i, j, ..., drop=FALSE) {
  if (!missing(j)) warning("sample indices ignored for hg18track")
  if (missing(i)) kpinds =   1:length(featureNames(x))
  else if (is(i, "chrnum")) kpinds =   which(chrnum(x) %in% i) 
  else if (is(i, "numeric")) kpinds = i
  else if (is(i, "logical")) kpinds = which(i)
  x@assayData = assayDataNew("lockedEnvironment",
        dataVals= matrix(dataVals(x)[ kpinds ], nc=1))
  x@featureData = featureData(x)[kpinds,]
  x
})

setGeneric("getTrkXY", function(object, type) standardGeneric("getTrkXY"))
setMethod("getTrkXY", c("hg18track", "character"), 
  function(object, type="midpoint") {
   Y = dataVals(object)
   Xs = pData(featureData(object))[,c("chromStart", "chromEnd")]
   X = apply(data.matrix(Xs),1,mean)
   list(x=X, y=Y)
})
setMethod("getTrkXY", c("hg18track", "missing"), 
  function(object, type="midpoint") {
    getTrkXY(object, "midpoint")
})

setGeneric("rangeLocs", function(object) standardGeneric("rangeLocs"))
setMethod("rangeLocs", "hg18track", function(object) {
 co = chrnum(object)
 if (!(all(co == co[1]))) stop("data on multiple chromosomes present; rangeLocs not meaningful")
 cs = pData(featureData(object))$chromStart
 ce = pData(featureData(object))$chromEnd
 an = as.numeric
 c(min(an(cs)), max(an(ce)))
})

setGeneric("chromStarts", function(x)standardGeneric("chromStarts"))
setMethod("chromStarts", "hg18track", function(x) {
 pData(featureData(x))[, "chromStart"]
})

juxtaPlot = function( trk, ssr ) {
 sy = abs(ssr$trat)
 sx = ssr@locs
 sc = ssr@chr
 slab = paste("loc on chr", sc)
 txy = getTrkXY( trk )
 tgn = paste(ssr@gene, "absT")
 df = data.frame( y = sy, x = sx, type=tgn )
 df = rbind(df, data.frame(y = txy$y, x = txy$x, type = "dnaseI"))
 df$type = factor(df$type, levels=c("dnaseI", tgn))
 require(lattice)
 xyplot( y~x| type, data=df, layout=c(1,2), xlab=slab, 
    scales=list(relation=list(y="free")))
}

setGeneric("clip", function(obj, low, hi, attr) 
  standardGeneric("clip"))
setMethod("clip", c("hg18track", "numeric", "numeric", "ANY"),
  function(obj, low, hi, attr) {
   if (missing(attr)) attr="chromStart"
   met = pData(featureData(obj))[[attr]]
   inds = which( met >= low & met <= hi )
   obj[inds, ]
  })
locmax = function (x, y, bin = 50000) {
    fx = x[is.finite(y)]
    fy = y[is.finite(y)]
    coax = floor(fx/bin) * bin
    sy = split(fy, coax)
    list(x = unique(coax), y = sapply(sy, max))
}

alicor = function(x1, y1, x2, y2, bin = 50000) {
    prof1 = locmax(x1, y1, bin)
    prof2 = locmax(x2, y2, bin)
# there is no guarantee that these are on the same domain; use first to define domain
    domx = seq(min(x1), max(x1), bin)
    yon1 = approx(prof1$x, prof1$y, domx)
    yon2 = approx(prof2$x, prof2$y, domx)
    cor(yon1$y, yon2$y)
}

ALICOR = function(ssr, dns=rawCD4, bin=50000) {
 x1 = ssr@locs
 y1 = abs(ssr$trat)
 x2 = chromStarts(dns)+24.5
 y2 = dataVals(dns)
 alicor(x1, y1, x2, y2, bin)
}


wrc = function(x1, y1, x2, y2, dropsize=10000, nrun=3) {
 # weighted recursive coupling
   loc1 = x1[sm1 <- which.max(y1)[1]]
   loc2 = x2[sm2 <- which.max(y2)[1]]
   val1 = abs(y1[sm1])
   kill1 = c(loc1-dropsize, loc1+dropsize)
   x1 = x1[ ok <- which(x1<kill1[1] | x1>kill1[2] )]
   y1 = y1[ok]
   kill2 = c(loc2-dropsize, loc2+dropsize)
   x2 = x2[ ok <- which(x2<kill2[1] | x2>kill2[2] )]
   y2 = y2[ok]
   ans = c(dist=abs(loc1-loc2)/val1,loc=loc1)
 if (nrun > 0) 
   return(c(ans, Recall(x1, y1, x2, y2, dropsize, nrun-1)))
 else return(ans)
}

WRC = function(ssr, dns=d19, dropsize=10000, nrun=2) {
 x1 = ssr@locs
 y1 = abs(ssr$trat)
 x2 = chromStarts(dns)+24.5
 y2 = dataVals(dns)
 ans <- wrc(x1, y1, x2, y2, dropsize=dropsize, nrun=nrun)
 nn = names(ans)[grep("dist", names(ans))]
 ss = strsplit(nn,"\\.")
 ans = t(matrix(ans,nr=2))
 colnames(ans)  = c("score", "loc")
 rownames(ans) = sapply(ss, "[", 2)
 ans
}
