.packageName <- "DNAcopy"
changepoints <- function(genomdat, data.type="logratio", alpha=0.01,
                         nperm=10000, window.size=NULL, overlap=0.25,
                         trim = 0.025, smooth.outliers=TRUE, smooth.region=2,
                         outlier.SD=4, smooth.SD=2, smooth.output=FALSE,
                         undo.splits="none", undo.prune=0.05, undo.SD=3,
                         verbose=TRUE)
  {
    n <- length(genomdat)
    genomdat.orig <- genomdat
    if(smooth.outliers) genomdat <- smooth.data(genomdat.orig, smooth.region, outlier.SD, smooth.SD, trim)
    if(is.null(window.size)) window.size <- n
    seg.end <- c(0,n)
    k <- length(seg.end)
    change.loc <- NULL
    while (k > 1)
      {
        current.n <- seg.end[k]-seg.end[k-1]
        if(verbose) cat("Current segment:",seg.end[k-1]+1,"-",seg.end[k],"\n")
        if(current.n >= 4)
          {
            current.genomdat <- genomdat[(seg.end[k-1]+1):seg.end[k]]
            wsize <- min(current.n, window.size)
            winnum <- ceiling((current.n - wsize)/((1-overlap)*wsize)) + 1
            winloc <- round(seq(0,current.n - wsize,length=winnum))
            zzz <- .Fortran("fndcpt",
                            n=as.integer(current.n),
                            w=as.integer(wsize),
                            wn=as.integer(winnum),
                            wloc=as.integer(winloc),
                            x=as.double(current.genomdat),
                            px=double(current.n),
                            sx=double(wsize),
                            tx=double(wsize),
                            nperm=as.integer(nperm),
                            cpval=as.double(alpha),
                            ncpt=integer(1),
                            icpt=integer(2),
                            ibin=as.logical(data.type=="binary"),
                            PACKAGE="DNAcopy")
          }
        else
          {
            zzz <- list()
            zzz$ncpt <- 0
          }
        if(zzz$ncpt==0) change.loc <- c(change.loc,seg.end[k])
        seg.end <- switch(1+zzz$ncpt,seg.end[-k],
                          c(seg.end[1:(k-1)],seg.end[k-1]+zzz$icpt[1],seg.end[k]),
                          c(seg.end[1:(k-1)],seg.end[k-1]+zzz$icpt,seg.end[k]))
        k <- length(seg.end)
        if(verbose) cat("Segments to go:",seg.end,"\n")
      }
    seg.ends <- rev(change.loc)
    nseg <- length(seg.ends)
    lseg <- diff(c(0,seg.ends))
    if (nseg > 1) {
        if (undo.splits == "prune") {
            lseg <- changepoints.prune(genomdat, lseg, undo.prune)
        }
        if (undo.splits == "sdundo") {
            lseg <- changepoints.sdundo(genomdat, lseg, undo.SD, trim)
        }
    }
    segmeans <- 0*lseg
    if (!smooth.output) genomdat <- genomdat.orig
    ll <- uu <- 0
    for(i in 1:length(lseg)) {
      uu <- uu + lseg[i]
      segmeans[i] <- mean(genomdat[(ll+1):uu])
      ll <- uu
    }
    if (smooth.output) {
      list("smoothed.data"=genomdat, "lseg" = lseg, "segmeans" = segmeans)
    } else {
      list("lseg" = lseg, "segmeans" = segmeans)
    }
  }

changepoints.prune <- function(genomdat, lseg, change.cutoff=0.05) {
  n <- length(genomdat)
  nseg <- length(lseg)
  ncpt <- nseg-1
  zzz <- .Fortran("prune",
                  as.integer(n),
                  as.double(genomdat),
                  as.integer(nseg),
                  as.integer(lseg),
                  as.double(change.cutoff),
                  double(nseg),
                  as.integer(ncpt),
                  loc=integer(ncpt),
                  integer(2*ncpt),
                  pncpt=integer(1), PACKAGE="DNAcopy")
  pruned.ncpt <- zzz$pncpt
  pruned.cpts <- cumsum(lseg)[zzz$loc[1:pruned.ncpt]]
  pruned.lseg <- diff(c(0,pruned.cpts,n))
  pruned.lseg
}

changepoints.sdundo <- function(genomdat, lseg, change.SD=3, trim=0.025) {
  trimmed.SD <- sqrt(trimmed.variance(genomdat, trim))
  change.SD <- trimmed.SD*change.SD
  cpt.loc <- cumsum(lseg)
  sdundo <- TRUE
  while(sdundo) {
    k <- length(cpt.loc)
    if (k>1) {
      segments0 <- cbind(c(1,1+cpt.loc[-k]),cpt.loc)
      segmed <- apply(segments0, 1, function(i,x) {median(x[i[1]:i[2]])}, genomdat)
      adsegmed <- abs(diff(segmed))
      if (min(adsegmed) < change.SD) {
        i <- which(adsegmed == min(adsegmed))
        cpt.loc <- cpt.loc[-i]
      } else {
        sdundo <- FALSE
      }
    } else {
      sdundo <- FALSE
    }
  }
  lseg.sdundo <- diff(c(0,cpt.loc))
  lseg.sdundo
}

trimmed.variance <- function(genomdat, trim=0.025)
  {
    n <- length(genomdat)
    n.keep <- round((1-2*trim)*(n-1))
    inflfact(trim)*sum((sort(abs(diff(genomdat)))[1:n.keep])^2 / (2*n.keep))
  }

inflfact <- function(trim)
  {
    a <- qnorm(1-trim)
    x <- seq(-a,a,length=10001)
    x1 <- (x[-10001] + x[-1])/2
    1/(sum(x1^2*dnorm(x1)/(1-2*trim))*(2*a/10000))
  }
smooth.data <- function(genomdat, smooth.region=2, outlier.SD=4, smooth.SD=2,
                        trim=0.025)
  {
    trimmed.SD <- sqrt(trimmed.variance(genomdat, trim))
    outlier.SD <- outlier.SD*trimmed.SD
    smooth.SD <- smooth.SD*trimmed.SD
    k <- smooth.region
    n <- length(genomdat)
    smoothed.data <- sapply(1:n, function(i, x, n, nbhd, oSD, sSD) {
      xi <- x[i]
      nbhd <- i+nbhd
      xnbhd <- x[nbhd[nbhd>0 & nbhd <=n]]
      if (xi > max(xnbhd) + oSD) xi <- median(c(xi,xnbhd)) + sSD
      if (xi < min(xnbhd) - oSD) xi <- median(c(xi,xnbhd)) - sSD
      xi
    }, genomdat, n, c(-k:-1, 1:k), outlier.SD, smooth.SD)
    smoothed.data
  }

segment <- function(genomdat, chrom, maploc, data.type=c("logratio","binary"),
                    alpha=0.01, nperm=10000, window.size=NULL, overlap=0.25,
                    trim = 0.025, smooth.outliers=TRUE, smooth.region=2,
                    outlier.SD=4, smooth.SD=2, smooth.output=FALSE,
                    undo.splits= c("none","prune","sdundo"), undo.prune=0.05,
                    undo.SD=3, verbose=TRUE)
  {
    if(!is.numeric(genomdat)) stop("genomdat must be numeric")
    if(is.factor(chrom)) chrom <- as.character(chrom)
    if(!is.numeric(maploc)) stop("maploc must be numeric")
    sortindex <- order(chrom, maploc)
    if (is.matrix(genomdat)) {
        genomdat <- genomdat[sortindex, ]
    }
    else {
        genomdat <- genomdat[sortindex]
    }
    if (is.vector(genomdat)) genomdat <- as.matrix(genomdat)
    if (smooth.output) genomdat.smoothed <- matrix(NA, nrow(genomdat), ncol(genomdat))
    nsample <- ncol(genomdat)
    chrom <- chrom[sortindex]
    maploc <- maploc[sortindex]
    uchrom <- unique(chrom)
    data.type <- match.arg(data.type)
    if(data.type=="binary") smooth.outliers <- FALSE
    undo.splits <- match.arg(undo.splits)
    allsegs <- list()
    allsegs$ID <- NULL
    allsegs$chrom <- NULL
    allsegs$loc.start <- NULL
    allsegs$loc.end <- NULL
    allsegs$num.mark <- NULL
    allsegs$seg.mean <- NULL
    for (isamp in 1:nsample) {
      genomdati <- genomdat[,isamp]
      ina <- which(!is.na(genomdati) & !(abs(genomdati)==Inf))
      genomdati <- genomdati[ina]
      chromi <- chrom[ina]
      sample.lsegs <- NULL
      sample.segmeans <- NULL
      for (ic in uchrom) {
        if(verbose) cat(paste("Sample:", isamp, "; chrom:", ic, "\n"))
        segci <- changepoints(genomdati[chromi==ic], data.type, alpha, 
                              nperm,  window.size, overlap, trim, 
                              smooth.outliers, smooth.region, outlier.SD, 
                              smooth.SD, smooth.output, undo.splits, 
                              undo.prune, undo.SD, verbose)
        if (smooth.output) {
          genomdat.smoothed[ina, isamp][chromi==ic] <- segci$smoothed.data
        }
        sample.lsegs <- c(sample.lsegs, segci$lseg)
        sample.segmeans <- c(sample.segmeans, segci$segmeans)
      }
      sample.nseg <- length(sample.lsegs)
      sample.segs.start <- ina[cumsum(c(1,sample.lsegs[-sample.nseg]))]
      sample.segs.end <- ina[cumsum(sample.lsegs)]
      allsegs$ID <- c(allsegs$ID, rep(isamp,sample.nseg))
      allsegs$chrom <- c(allsegs$chrom, chrom[sample.segs.end])
      allsegs$loc.start <- c(allsegs$loc.start, maploc[sample.segs.start])
      allsegs$loc.end <- c(allsegs$loc.end, maploc[sample.segs.end])
      allsegs$num.mark <- c(allsegs$num.mark, sample.lsegs)
      allsegs$seg.mean <- c(allsegs$seg.mean, sample.segmeans)
    }
    allsegs$seg.mean <- round(allsegs$seg.mean, 4)
    if (smooth.output) {
      list(smoothed.data=genomdat.smoothed, output=as.data.frame(allsegs))
    } else {
      list(output=as.data.frame(allsegs))
    }
  }
.First.lib <- function(lib, pkg)
{
    library.dynam("DNAcopy", pkg, lib)
}
