.packageName <- "aCGH"
require(cluster)
require(repeated)

create.aCGH <-
    function(log2.ratios, clones.info, phenotype = NULL)
{
    
    if (nrow(log2.ratios) != nrow(clones.info))
        stop("Number of rows of log2.ratios and clones.info differ!")
    if (!is.null(phenotype) && ncol(log2.ratios) != nrow(phenotype))
        stop("Number of clumns of log2.ratios and number of rows in\
phenotype differ!")
    if (!all(rownames(log2.ratios) == clones.info$Clone))
        rownames(log2.ratios) <- clones.info$Clone
    value <-
        list(log2.ratios = log2.ratios,
             clones.info = clones.info,
             phenotype = phenotype)
    class(value) <- "aCGH"
    attr(value, "call") <- sys.call()
    value
    
}

log2.ratios <- function(aCGH.obj) aCGH.obj$log2.ratios
##"log2.ratios<-" <-
##    function(aCGH.obj, value)
##{

##    if (!is.aCGH(aCGH.obj))
##	stop("object is not of class aCGH")
##    if (any(dim(value) != dim(aCGH.obj$log2.ratios)))
##        stop("invalid replacement dimensions")
##    aCGH.obj$log2.ratios <- value
##    aCGH.obj

##}

clones.info <- function(aCGH.obj) aCGH.obj$clones.info
##"clones.info<-" <-
##    function(aCGH.obj, value)
##{

##    if (!is.aCGH(aCGH.obj))
##	stop("object is not of class aCGH")
##    if (any(dim(value) != dim(aCGH.obj$clones.info)))
##        stop("invalid replacement dimensions")
##    aCGH.obj$clones.info <- value
##    aCGH.obj

##}

is.aCGH <- function(aCGH.obj) inherits(aCGH.obj, "aCGH")

dim.aCGH <- function(aCGH.obj) dim(aCGH.obj$log2.ratios)

num.clones <- nrow.aCGH <-
    function(aCGH.obj) nrow(aCGH.obj$log2.ratios)

num.samples <- ncol.aCGH <-
    function(aCGH.obj) ncol(aCGH.obj$log2.ratios)

num.chromosomes <- function(aCGH.obj) length(unique(aCGH.obj$clones.info$Chrom))

clone.names <- row.names.aCGH <- rownames.aCGH <-
    function(x) x$clones.info$Clone
"clone.names<-" <- "row.names<-.aCGH" <- "rownames<-.aCGH" <-
    function(x, value)
{
    
    if (!is.aCGH(x))
	stop("object is not of class aCGH")
    if (length(value) != length(x$clones.info$Clone))
        stop("invalid replacement dimensions")
    row.names(x$clones.info$Clone) <- as.factor(value)
    x
    
}

colnames.aCGH <- col.names.aCGH <- sample.names <-
    function(aCGH.obj) colnames(aCGH.obj$log2.ratios)
"colnames<-.aCGH" <- "col.names<-.aCGH" <- "sample.names<-" <-
    function(aCGH.obj, value)
{
    
    if (!is.aCGH(aCGH.obj))
	stop("object is not of class aCGH")
    if (length(value) != ncol(aCGH.obj$log2.ratios))
        stop("invalid replacement dimensions")
    colnames(aCGH.obj$log2.ratios) <- value
    aCGH.obj
    
}

impute.lowess <-
    function(aCGH.obj, chrominfo = human.chrom.info.Jul03,
             maxChrom = 23, smooth = 0.1)
{

    data.imp <- log2.ratios <- log2.ratios(aCGH.obj)
    clones.info <- clones.info(aCGH.obj)
    for (j in 1:maxChrom)
    {
        
        cat("Processing chromosome ", j, "\n")
        centr <- chrominfo$centromere[j]
        indl <-
            which(clones.info$Chrom == j & clones.info$kb < centr)
        indr <-
            which(clones.info$Chrom == j & clones.info$kb > centr)
        kbl <- clones.info$kb[indl]
        kbr <- clones.info$kb[indr]
	
        for (i in 1:ncol(log2.ratios))
        {
            
            ##print(i)
            if (length(indl) > 0)
            {
                
                vecl <- log2.ratios[indl, i]
                ind <- which(!is.na(vecl))
                if (length(ind) > 0)
                    data.imp[indl, i][-ind] <-
                        approx(lowess(kbl[ind], vecl[ind], f = smooth),
                               xout = kbl[-ind])$y
                
            }
            if (length(indr) > 0)
            {
                
                vecr <- log2.ratios[indr, i]
                ind <- which(!is.na(vecr))
                if (length(ind) > 0)
                    data.imp[indr, i][-ind] <-
                        approx(lowess(kbr[ind], vecr[ind], f = smooth),
                               xout = kbr[-ind])$y
                
            }
            
        }
        
    }

#################
###now, if any missing value are left 
    
    prop.miss <- apply(data.imp, 2, prop.na)
    ## if any samples contain missing values
    if (max(prop.miss, na.rm = TRUE) > 0)
    {
        
        for (i in 1:ncol(data.imp))
        {
            
            vec <- (as.matrix(data.imp))[,i]
            ind <- which(is.na(vec))
            if (length(ind) > 0)
            {
                
                vec[ind] <-
                    sapply(ind,
                           function(i) {

                               chr <- clones.info$Chrom[i]
                               kb <- clones.info$kb[i]
                               if (kb >= chrominfo$centromere[chr])
                                   median(vec[clones.info$Chrom == chr
                                              & clones.info$kb >=
                                              chrominfo$centromere[chr]],
                                          na.rm = TRUE)
                               else
                                   median(vec[clones.info$Chrom == chr
                                              & clones.info$kb <
                                              chrominfo$centromere[chr]],
                                          na.rm = TRUE)
                               
                           }
                           )

                ##if all values on chrom are missing
                vec[is.na(vec)] <- 0
                data.imp[,i] <- vec
            
            }
            
        }
        
    }
    prop.miss <- apply(data.imp, 2, prop.na)
    if (max(prop.miss) > 0)
        print(paste("Missing values still remain in samples ",
                    which(prop.miss > 0)))
    
    data.imp
    
}

log2.ratios.imputed <-
    function(aCGH.obj)
    aCGH.obj$log2.ratios.imputed

"log2.ratios.imputed<-" <-
    function(aCGH.obj, value)
{

    if (!is.aCGH(aCGH.obj))
	stop("object is not of class aCGH")
    if (!is.null(aCGH.obj$log2.ratios.imputed) &&
        any(dim(value) != dim(aCGH.obj$log2.ratios.imputed)))
        stop("invalid replacement dimensions")
    aCGH.obj$log2.ratios.imputed <- value
    aCGH.obj

}

find.hmm.states <-
    function(aCGH.obj, ...)
    hmm.run.func(aCGH.obj$log2.ratios,
                 aCGH.obj$clones.info, ...)

hmm <- function(aCGH.obj) aCGH.obj$hmm
"hmm<-" <-
    function(aCGH.obj, value)
{

    if (!is.aCGH(aCGH.obj))
	stop("object is not of class aCGH")
    if (!is.null(aCGH.obj$hmm))
    {
        
        nstates.ok <-
            all(
                sapply(1:length(aCGH.obj$hmm$nstates.hmm),
                       function(i)
                       all(dim(aCGH.obj$hmm$nstates.hmm[[i]]) ==
                           dim(value$nstates.hmm[[i]]))
                       )
                )
        states.ok <-
            all(
                sapply(1:length(aCGH.obj$hmm$states.hmm),
                       function(i)
                       all(dim(aCGH.obj$hmm$states.hmm[[i]]) ==
                           dim(value$states.hmm[[i]]))
                       )
                )
        if (!nstates.ok || !states.ok)
            stop("invalid replacement dimensions")

    }
    aCGH.obj$hmm <- value
    aCGH.obj

}

computeSD.Samples <-
    function(aCGH.obj, minDiff = .25, maxChrom = 22, maxmadUse = .3,
             maxmedUse = .5, maxState = 3, minClone = 20, modelUse=1)
{

    if (is.null(hmm(aCGH.obj)))
        stop("compute the hmm states first using find.hmm.states\
function")
    hmm <- hmm(aCGH.obj)
    hmm.res.merge <-
        mergeFunc(statesres = hmm$states.hmm[[modelUse]],
                  minDiff = minDiff)

    ##extracting statesMatrix

    states.bic <- hmm.res.merge$states.hmm

    ##computing SD of the tumor and sd on individual chromosomes

    computeSD.func(statesres = states.bic, maxmadUse = maxmadUse,
                   maxmedUse = maxmedUse, maxState = maxState,
                   minClone = minClone, maxChrom = maxChrom)
    
}

sd.samples <- function(aCGH.obj) aCGH.obj$sd.samples
"sd.samples<-" <-
    function(aCGH.obj, value)
{

    if (!is.aCGH(aCGH.obj))
	stop("object is not of class aCGH")
    if (!is.null(aCGH.obj$sd.samples))
    {
        
        sd.samples.ok <-
            all(
                sapply(1:length(aCGH.obj$sd.samples),
                       function(i)
                       all(dim(aCGH.obj$sd.samples[[i]]) == dim(value[[i]]))
                       )
                )
        if (sd.samples.ok)
            stop("invalid replacement dimensions")

    }
    aCGH.obj$sd.samples <- value
    aCGH.obj

}

find.genomic.events <-
    function(aCGH.obj, maxChrom = 23, minDiff = .25, modelUse = 1,
             factor = 5, maxClones = 1, maxLen = 1000,
             absValSingle = 1, absValRegion = 1, diffVal1 = 1,
             diffVal2 = .5, maxSize = 10000, pChrom.min = .9,
             medChrom.min = .1)
{

    if (is.null(hmm(aCGH.obj)))
        stop("compute the hmm states first using find.hmm.states\
function")
    if (is.null(sd.samples(aCGH.obj)))
        stop("compute the std. dev. of aCGH using computeSD.Samples\
function")
    data <- log2.ratios(aCGH.obj)
    clones.info <- clones.info(aCGH.obj)
    hmm <- hmm(aCGH.obj)
    sd.samples <- sd.samples(aCGH.obj)
###    ind.samples <- (1:ncol(data))
    ncols <- ncol(data)

    hmm.res.merge <-
        mergeFunc(statesres = hmm$states.hmm[[modelUse]],
                   minDiff = minDiff)
    statesMatrix <- hmm.res.merge$states.hmm
    ##identifies outliers (factor times SD from the the median of the state)
    cat("Finding outliers\n")
    outliers <-
        findOutliers.func(thres = sd.samples$madGenome, factor =
                          factor, statesres = statesMatrix)
    ##identifies focal low level aberrations
    cat("Finding focal low level aberrations\n")
    aberrations <-
        findAber.func(maxClones = maxClones, maxLen = maxLen, statesres =
                      statesMatrix)
    ##identifies transitions: start and end of the states  
    cat("Finding transitions\n")
    transitions <-
        findTrans.func(outliers = outliers$outlier,
                       aber = aberrations$aber,
                       statesres = statesMatrix)
    ##identifies focal amplifications
    cat("Finding focal amplifications\n")
    amplifications <-
        findAmplif.func(absValSingle = absValSingle,
                        absValRegion = absValRegion,
                        diffVal1 = diffVal1, diffVal2 = diffVal2,
                        maxSize = maxSize,
                        translen.matr = transitions$translen.matrix,
                        trans.matr = transitions$trans.matr,
                        aber = aberrations$aber,
                        outliers = outliers$outlier,
                        pred = outliers$pred.out,
                        pred.obs = outliers$pred.obs.out,
                        statesres = statesMatrix)
    
    ##number of transitions per chromosome
    numTrans <- matrix(0, nrow = maxChrom, ncol = ncols)
    ##number of amplifications per chromosome
    numAmplif <- matrix(0, nrow = maxChrom, ncol = ncols)
    ##number of aberrations per chromosome
    numAber <- matrix(0, nrow = maxChrom, ncol = ncols)
    ##number of outliers per chromosome
    numOutlier <- matrix(0, nrow = maxChrom, ncol = ncols)
    ##number of chromosomes containing at least one transition
    numTrans.binary <- matrix(0, nrow = maxChrom, ncol = ncols)
    ##number of chromosomes containing at least one focal amplification
    numAmplif.binary <- matrix(0, nrow = maxChrom, ncol = ncols)
    ##number of chromosomes containing at least one focal aberration
    numAber.binary <- matrix(0, nrow = maxChrom, ncol = ncols)
    ##number of chromosomes containing at least one outlier
    numOutlier.binary <- matrix(0, nrow = maxChrom, ncol = ncols)
    ## whole chromosome gain or loss
    wholeChromGainLoss <- matrix(0, nrow = maxChrom, ncol = ncols)
    sizeAmplicon <- numAmplicon <-
        matrix(0, nrow = maxChrom, ncol = ncols)
    propClones <-  matrix(0, nrow = maxChrom, ncol = ncols)
    pvClones <-  matrix(0, nrow = maxChrom, ncol = ncols)
    medClones <- matrix(0, nrow = maxChrom, ncol = ncols)
    p.min <- pChrom.min
    pv.max <- .0001
    med.min <- medChrom.min
    chr <- clones.info(aCGH.obj)$Chrom
    kb <- clones.info(aCGH.obj)$kb

    for (j in 1:maxChrom)
    {

        cat("Processing chromosome ", j, "\n")
        ind <- chr == j
        trans <- transitions$trans.matrix[ ind, ,drop = FALSE]
        amplif <- amplifications$amplif[ ind, ,drop = FALSE]
        aber <- aberrations$aber[ ind, ,drop = FALSE]
        outlier <- outliers$outlier[ ind, ,drop = FALSE]
        for (i in 1:ncols)
        {

            numTrans[j, i] <- sum(trans[ ,i] == 1)
            if (numTrans[j, i] > 0)
                numTrans.binary[j, i] <- 1
            else # if no transitions
            {

                ##observed values
                obs <- data[ind, i]
                ##exclude aberrations and outliers
                obs <- obs[aber[ ,i ] == 0 & outlier[ ,i ] == 0]
                ##exclude missing values
                obs <- obs[!is.na(obs)]
                p <- 
                    if (median(obs) >= 0)
                        length(obs[obs>0])/length(obs)
                    else
                        length(obs[obs<0])/length(obs)
                propClones[j, i] <- p
                pv <-
                    1 - pnorm((p - .5) / sqrt((.5 ^ 2) / length(obs)))
                pvClones[j, i] <- pv
                medClones[j, i] <- median(obs)
                #if ((p < .95) && (p >= .9) &&
                #    (abs(median(obs)) >= .15))
                #    print(c(j,i))
                if ((p >= p.min) && (abs(median(obs)) >= med.min))
                {
                    
                    if (pv <= pv.max)
                        wholeChromGainLoss[j, i] <- 
                            if (median(obs) >= 0)
                                1
                            else
                                -1
                    
                }
                else
                    wholeChromGainLoss[j, i] <- 0
                
            }
            numAmplif[j,i] <- sum(amplif[ ,i ] == 1)
            if (numAmplif[j,i] > 0)
                numAmplif.binary[j,i] <- 1
            numAber[j,i] <- sum(aber[ ,i ] == 1)
            if (numAber[j,i] > 0)
                numAber.binary[j,i] <- 1
            numOutlier[j,i] <- sum(outlier[ ,i ] == 1)
            if (numOutlier[j,i] > 0)
                numOutlier.binary[j,i] <- 1
            try1 <- diff(amplif[ ,i ])
            tmps <- which(try1 == 1) + 1
            tmpe <- which(try1 == -1)
            if (length(tmps) > length(tmpe))
                ##last clone
                tmpe <- c(tmpe, length(ind))
            if (length(tmps) < length(tmpe))
                ##first clone
                tmps <- c(1, tmps)
            if (length(tmpe) == length(tmps))
            {

                kb.ind <- kb[ind]
                tmplen <-
                    (kb.ind[tmpe] - kb.ind[tmps]) +
                        rep(1000, length(tmpe))
                sizeAmplicon[j, i] <- sum(tmplen)
                numAmplicon[j, i] <- length(tmpe)
                
            }
            
	}
        
    }

    list(num.transitions = numTrans,
         num.amplifications = numAmplif,
         num.aberrations = numAber,
         num.outliers = numOutlier,
         num.transitions.binary = numTrans.binary,
         num.amplifications.binary = numAmplif.binary,
         num.aberrations.binary = numAber.binary,
         num.outliers.binary = numOutlier.binary,
         whole.chrom.gain.loss = wholeChromGainLoss,
         size.amplicons = sizeAmplicon,
         num.amplicons = numAmplicon,
         outliers = outliers,
         aberrations = aberrations,
         transitions = transitions,
         amplifications = amplifications
         )
    
}

genomic.events <- function(aCGH.obj) aCGH.obj$genomic.events
"genomic.events<-" <-
    function(aCGH.obj, value)
{

    if (!is.aCGH(aCGH.obj))
	stop("object is not of class aCGH")
    if (!is.null(aCGH.obj$genomic.events))
    {
        
        events.ok <-
            all(
                sapply(1:length(aCGH.obj$genomic.events),
                       function(i)
                       all(dim(aCGH.obj$genomic.events[[i]]) ==
                           dim(value[[i]]))
                       )
                )
        if (events.ok)
            stop("invalid replacement dimensions")

    }
    aCGH.obj$genomic.events <- value
    aCGH.obj

}

phenotype <- function(aCGH.obj) aCGH.obj$phenotype
"phenotype<-" <-
    function(aCGH.obj, value)
{

    if (!is.aCGH(aCGH.obj))
	stop("object is not of class aCGH")
    if (nrow(value) != ncol(aCGH.obj$log2.ratios))
        stop("number of observations differs between the old and new\
phenotypes")
    aCGH.obj$phenotype <- value
    aCGH.obj

}

subset.hmm <-
    function(x, ...)
{
    
    ll <- list(...)
    i <- 
        if (is.null(ll$i))
            1:nrow(x$states.hmm[[1]])
        else
            ll$i
    j <- 
        if (is.null(ll$j))
            1:ncol(x$nstates.hmm[[1]])
        else
            ll$j
    chroms <- 
        if (is.null(ll$chroms))
            1:nrow(x$nstates.hmm[[1]])
        else
            ll$chroms
    with(x,
         list(nstates.hmm =
              lapply(nstates.hmm,
                     function(nstates) nstates[chroms ,j]
                     ),
              states.hmm =
              lapply(states.hmm,
                     function(states)
                     states[i,
                            c(1:2,
                              as.vector(
                                        sapply(j,
                                               function(k)
                                               (3 + (k - 1) * 6):(2 + k * 6)
                                               )
                                        )
                              )
                            ]
                     )
              )
         )

}

"[.aCGH" <-
    function(aCGH.obj, i, j, keep = FALSE)
{

    drop.i <- missing(i)
    drop.j <- missing(j)
    if (drop.i && drop.j)
        aCGH.obj
    else
    {

        if (drop.i)
            i <- 1:nrow(aCGH.obj)
        else
            if (mode(i) == "logical")
                i <- which(i)
        if (drop.j)
            j <- 1:ncol(aCGH.obj)
        else
            if (mode(j) == "logical")
                j <- which(j)
        res <-
            if (keep)
                list(log2.ratios = aCGH.obj$log2.ratios[i, j],
                     clones.info = aCGH.obj$clones.info[ i, ],
                     qual.rep = NULL,
                     bad.quality.index = NULL,
                     log2.ratios.imputed =
                     if (is.null(aCGH.obj$log2.ratios.imputed)) NULL
                     else aCGH.obj$log2.ratios.imputed[i, j],
                     sd.samples =
                     if (is.null(aCGH.obj$sd.samples)) NULL
                     else 
                     with(aCGH.obj$sd.samples,
                          list(madChrom = madChrom[ ,j ],
                               madGenome = madGenome[j]
                               )
                          ),
                     genomic.events =
                     if (is.null(aCGH.obj$genomic.events)) NULL
                     else 
                     lapply(aCGH.obj$genomic.events,
                            function(el)
                            if (is.matrix(el)) el[ ,j ]
                            else
                            lapply(el, function(el1) el1[i, j])
                            ),
                     hmm = if (is.null(hmm(aCGH.obj))) NULL
                     else
                     subset.hmm(hmm(aCGH.obj), i = i, j = j,
                                chroms =
                                which(table(clones.info(aCGH.obj)$Chrom[i]) > 0)
                                ),
                     phenotype =
                     if (is.null(aCGH.obj$phenotype)) NULL
                     else aCGH.obj$phenotype[j, , drop = FALSE]
                     )
            else
            {
                
                warning("For now just subsetting the log2.ratios\
and phenotype. Please rerun the find.hmm.states function!")
                list(log2.ratios =
                     aCGH.obj$log2.ratios[i, j, drop = FALSE],
                     clones.info =
                     aCGH.obj$clones.info[i, , drop = FALSE],
                     qual.rep = NULL,
                     bad.quality.index = NULL,
                     log2.ratios.imputed =
                     if (is.null(aCGH.obj$log2.ratios.imputed)) NULL
                     else aCGH.obj$log2.ratios.imputed[i, j, drop = FALSE],
                     sd.samples = NULL,
                     genomic.events = NULL,
                     hmm = NULL,
                     phenotype =
                     if (is.null(aCGH.obj$phenotype)) NULL
                     else aCGH.obj$phenotype[j, , drop = FALSE]
                     )

            }
        attr(res, "call") <- sys.call()
        class(res) <- "aCGH"
        res

    }
    
}

print.aCGH <-
    function(x, ...)
{

    cat("aCGH object\nCall: ")
    print(attr(x, "call"), ...)
    cat("\nNumber of Arrays", ncol(x),
        "\nNumber of Clones", nrow(x), "\n")

}

summary.aCGH <-
    function(object, ...)
{
    
    print.aCGH(object, ...)
    if (!is.null(log2.ratios.imputed(object)))
        cat("Imputed data exist\n")
    else
        cat("Imputed data does not exist\n")
    if (!is.null(hmm(object)))
        cat("HMM states assigned\n")
    else
        cat("HMM states are not assigned\n")
    if (!is.null(sd.samples(object)))
        cat("samples standard deviations are computed\n")
    else
        cat("samples standard deviations are not computed\n")
    if (!is.null(genomic.events(object)))
        cat("genomic events are assigned\n")
    else
        cat("genomic events are not assigned\n")
    if (!is.null(phenotype(object)))
        cat("phenotype exists\n")
    else
        cat("phenotype does not exists\n")

}

plot.aCGH <-
    function(x, ...)
{

    ll <- list(...)
    if (!is.null(ll$imp) && ll$imp)
        dat <- as.matrix(log2.ratios.imputed(x))
    else
        dat <- as.matrix(log2.ratios(x))
    heatmap(dat, Rowv = NA, main = "Heatmap",
            labCol = sample.names(x))

}

minna <-
    function(x)
    min(x, na.rm = TRUE)

maxna <-
    function(x)
    max(x, na.rm = TRUE)

corna <-
    function(x)
    cor(x, use = "pairwise.complete.obs")

floor.func <-
    function(x, floor, x.na = x[!is.na(x)])
{
    x[!is.na(x)] <-
        ifelse(x.na > floor,
               floor,
               ifelse(x.na < -floor, -floor, x.na)
               )
    x
    
}

length.num.func <-
    function(x, num)
    sapply(num, function(i) sum(x == i, na.rm = TRUE))

prop.num.func <-
    function(x, num)
    sapply(num, function(i) mean(x == i, na.rm = TRUE))
plotGenome <-
    function(aCGH.obj, samples = 1:num.samples(aCGH.obj), naut = 22,
             Y = TRUE, X = TRUE, data = log2.ratios(aCGH.obj),
             chrominfo = human.chrom.info.Jul03, yScale = c(-2, 2),
             samplenames = sample.names(aCGH.obj), ylb = "Log2Ratio")
{

    datainfo <- clones.info(aCGH.obj)
    ##total number of chromosomes to plot:
    
    nchr <- naut
    if (X)
	nchr <- nchr+1
    if (Y)
        nchr <- nchr+1
    
    nsamples <- length(samplenames)
    
    ##reordering according to genomic position
    ord <- order(datainfo$Chrom, datainfo$kb)
    chrom <- datainfo$Chrom[ord]
    kb <- datainfo$kb[ord]
    data <- data[ord,]
    
    ##screening out unampped clones
    ind.unmap <- which(is.na(chrom) | is.na(kb) | (chrom > (naut+2)))
    if (length(ind.unmap) > 0)
	{
 	   chrom <- chrom[-ind.unmap]
    	kb <- kb[-ind.unmap]
    	data <- data[-ind.unmap,]
	}
    
    ##removing chromosome not to plot:
    data <- data[chrom <= nchr,]
    kb <- kb[chrom <= nchr]
    chrom <- chrom[chrom <= nchr]

    chrominfo <- chrominfo[1:nchr,]
    chrom.start <- c(0, cumsum(chrominfo$length))[1:nchr]
    chrom.centr <- chrom.start + chrominfo$centr
    chrom.mid <- chrom.start + chrominfo$length / 2
    chrom.rat <- chrominfo$length / max(chrominfo$length)

    par(cex = .6, pch = 18, lab = c(1, 6, 7), cex.axis = 1.5,
        xaxs = "i")
    for (k in (1:length(samples)))
    {

        vec <- data[ ,samples[k] ]
        name <- samplenames[samples[k]]

        clone.genomepos <- rep(0, length(kb))
        for (i in 1:nrow(chrominfo))
            clone.genomepos[chrom == i] <-
                kb[chrom == i] + chrom.start[i]

        ##Now, determine vertical scale for each chromosome:

        y.min <- rep(yScale[1], nrow(chrominfo))
        y.max <- rep(yScale[2], nrow(chrominfo))

        for (i in 1:nrow(chrominfo))
        {

            if (minna(vec[(chrom==i)]) < y.min[i])
                y.min[i] <- minna(vec[(chrom==i)])
            if (maxna(vec[(chrom==i)]) > y.max[i])
                y.max[i] <- maxna(vec[(chrom==i)])

        }

        ##set genome scale to the min and mx values of the rest of the chromosomes:

        ygenome.min <- minna(y.min)
        ygenome.max <- maxna(y.max)
        
#########################
        
        plot(clone.genomepos / 1000, vec,
             ylim = c(ygenome.min, ygenome.max), xlab = "", ylab = "",
             xlim =
             c(min(clone.genomepos[clone.genomepos > 0], na.rm = TRUE) /
               1000,
               clone.genomepos[sum(clone.genomepos>0)] / 1000),
             col="black")
        
        
        ##title(main=paste(name, " ", sample[k], " - Whole Genome"),
        ##ylab=ylb, xlab="Chromosome", cex.lab=1.5,cex.main=2)
        title(main = paste(samples[k], " ", name), ylab = ylb,
              xlab = "", cex.lab = 1.5, cex.main = 2)
        
        for (i in seq(1,naut,b=2))
            mtext(paste("", i), side = 1, at = (chrom.mid[i]/1000),
                  line=.3, col="red")
        for (i in seq(2,naut,b=2))
            mtext(paste("", i), side = 3, at = chrom.mid[i] / 1000,
                  line=.3, col="red")
        
        if (X)
            mtext("X", side = 1, at = chrom.mid[naut + 1] / 1000,
                  line=.3, col="red")
        if (Y)
            mtext("Y", side = 3, at = chrom.mid[naut + 2] / 1000,
                  line=.3, col="red")
        
        abline(v = c(chrom.start / 1000,
               (chrom.start[nrow(chrominfo)] +
                chrominfo$length[nrow(chrominfo)]) / 1000), lty = 1)
        ##abline(h=seq(ygenome.min,ygenome.max, b=.2), lty=3)
        abline(h = seq(-1,1, b=.5), lty = 3)
        abline(v = (chrominfo$centromere + chrom.start) / 1000,
               lty = 3, col = "red")
        
    }
    
}

###############################

plotSummaryProfile <-
    function(aCGH.obj, response = as.factor(rep("All", ncol(aCGH.obj))),
             titles = unique(response[!is.na(response)]),X = TRUE, Y = FALSE,
             maxChrom = 23, chrominfo = human.chrom.info.Jul03)
{

    if (is.null(genomic.events(aCGH.obj)))
        stop("compute the genomic events first using\
find.genomic.events")
    ind.samp <- which(!is.na(response))
    resp.na <- response[ind.samp]
    response.uniq <- sort(unique(resp.na))
    ge <- genomic.events(aCGH.obj)

###    length.num.func <-
###        function(x, num)
###            sapply(num, function(nn) sum(x == nn & !is.na(x)))

    df.not.na <-
        data.frame(response = response,
                   numtrans =
                   apply(ge$num.transitions, 2, sum, na.rm = TRUE),
                   numtrans.binary =
                   apply(ge$num.transitions.binary, 2, sum, na.rm = TRUE),
                   numaber =
                   apply(ge$num.aberrations, 2, sum, na.rm = TRUE),
                   numaber.binary =
                   apply(ge$num.aberrations.binary, 2, sum, na.rm = TRUE),
                   numamplif =
                   apply(ge$num.amplifications[ 1:maxChrom, ], 2, sum,
                         na.rm = TRUE),
                   numamplif.binary =
                   apply(ge$num.amplifications.binary[ 1:maxChrom, ],
                         2, sum, na.rm = TRUE),
                   numoutlier =
                   apply(ge$num.outliers, 2, sum, na.rm = TRUE),
                   num.outliers.binary =
                   apply(ge$num.outliers.binary, 2, sum, na.rm = TRUE),
                   numchromgain =
                   apply(ge$whole.chrom.gain.loss[ 1:maxChrom, ], 2,
                         length.num.func, 1),
###                   apply(ge$whole.chrom.gain[ 1:maxChrom, ], 2, sum,
###                         na.rm = TRUE),
                   numchromloss =
                   apply(ge$whole.chrom.gain.loss[ 1:maxChrom, ], 2,
                         length.num.func, -1),
###                   apply(ge$whole.chrom.loss[ 1:maxChrom, ], 2, sum,
###                         na.rm = TRUE)
                   sizeamplicon =
                   apply(ge$size.amplicons[ 1:maxChrom, ], 2, sum,
                         na.rm = TRUE),
                   numamplicon =
                   apply(ge$num.amplicons[ 1:maxChrom, ], 2, sum,
                         na.rm = TRUE)
                   )[ which(!is.na(response)), ]
    attach(df.not.na)
    numchromchange <- numchromgain + numchromloss
    
    boxplot.this <-
        function(ge, title, sig = 6)
        {

            p.value <-
                if (length(response.uniq) > 1)	
                    signif(kruskal.test(ge ~ resp.na)$p.value, sig)
                else
                    ""
            boxplot(ge ~ resp.na, notch = TRUE, names = titles,
                    varwidth = TRUE, main = paste(title, p.value))
            
        }

#############################################
    ##Plot1:
    par(mfrow = c(2, 2))

    boxplot.this(numtrans, "Number of Transitions")
    boxplot.this(numtrans.binary,
                 "Number of Chrom containing Transitions")
    boxplot.this(numaber, "Number of Aberrations")
    boxplot.this(numchromchange, "Number of Whole Chrom Changes")

#############################################
    ##Plot2:
    
    boxplot.this(numamplif, "Number of Amplifications")
    boxplot.this(numamplif.binary,
                 "Number of Chrom containing Amplifications")
    boxplot.this(numamplicon, "Number of Amplicons")
    boxplot.this(sizeamplicon, "Amount of Genome Amplified")

#############################################

    plot.freq.this <-
        function(matr, i, ylb)
        {
            
            par(mfrow = c(length(titles), 1))

            out <-
                sapply(1:length(response.uniq),
                       function(j)
                       apply(matr[
                                  ,which(resp.na == response.uniq[j])
                                  ],
                             1,
                             prop.num.func,
                             i
                             )
                       )
            mx <- max(c(out), na.rm = TRUE)
            if (length(titles == 1))
                out <- cbind(out, out)
            
            plotGenome(aCGH.obj, samples = 1:length(titles),
                       yScale = c(0, mx), data = out, naut = 22,
                       X = X, Y = Y, ylb = ylb,
                       chrominfo = chrominfo[ 1:maxChrom, ],
                       samplenames = titles
                       )
            
        }
    
    ##Plot3: trans start
    plot.freq.this(ge$transitions$trans.matrix, 1,
                  "Proportion of Transition Starts")

    ##Plot4: trans end
    plot.freq.this(ge$transitions$trans.matrix, 2,
                  "Proportion of Transition Ends")

    ##Plot5: amplification
    plot.freq.this(ge$amplifications$amplif, 1,
                  "Proportion of Amplifications")
    mtext("Amplifications", side = 3, outer = TRUE)

    ##Plot6: aberration
    plot.freq.this(ge$aberrations$aber, 1,
                   "Proportion of Aberrations")
    mtext("Aberrations", side = 3, outer = TRUE)

    ##Plot7: whole chromosomal gain/loss:

    par(mfrow = c(length(titles), 2), lab = c(5,6,7))
    
    matr <- ge$whole.chrom.gain.loss[ 1:22, ]
    out.gain <- matrix(NA, nrow = nrow(matr), ncol = length(titles))
    out.loss <- matrix(NA, nrow = nrow(matr), ncol = length(titles))
    for (j in 1:length(response.uniq))
    {
        
        ind <- which(response == response.uniq[j])
        out.gain[ ,j ] <-
            apply(matr[ ,ind ], 1, length.num.func, 1) / ncol(matr)
        out.loss[ ,j ] <-
            apply(matr[ ,ind ], 1, length.num.func, -1) / ncol(matr)
        
    }
    mx.gain <- max(c(out.gain), na.rm = TRUE)
    mx.loss <- max(c(out.loss), na.rm = TRUE)
    mx <- max(mx.gain, mx.loss)
    for (j in 1:length(titles))
    {
        
        plot(1:22, out.gain[,j], pch = 20,
             main = as.character(titles[j]),
             xlab = "chromosome",
             ylab = "Proportion of whole chromosomes gains",
             ylim = c(0, mx), xlim = c(0,23))
        plot(1:22, out.loss[,j], pch = 20,
             main = as.character(titles[j]),
             xlab = "chromosome",
             ylab = "Proportion of whole chromosomes losses",
             ylim = c(0, mx), xlim = c(0,23))
        
    }
    detach(df.not.na)

}	

plotHmmStates <-
    function(aCGH.obj, sample.ind, chr = 1:num.chromosomes(aCGH.obj),
             statesres = hmm(aCGH.obj)$states.hmm[[1]],
             maxChrom = 23, chrominfo = human.chrom.info.Jul03,
             yScale = c(-2, 2), samplenames = sample.names(aCGH.obj)
             )
{

    if (length(sample.ind) > 1)
        stop("plotHmmStates currently prints only 1 sample at a\
time\n")
    if (is.null(genomic.events(aCGH.obj)))
        stop("compute the genomic.events of aCGH.obj first using\
find.genomic.events function")
    
###    hmm.res.merge <- merge.func(statesres = statesres, minDiff = .25)
###    states.bic <- hmm.res.merge$states.hmm
    ge <- genomic.events(aCGH.obj)
    aber <- ge$aberrations$aber
    amplif <- ge$amplifications$amplif
    trans <- ge$transitions$trans.matr
    outliers <- ge$outliers$outlier
    pred <- ge$outliers$pred.out

    chrom.rat <- chrominfo$length / max(chrominfo$length)
    chrom.start <- c(0, cumsum(chrominfo$length))[1:maxChrom]
    
    ##chrom.mid contains middle positions of the chromosomes relative to
    ##the whole genome (useful for plotting the whole genome)
    chrom.mid <- chrom.start + chrominfo$length[1:maxChrom] / 2
    chrom <- statesres[ ,1 ]
    par(lab = c(15, 6, 7), pch = 18, cex = 1, lwd = 1,
        mfrow = c(2, 1))
    
    sq.state <- seq(3, ncol(statesres), b = 6)
    sq.obs <- seq(8, ncol(statesres), b = 6)
    
    for (j in 1:length(chr))
    {

        ind.nonna <-
            which(!is.na(statesres[chrom == chr[j],
                                   sq.obs[sample.ind]]))

        kb <- statesres[chrom == chr[j], 2][ind.nonna] / 1000
        obs <- statesres[chrom == chr[j],
                         sq.obs[sample.ind]][ind.nonna]
        states <-
            statesres[chrom == chr[j],
                      sq.state[sample.ind]][ind.nonna]
        nstates <- length(unique(states)) 

        abernow <- aber[chrom == chr[j], sample.ind][ind.nonna]
        outliersnow <-
            outliers[chrom == chr[j], sample.ind][ind.nonna]
        amplifnow <- amplif[chrom == chr[j], sample.ind][ind.nonna]
        transnow <- trans[chrom == chr[j], sample.ind][ind.nonna]

        ## predicted values when non-aberration of outlier: otherwise
        ## observed
        
        prednow <- obs
        predicted <- pred[chrom == chr[j], sample.ind][ind.nonna]
        prednow[outliersnow == 0 & abernow == 0] <-
            predicted[outliersnow == 0 & abernow == 0]

        y.min <- min(yScale[1], min(obs))
        y.max <- max(yScale[2], max(obs))

        ##observed

        plot(kb, obs, xlab = "", ylab = "", ylim = c(y.min, y.max),
             type = "l", col = "blue",
             xlim = c(0, chrominfo$length[chr[j]] / 1000)
             )
        points(kb, obs, col = "black")
        title(main = paste("Sample", sample.ind,
              samplenames[sample.ind], "- Chr", chr[j],
              "Number of states", nstates),
              xlab = "kb (in 1000's)", ylab = "data (observed)"
              )
        
        abline(h = seq(-2, 2, b = .5), lty = 3)
        abline(v = chrominfo$centromere[chr[j]] / 1000, lty = 2,
               col = "red", lwd = 3)

        if (nstates > 1)
        {
            
            abline(v = kb[transnow == 1], col = "blue", lwd = 2)
            abline(v = kb[transnow == 2], col = "green", lty = 2,
                   lwd = .5)
            
        }

        ##amplif = red
        ##aber = orange
        ##outliers = yellow

        if (length(outliersnow[outliersnow == 1]) > 0)
            points(kb[outliersnow == 1], obs[outliersnow == 1],
                   col = "yellow")
        if (length(abernow[abernow == 1]) > 0)
            points(kb[abernow == 1], obs[abernow == 1],
                   col = "orange")
        if (length(amplifnow[amplifnow == 1]) > 0)
            points(kb[amplifnow == 1], obs[amplifnow == 1],
                   col="red")

        ##predicted states:
        
        plot(kb, prednow, xlab = "", ylab = "",
             ylim = c(y.min, y.max), type = "l", col = "blue",
             xlim =c(0, chrominfo$length[chr[j]] / 1000))
        
        points(kb, prednow, col = "black")
        title(xlab = "kb (in 1000's)", ylab = "data (smoothed)")
        abline(h = seq(-2, 2, b = .5), lty = 3)
        abline(v = chrominfo$centromere[chr[j]] / 1000, lty = 2,
               col = "red", lwd = 3)

        ##start (dotted blue) and end of states (green)
        if (nstates > 1)
        {
            
            abline(v = kb[transnow == 1], col = "blue", lwd = 2)
            abline(v = kb[transnow == 2], col = "green", lty = 2,
                   lwd = .5)
            
        }

        ##amplif = red
        ##aber = orange
        ##outliers = yellow

        if (length(outliersnow[outliersnow == 1]) > 0)
            points(kb[outliersnow == 1], obs[outliersnow == 1],
                   col = "yellow")
        if (length(abernow[abernow == 1]) > 0)
            points(kb[abernow == 1], obs[abernow == 1],
                   col = "orange")
        if (length(amplifnow[amplifnow == 1]) > 0)
            points(kb[amplifnow == 1], obs[amplifnow == 1],
                   col = "red")

    } 

}

plotHmmStatesNew <-
    function(aCGH.obj, sample.ind, chr = 1:num.chromosomes(aCGH.obj),
             statesres = hmm(aCGH.obj)$states.hmm[[1]],
             chrominfo = human.chrom.info.Jul03, yScale = c(-2, 2),
             samplenames = sample.names(aCGH.obj)
             )
{

    if (length(sample.ind) > 1)
        stop("plotHmmStatesNew currently prints only 1 sample at a\
time\n")
    if (is.null(genomic.events(aCGH.obj)))
        stop("compute the genomic.events of aCGH.obj first using\
find.genomic.events function")
    
    ge <- genomic.events(aCGH.obj)
    aber <- ge$aberrations$aber
    amplif <- ge$amplifications$amplif
    trans <- ge$transitions$trans.matr
    outliers <- ge$outliers$outlier
    pred <- ge$outliers$pred.out

    chrom.rat <- chrominfo$length / max(chrominfo$length)
    chrom.start <- c(0, cumsum(chrominfo$length))[chr]
    
    ##chrom.mid contains middle positions of the chromosomes relative to
    ##the whole genome (useful for plotting the whole genome)
    chrom.mid <- chrom.start + chrominfo$length[chr] / 2
    chrom <- statesres[ ,1 ]
    par(lab = c(15, 6, 7), pch = 18, cex = 1, lwd = 1,
        mfrow = c(2, 1))
    
    sq.state <- seq(3, ncol(statesres), b = 6)
    sq.obs <- seq(8, ncol(statesres), b = 6)
    
    for (j in 1:length(chr))
    {

        ind.nonna <-
            which(!is.na(statesres[chrom == chr[j],
                                   sq.obs[sample.ind]]))

        kb <- statesres[chrom == chr[j], 2][ind.nonna] / 1000
        obs <- statesres[chrom == chr[j],
                         sq.obs[sample.ind]][ind.nonna]
        states <-
            statesres[chrom == chr[j],
                      sq.state[sample.ind]][ind.nonna]
        nstates <- length(unique(states)) 

        abernow <- aber[chrom == chr[j], sample.ind][ind.nonna]
        outliersnow <-
            outliers[chrom == chr[j], sample.ind][ind.nonna]
        amplifnow <- amplif[chrom == chr[j], sample.ind][ind.nonna]
        transnow <- trans[chrom == chr[j], sample.ind][ind.nonna]

        ## predicted values when non-aberration of outlier: otherwise
        ## observed
        
        prednow <- obs
        predicted <- pred[chrom == chr[j], sample.ind][ind.nonna]
        prednow[outliersnow == 0 & abernow == 0] <-
            predicted[outliersnow == 0 & abernow == 0]

        y.min <- min(yScale[1], min(obs))
        y.max <- max(yScale[2], max(obs))

        ##observed

        plot(kb, obs, xlab = "", ylab = "", ylim = c(y.min, y.max),
             type = "l", col = "blue",
             xlim = c(0, chrominfo$length[chr[j]] / 1000)
             )
        points(kb, obs, col = "black")
        title(main = paste("Sample", sample.ind,
              samplenames[sample.ind], "- Chr", chr[j],
              "Number of states", nstates),
              xlab = "kb (in 1000's)", ylab = "data (observed)"
              )
        
        abline(h = seq(-2, 2, b = .5), lty = 3)
        abline(v = chrominfo$centromere[chr[j]] / 1000, lty = 2,
               col = "red", lwd = 3)

        if (nstates > 1)
        {
            
            abline(v = kb[transnow == 1], col = "blue", lwd = 2)
            abline(v = kb[transnow == 2], col = "green", lty = 2,
                   lwd = .5)
            
        }

        ##amplif = red
        ##aber = orange
        ##outliers = yellow

        if (length(outliersnow[outliersnow == 1]) > 0)
            points(kb[outliersnow == 1], obs[outliersnow == 1],
                   col = "yellow")
        if (length(abernow[abernow == 1]) > 0)
            points(kb[abernow == 1], obs[abernow == 1],
                   col = "orange")
        if (length(amplifnow[amplifnow == 1]) > 0)
            points(kb[amplifnow == 1], obs[amplifnow == 1],
                   col="red")

        ##predicted states:
        
        plot(kb, prednow, xlab = "", ylab = "",
             ylim = c(y.min, y.max), type = "l", col = "blue",
             xlim =c(0, chrominfo$length[chr[j]] / 1000))
        
        points(kb, prednow, col = "black")
        title(xlab = "kb (in 1000's)", ylab = "data (smoothed)")
        abline(h = seq(-2, 2, b = .5), lty = 3)
        abline(v = chrominfo$centromere[chr[j]] / 1000, lty = 2,
               col = "red", lwd = 3)

        ##start (dotted blue) and end of states (green)
        if (nstates > 1)
        {
            
            abline(v = kb[transnow == 1], col = "blue", lwd = 2)
            abline(v = kb[transnow == 2], col = "green", lty = 2,
                   lwd = .5)
            
        }

        ##amplif = red
        ##aber = orange
        ##outliers = yellow

        if (length(outliersnow[outliersnow == 1]) > 0)
            points(kb[outliersnow == 1], obs[outliersnow == 1],
                   col = "yellow")
        if (length(abernow[abernow == 1]) > 0)
            points(kb[abernow == 1], obs[abernow == 1],
                   col = "orange")
        if (length(amplifnow[amplifnow == 1]) > 0)
            points(kb[amplifnow == 1], obs[amplifnow == 1],
                   col = "red")

    } 

}

##plot.all.arrays.plot <-
##    function(aCGH.obj, chrominfo = human.chrom.info.Jul03,
##             sample.names = sample.names(aCGH.obj))
##{

##    if (is.null(hmm(aCGH.obj)))
##        stop("compute the hmm states first using find.hmm.states\
##function")
##    if (is.null(sd.samples(aCGH.obj)))
##        stop("compute first the standard deviations for samples using\
##computeSD.Samples function")

##    madGenome <- sd.samples(aCGH.obj)$madGenome
##    ord <- order(madGenome)
##    nm <-
##        apply(data.frame(sample.names, round(madGenome, 2),
##                         round((3 * madGenome), 2)),
##              1,
##              paste,
##              collapse = ":"
##              )
##    op <- par(mfrow = c(2, 1))
##    sapply(ord,
##           function(i) {
               
##               cat(i, "\n")
##               plotGenome(aCGH.obj, sample = i)
               
##           }
##           )
##    par(op)
    
##}

##plot.all.arrays <-
##    function(aCGH.obj, plot.file.name = "samples.noise.ps")
##{

##    postscript(plot.file.name, paper="letter")
##    plot.all.arrays.plot(aCGH.obj)
##    dev.off()
    
##}

##produce.pairs.plot <-
##    function(aCGH.obj)
##{

##    attach(aCGH.obj)
##    nm <- colnames(qual.rep)
##    for (i in 1:length(nm))
##    {
##        cat(i, "\n")
##        matr <-
##            t(as.matrix(log2.ratios)[
##                                     which(clones.info(aCGH.obj)$Clone ==
##                                           nm[i]),
##                                     ]
##              )
##        ylm <- c(min(c(matr), na.rm = TRUE), max(c(matr), na.rm = TRUE))
##        pairs(matr, ylim = c(ylm[1], ylm[2]),
##              xlim = c(ylm[1], ylm[2]), pch = 20)
##        title(paste(nm[i], " ;median maxdiff is ",
##                    qual.rep[2,i], " ;spearman corr is ",
##                    qual.rep[3,i])
##              )
##    }
##    detach(aCGH.obj)
    
##}

plotValGenome <-
    function(aCGH.obj, phen = rep(1, ncol(aCGH.obj)),
             data = log2.ratios(aCGH.obj),
             datainfo = clones.info(aCGH.obj),
             chrominfo = human.chrom.info.Jul03,
             cutoff = 1, ncolors = 50, byclass = TRUE, showaber = FALSE,
             amplif = 1, homdel = -1, vecchrom = 1:23,
             samplenames = sample.names(aCGH.obj),
             title = "Image Plots")
{
    
    resp0 <- phen
    resp <- resp0
    if (!byclass)
	resp <- rep(1, length(resp0))

    tbl.resp <- table(resp)
    ##label.col <- c("red", "green", "blue", "skyblue", "orange", "pink", "gray20")
    label.col <- rainbow(6)
    
    par(bg = "grey20")
    
    kb <- datainfo$kb
    data <- as.matrix(data)
    dt.cp <- data
    dt <- apply(data, 2,floor.func, cutoff)    
###    chromb <- rep(0,nrow(chrominfo))
    ##centrloc <- rep(0,nrow(chrominfo))
###    for (i in 1:nrow(chrominfo))
###    {
        
###	for (j in 1:i)
###            ##chromb[i] <- chromb[i]+length(datainfo$Chrom[datainfo$Chrom==vecchrom[j]])+.5
###            chromb[i] <- chromb[i]+sum(datainfo$Chrom == vecchrom[j])
###        ##centrloc[i] <- chromb[i]-length(datainfo$Chrom[datainfo$Chrom==vecchrom[i] & datainfo$kb >= chrominfo$centr[vcchrom[i]]])
	
###    }
    chromb <- c(0, cumsum(table(datainfo$Chrom)))
    ##chromb <- c(.5, chromb)
    ##chromb <- c(0, chromb)

    dt <- dt[ ,order(resp) ]
    dt.cp <- dt.cp[ ,order(resp) ]
    resp0 <- resp0[order(resp)]
    samplenames <- samplenames[order(resp)]
    resp <- resp[order(resp)]
    start <- 1
    
    ##mapping order
    ord <- rep(0, length(resp))
    for (i in 1:(length(tbl.resp)))
    {
	
	ind <- which(resp == i)
	cr <- as.dist(1 - corna(data[ ,ind ]))
	ord[start:sum(tbl.resp[1:i])] <-
            hclust(cr, method = "ave")$ord + start - 1
	start <- sum(tbl.resp[1:i]) + 1
	
    }
    dt <- dt[ ,ord ]
    dt.cp <- dt.cp[ ,ord ]
    resp <- resp[ord]
    resp0 <- resp0[ord]
    samplenames <- samplenames[ord]

    image(x = 1:length(kb), y = 1:length(resp), z = dt,
          col = maPalette(low = "red", high = "green", mid = "white",
          k = ncolors), axes = FALSE, xlab = "", ylab = "",
          zlim = c(-cutoff, cutoff))
    
    ##abline(h=seq(.5, 81.5, b=1), col="gray20", lwd=.2)
    if (showaber)
    {
        
        ##for (i in 1:nrow(dt))
        ##{
        for (j in 1:ncol(dt))
        {
            
            tmp <- dt.cp[,j]
            i <- which(tmp >= amplif & !is.na(tmp))
            if (length(i) > 0)
                ##if ((!is.na(dt.cp)) && (dt.cp[i,j] >= amplif))
                points(i, rep(j, length(i)), col = "yellow", pch = 20,
                       cex = .7)
            i <- which(tmp <= homdel & !is.na(tmp))
            if (length(i) > 0)
                ##if ((!is.na(dt.cp)) && (dt.cp[i,j] >= amplif))
                points(i, rep(j, length(i)), col = "skyblue",
                       pch = 20, cex = .7)
            
        }
        ##}
    }
    for (j in 1:ncol(dt))
    {

        col <- label.col[resp0[j] + 1]
	mtext(resp0[j], side = 2, at = j, line=.3, col = col,
              cex = .5, las = 2)
	mtext(paste((samplenames)[j], ""), side = 4, at = j,
              line = .3, col = col, cex = .3, las = 2)
	
    }
    ##title(main="Whole genome", xlab = "clone", ylab = "sample", col.lab="white", col.main="white")
    title(xlab = "clone", ylab = "sample", col.lab = "white",
          col.main = "white", main = title)
    ##abline(v=centrloc, col="white", lty=2, lwd=.5)
    abline(v = chromb, col = "black", lty = 1, lwd = .5)
    loc <- chromb[-1] - diff(chromb) / 2
    for (i in seq(2, nrow(chrominfo), b = 2))
        mtext(paste("", vecchrom[i]), side = 3, at = loc[i],
              line = .3,col = "white", cex.main = .5)
    for (i in seq(1, nrow(chrominfo), b = 2))
        mtext(paste("", vecchrom[i]), side = 1, at = loc[i],
              line = .3,col = "white", cex.main = .5)
    ##mtext("X", side = 1, at = (loc[nrow(chrominfo)]), line=.3,col="white", cex.main=.5)

}

plotValChrom <-
    function(aCGH.obj, phen = rep(1, ncol(aCGH.obj)),
             data = log2.ratios(aCGH.obj),
             datainfo = clones.info(aCGH.obj),
             chrominfo = human.chrom.info.Jul03, chrom = 1:23,
             cutoff = 1, ncolors = 50, amplif = 1, homdel = -1,
             byclass = TRUE, samplenames = sample.names(aCGH.obj),
             clonenames = datainfo$Clone, title = "Image Plot")
{
    
    ##label.col <- c("red", "green", "blue", "yellow", "skyblue", "orange", "pink", "gray20")
    label.col <- rainbow(6)
    par(bg = "grey20")    
    samplenames.cp <- samplenames
    for (chr in chrom)
    {
        
        resp0 <- phen
        resp <- resp0
        samplenames <- samplenames.cp
        if (!byclass)
            resp <- rep(1, length(resp0))
        tbl.resp <- table(resp)
        kb <- datainfo$kb[datainfo$Chrom == chr]
        dt <- as.matrix(data[ datainfo$Chrom == chr, ])
        clonenms <- clonenames[datainfo$Chrom == chr]
        
        dt.cp <- dt
        dt <- apply(dt.cp, 2, floor.func, cutoff)       
        if (chrominfo$centr[chr] >0)
###            centr <- length(kb[kb<=chrominfo$centr[chr]])
            centr <- sum(kb <= chrominfo$centr[chr])
        dt <- dt[,order(resp)]
        dt.cp <- dt.cp[ ,order(resp) ]
        resp0 <- resp0[order(resp)]
        samplenames <- samplenames[order(resp)]
        resp <- resp[order(resp)]
        start <- 1

        ##mapping order
        ord <- rep(0, length(resp))
        for (i in 1:length(tbl.resp))
        {
            
            ind <- which(resp == i)
            cr <- as.dist(1 - corna(dt.cp[ ,ind ]))
            ord[start:sum(tbl.resp[1:i])] <-
                hclust(cr, method = "ave")$ord + start - 1
            start <- sum(tbl.resp[1:i])+1
            
        }

        dt <- dt[ ,ord ]
        dt.cp <- dt.cp[ ,ord ]
        resp <- resp[ord]
        resp0 <- resp0[ord]
        samplenames <- samplenames[ord]

        image(x = 1:length(kb), y = 1:length(resp), z = dt,
              col = maPalette(low = "red", high = "green",
              mid = "white", k = ncolors), axes = FALSE, xlab = "",
              ylab = "", zlim = c(-cutoff, cutoff))

        if (chrominfo$centr[chr] > 0)
            abline(v = centr, col = "black")
        for (i in 1:nrow(dt))
        {

            ##if ((i %% 2) == 0)
            ##{
            ##	
            ##	mtext(paste(clonenms[i], ""), side = 1, at = i, line=.3, col="white", cex=.5, las=2)
            ##}
            ##else
            ##{	
            ##	mtext(paste(clonenms[i], ""), side = 3, at = i, line=.3, col="white", cex=.5, las=2)
            ##}
            mtext(paste(clonenms[i], ""), side = 1, at = i, line = .3,
                  col = "white", cex = .25, las = 2)
            for (j in 1:ncol(dt.cp))
            {
                
		if (i == 1)
		{

                    col <- label.col[resp0[j] + 1]
                    mtext(resp0[j], side = 2, at = j, line = .3,
                          col = col, cex = .5, las = 2)
                    mtext(paste(samplenames[j], ""), side = 4, at = j,
                          line = .3, col = col, las = 2, cex = .5)
                    
		}
		if (!is.na(dt.cp[i, j]) && dt.cp[i, j] >= amplif)
                    points(i, j, col = "yellow", pch = 20, cex = .7)
		if (!is.na(dt.cp[i, j]) && dt.cp[i, j] <= homdel)
                    points(i, j, col = "skyblue", pch = 20, cex = .7)
		
            }
            
        }
        title(main = paste(title, " Chromosome ", chr),
              col.main = "white")

    }

}

plotChrom <-
    function(aCGH.obj, sample = 1:ncol(aCGH.obj), chr = 1,
             yScale = c(-1, 1), data = log2.ratios(aCGH.obj),
             datainfo = clones.info(aCGH.obj),
             chrominfo = human.chrom.info.Jul03,
             samplenames = sample.names(aCGH.obj))
{
    
    nsamples <- length(sample)
    ord <- order(datainfo$Chrom, datainfo$kb)
    chrom <- datainfo$Chrom[ord]
    kb <- datainfo$kb[ord]
    data <- data[ ord, ]
    
    par(mfrow = c(nsamples, 1))
    par(cex = .6, pch = 18, lab = c(1,6,7), cex.axis = 1.5)
    kb <- kb[chrom == chr]
    centr.loc <- chrominfo$centromere[chr]
    for (k in 1:nsamples)
    {
        
        vec <- data[chrom == chr, sample[k]]
        name <- samplenames[sample[k]]
        
        ##Now, determine vertical scale for each chromosome:
        
        y.min <- min(yScale[1], minna(vec))
        y.max <- max(yScale[2], maxna(vec))

        plot(kb / 1000, vec, ylim = c(y.min, y.max), xlab = "",
             ylab = "",
             xlim = c(min(kb[kb > 0], na.rm = TRUE), kb[sum(kb > 0)]) /
             1000,
             col = "black", cex = 1.5)
        lines(kb / 1000, vec, col = "blue", lwd = .5)
        abline(v = centr.loc / 1000, col = "red", lty = 2)
        abline(h = 0, col = "black", lty = 2)
        abline(h = seq(-.6, .6, b = .2), lty = 3)
        title(main = paste(name, " Chr ", chr), ylab = "Log2Ratio",
              xlab = "Chromosome", cex.lab = 1.5, cex.main = 2)
        
    }

}

plotGene <-
    function(aCGH.obj, phen = rep(1, ncol(aCGH.obj)),
             data = log2.ratios(aCGH.obj), cutoff = 1, ncolors = 50,
             byclass = TRUE, method = "ave", showaber = FALSE, amplif = 1,
             homdel = -1, samplenames = sample.names(aCGH.obj),
             title = "Image Plots")
    
{
    
    resp0 <- phen
    resp <- resp0
    if (!byclass)
	resp <- rep(1, length(resp0))

    tbl.resp <- table(resp)
    label.col <-
        c("red", "blue", "green", "skyblue", "orange", "pink", "gray20")
    ##label.col <- rainbow(6)
    par(bg = "grey20")

    data <- as.matrix(data)
    dt.cp <- data
    dt <- apply(data, 2, floor.func, cutoff)
    dt <- dt[ ,order(resp) ]
    resp0 <- resp0[ order(resp) ]
    samplenames <- samplenames[ order(resp) ]
    resp <- resp[ order(resp) ]

    start <- 1
    ##mapping order
    ord <- rep(0, length(resp))
    for (i in 1:length(tbl.resp))
    {
	
	ind <- which(resp == i)
	cr <- as.dist(1 - corna(data[ ,ind ]))
	ord[start:sum(tbl.resp[1:i])] <-
            hclust(cr, method = method)$ord + start - 1
	start <- sum(tbl.resp[1:i]) + 1
	
    }
    dt <- dt[ ,ord ]
    resp <- resp[ord]
    resp0 <- resp0[ord]
    samplenames <- samplenames[ord]

    image(x = 1:nrow(dt), y = 1:length(resp), z = dt,
          col = maPalette(low = "red", high = "green", mid = "white",
          k = ncolors), axes = FALSE, xlab = "", ylab = "",
          zlim = c(-cutoff, cutoff))
    ##abline(h=seq(.5, 81.5, b=1), col="gray20", lwd=.2)

    if (showaber)
    {
        ##for (i in 1:nrow(dt))
        ##{
        for (j in 1:ncol(dt))
        {
            
            tmp <- dt.cp[ ,j ]
            i <- which(tmp >= amplif & !is.na(tmp))
            if (length(i) > 0)
                ##if ((!is.na(dt.cp)) && (dt.cp[i,j] >= amplif))
                points(i, rep(j, length(i)), col = "yellow", pch = 20,
                       cex = .7)
            i <- which(tmp <= homdel & !is.na(tmp))
            if (length(i) > 0)
                ##if ((!is.na(dt.cp)) && (dt.cp[i,j] >= amplif))
                points(i, rep(j, length(i)), col = "skyblue",
                       pch = 20, cex = .7)
            
        }
        ##}
    }
    for (j in 1:ncol(dt))
    {

        col <- label.col[resp0[j] + 1]
	mtext(resp0[j], side = 2, at = j, line = .3, col = col,
              cex = .5, las = 2)
	mtext(paste(samplenames[j], ""), side = 4, at = j, line = .3,
              col = col, cex = .25, las = 2)
	
    }
    ##title(main="Whole genome", xlab = "clone", ylab = "sample", col.lab="white", col.main="white")
    title(xlab = "clone", ylab = "sample", col.lab = "white",
          col.main = "white", main = title)

}

plotGeneSign <-
    function(aCGH.obj, phen = rep(1, ncol(aCGH.obj)),
             data = log2.ratios(aCGH.obj), cutoff = 1, ncolors = 50,
             byclass = TRUE, method = "ave", showaber = FALSE, amplif = 1,
             homdel = -1, samplenames = sample.names(aCGH.obj),
             title = "Image Plots", sign = FALSE, dataSign = data,
             nperm = 1000, test = "f", ranks = "y", side = "abs",
             p.thres = c(.01, .05, .1, .2),
             clusterindex = rep(1, nrow(data)))
{

    resp0 <- phen
    resp <- resp0
    if (!(byclass))
	resp <- rep(1, length(resp0))

    tbl.resp <- table(resp)
    label.col <-
        c("red", "blue", "green", "skyblue", "orange", "pink",
          "gray20")
    ##label.col <- rainbow(6)
    ##par(bg="grey20")
    if (sign)
	par(mfrow = c(2, 1))

    data <- as.matrix(data)
    dt.cp <- data
    dt <- apply(data, 2,floor.func, cutoff)    

    dt <- dt[,order(resp)]
    resp0 <- resp0[order(resp)]
    samplenames <- samplenames[order(resp)]
    resp <- resp[order(resp)]

    ##to order within class:

    start <- 1
    ##mapping order
    ord <- rep(0, length(resp))
    for (i in 1:(length(tbl.resp)))
    {
	
	ind <- which(resp == i)
        ##cr <- as.dist(1-cor.na(data[,ind]))
	cr <- dist(t(data[,ind]))
	ord[start:sum(tbl.resp[1:i])] <- hclust(cr, method=method)$ord+start-1
	start <- sum(tbl.resp[1:i])+1
	
	
	
    }
    dt <- dt[,ord]
    resp <- resp[ord]
    resp0 <- resp0[ord]
    samplenames <- samplenames[ord]


    image(x=(1:nrow(dt)), y=1:length(resp), z=dt, col = maPalette(low = "red", high = "green", mid = "white", k =ncolors), axes = FALSE, xlab = "", ylab = "", zlim=c(-cutoff,cutoff))
    ##abline(h=seq(.5, 81.5, b=1), col="gray20", lwd=.2)

    if (showaber)
    {
        ##for (i in 1:nrow(dt))
        ##{
        for (j in 1:ncol(dt))
        {
            
            tmp <- dt.cp[,j]
            i <- (1:length(tmp))[tmp >= amplif & !is.na(tmp)]
            if (length(i) > 0)
                ##if ((!is.na(dt.cp)) && (dt.cp[i,j] >= amplif))
            {
                points(i, rep(j, length(i)), col="yellow", pch=20, cex=.7)
            }
            i <- (1:length(tmp))[tmp <= homdel & !is.na(tmp)]
            if (length(i) > 0)
                ##if ((!is.na(dt.cp)) && (dt.cp[i,j] >= amplif))
            {
                points(i, rep(j, length(i)), col="skyblue", pch=20, cex=.7)
            }
            
        }
        ##}
    }
    for (j in 1:ncol(dt))
    {
	mtext((resp0)[j], side = 2, at = j, line=.3, col=label.col[((resp0)[j]+1)], cex=.5, las=2)
	mtext(paste((samplenames)[j], ""), side = 4, at = j, line=.3, col=label.col[((resp0)[j]+1)], cex=.25, las=2)
	
    }

    if (length(unique(clusterindex)) > 1)
    {
	clusterloc <- cumsum(table(clusterindex))+.5
	clusterloc <- clusterloc[-length(clusterloc)]
	abline(v=clusterloc, col="blue", lwd=.5)
    }
    

    title(xlab = "gene", ylab = "sample", col.lab="black", col.main="black", main=title)

##################now, significance:
    if (sign)
    {
	pal <- c("red", "green", "yellow", "blue")
	pal <- pal[1:length(p.thres)]
	
	res <-  mt.maxT(X=dataSign, classlabel=phen,test=test,side=side,fixed.seed.sampling="y",B=nperm, na=.mt.naNUM, nonpara=ranks)
	maxT <- res$adjp[order(res$index)]	
	
        ##rawp <- res$rawp[order(res$index)]
	teststat <- abs(res$teststat[order(res$index)])
	st <- rep(NA, length(p.thres))
	for (s in 1:length(p.thres))
	{
            if (length(maxT[maxT<=p.thres[s]]) > 0)
            {
                st[s] <- min(teststat[maxT<=p.thres[s]])
            }
	}
        
	st.now <- st
	pal.now <- pal
	par(xaxs="i")
	plot(1:length(teststat),teststat, col="blue", ylim=c(0,max(teststat)), type="h", xlab="gene", ylab="gene statistic", pch=18, col.lab="black", col.axis="black")
	
	if (length(st.now) > 0)
	{
            abline(h=rev(st.now), col=rev(pal.now), lty=2)
	}
	
    }
    if (length(unique(clusterindex)) > 1)
    {
        abline(v=clusterloc, col="red", lwd=.5)
    }

}
dotify.names <-
    function(nms)
    gsub("_", ".", nms)

read.Sproc.files <-
    function(fnames, maxsd = .2, minreplic = 2,
             cols = c("Log2Rat", "Log2StdDev", "NReplic", "Bad.P"))
    sapply(fnames,
           function(fname) {
               
               cat("Trying to read ", fname, "\n")
               dt.tmp <-
                   read.table(fname, h = TRUE, sep = "\t", quote = "",
                              comment.char = "", fill = TRUE,
                              blank.lines.skip = FALSE)
               colnames(dt.tmp) <- dotify.names(colnames(dt.tmp))
               dat <- dt.tmp[-nrow(dt.tmp), cols]
               log2rat <- dat[ ,1 ]
               log2stddev <- dat[ ,2 ]
               nreplic <- dat[ ,3 ]
               flag <- dat[ ,4 ]
               tmp1 <-
                   flag == 1 &
               ((log2stddev > maxsd) | (nreplic < minreplic))
               log2rat[tmp1] <- NA
               log2rat
               
           }
           )

##flag.func <-
##    function(dat, maxsd = .2, minreplic = 2, colvals = 1, colsd = 2,
##             colrep = 3, colbad = 4)
##{

##    seq.val <- seq(colvals, ncol(dat), by = 4)
##    seq.sd <- seq(colsd, ncol(dat), by = 4)
##    seq.rep <- seq(colrep, ncol(dat), by = 4)
##    seq.bad <- seq(colbad, ncol(dat), by = 4)

##    log2rat <- as.matrix(dat[ ,seq.val ])
##    log2stddev <- as.matrix(dat[ ,seq.sd ])
##    nreplic <- dat[ ,seq.rep ]
##    flag <- dat[ ,seq.bad ]

##    for (i in 1:ncol(flag))
##    {
        
#####        tmp <- flag[,i]
#####        tmp[((log2stddev[,i] > maxsd) | (nreplic[,i] < minreplic))] <- 1
#####        flag[ ,i ] <- tmp
#####        log2rat[tmp == 1, i] <- NA
##        tmp1 <- flag[,i] == 1 & ((log2stddev[,i] > maxsd) | (nreplic[,i] < minreplic))
##        log2rat[tmp1, i] <- NA
#####        log2stddev[tmp == 1, i] <- NA
        
##    }
    
##    log2rat
    
##}

extract.clones.info <-
    function(dt.tmp)
{
    
    dt.tmp <- dt.tmp[ -nrow(dt.tmp), ]
    colnames(dt.tmp) <- dotify.names(colnames(dt.tmp))
    clones.info <-
        dt.tmp[ , c("Clone", "Target", "Chromosome", "KB.POSITION")]
    
}

aCGH.read.Sprocs <-
    function(fnames, latest.mapping.file = NULL, maxsd = .2,
             minreplic = 2, chrom.remove.threshold = 24,
             prop.missing = .25, sample.names = fnames,
             sample.quality.threshold = .4,
             cols = c("Log2Rat", "Log2StdDev", "NReplic", "Bad.P"))
{
    
    maxdiff.func <-
        function(x)
            abs(max(x, na.rm = TRUE) - min(x, na.rm = TRUE))

    mincorr.func <-
        function(A)
        {
            
            crmn <- 2
            for (i in 1:(ncol(A) - 1))
                for (j in (i+1):ncol(A))
                {
                    
                    vec1 <- A[ ,i ]
                    vec2 <- A[ ,j ]
                    ind <- which(!is.na(vec1) & !is.na(vec2))
                    vec1 <- rank(vec1[ind])
                    vec2 <- rank(vec2[ind])
                    cr <- cor(vec1, vec2)
                    if (cr < crmn)
                        crmn <- cr
                    
                }
            
            crmn
            
        }

###    if (is.null(sample.names))
###        sample.names <- 
###            sapply(strsplit(fnames, "/"),
###                   function(vv) {

###                       name.split <-
###                           strsplit(vv[[length(vv)]], "\\.")[[1]]
###                       num.splits <- length(name.split)
###                       if (num.splits > 2)
###                           name.split <-
###                               paste(name.split[-num.splits], ".")
###                       name.split

###                   }
###                   )

    ## screening out clones with < 2 replicates or SD > .2 or
    ## SPROC indicator of 1

    log2.ratios <-
        read.Sproc.files(fnames, maxsd = maxsd, minreplic = minreplic,
                         cols = cols)
    colnames(log2.ratios) <- sample.names

    ## Extract the clones information from the first file in the list
    
    clones.info <- 
        extract.clones.info(read.table(fnames[1], h = TRUE, sep = "\t",
                                       quote = "", comment.char = "",
                                       fill = TRUE,
                                       blank.lines.skip = FALSE)
                            )
    
    ## if clones have newer mapping associated with them
    if (!is.null(latest.mapping.file))
    {

        latest.mapping <-
            read.table(latest.mapping.file, sep = "\t", h = TRUE,
                       quote = "", comment.char = "")[ ,1:4 ]
        colnames(latest.mapping) <-
            dotify.names(colnames(latest.mapping))
        ind.match <-
            match(as.character(clones.info$Clone),
                  as.character(latest.mapping$USER.CLONE.ID)
                  )
        ind <- ind.match[!is.na(ind.match)]
        clones.info <- latest.mapping[ ind, ]
        log2.ratios <- log2.ratios[ !is.na(ind.match), ]

    }
    colnames(clones.info) <- c("Clone", "Target", "Chrom", "kb")
    rownames(log2.ratios) <- clones.info$Clone
    
    ## remove unmapped clones
    ind.unmap <-
        which(clones.info$Chrom > chrom.remove.threshold |
              is.na(clones.info$Chrom) | is.na(clones.info$kb))
    clones.info <- clones.info[ -ind.unmap, ]
    log2.ratios <- log2.ratios[ -ind.unmap, ]

    ## reorder by chromosome and chromosomal position
    ord <- order(clones.info$Chrom, clones.info$kb)
    clones.info <- clones.info[ ord, ]
    log2.ratios <- log2.ratios[ ord, ]

    ## mark those samples that have bad quality
    bad.quality.index <-
        which(apply(log2.ratios,
                    2,
                    function(col)
                    mean(is.na(col)) > sample.quality.threshold
                    )
              )

    ## screen out clones missing in > prop.missing% of the samples:

    prop.miss <- apply(log2.ratios, 1, prop.na)
    clones.info.screen <-
        clones.info[ prop.miss <= prop.missing, ]
    log2.ratios <- log2.ratios[ prop.miss <= prop.missing, ]

    ## determine duplicates and average/remove them

    tbl <- table(clones.info.screen$Clone)
    qual.rep <- NULL
    if (any(tbl > 1))
    {
        
        tbl <- tbl[tbl > 1]
        qual.rep <- matrix(0, ncol = length(tbl), nrow = 2)
        nms <- names(tbl)
        cat("\nAveraging duplicated clones\n")
        for (i in 1:length(tbl))
        {

            ind1 <- which(clones.info.screen$Clone == nms[i])
            cat(as.character(clones.info.screen$Clone[ind1[1]]),
                "\t", ind1, "\n")
            vec <- apply(log2.ratios[ ind1, ], 2, mean, na.rm = TRUE)
            md <- apply(log2.ratios[ ind1, ], 2, maxdiff.func)
            md <- md[md > 0]
            qual.rep[1, i] <- round(median(md, na.rm = TRUE), 2)
            qual.rep[2, i] <-
                round(mincorr.func( t(log2.ratios[ ind1, ]) ), 2)
            for (j in 1:length(ind1))
                log2.ratios[ ind1[j], ] <- vec
            
        }
        qual.rep <- rbind(tbl, qual.rep)

    }
    ## contains median of abs max difference among all replicates and
    ## min correlations between replicates

    dupl  <- duplicated(clones.info.screen$Clone)
    clones.info.screen <- clones.info.screen[ !dupl, ]
    log2.ratios <- log2.ratios[ !dupl, ]

    if (!is.null(sample.names))
        colnames(log2.ratios) <- sample.names

    clones.info.screen$Clone <- factor(clones.info.screen$Clone)
    clones.info.screen$Target <- factor(clones.info.screen$Target)
    value <- create.aCGH(log2.ratios, clones.info.screen)
    attr(value, "call") <- sys.call()
    value$qual.rep <- qual.rep
    value$bad.quality.index <- bad.quality.index
    value

}
require(survival)
require(multtest)

aCGH.test.old <-
    function(formula, aCGH.obj, test = c("t.test", "coxph"),
             grouping = NULL, p.adjust.method = "fdr", subset = NULL)
{

#    if(missing(formula) || !inherits(formula, "formula"))
#        stop("formula missing or invalid")
#        m <- match.call(expand.dots = FALSE)
#    if(is.matrix(eval(m$data, parent.frame())))
#        m$data <- as.data.frame(data)
#    m[[1]] <- as.name("model.frame")
#    m$... <- NULL
#    mf <- eval(m, parent.frame())
#    DNAME <- paste(names(mf), collapse = " by ")
#    names(mf) <- NULL
#    response <- attr(attr(mf, "terms"), "response")
#    g <- factor(mf[[-response]])
#    if(nlevels(g) != 2)
#        stop("grouping factor must have exactly 2 levels")
#    DATA <- split(mf[[response]], g)
#    browser()

    pheno <- phenotype(aCGH.obj)
    if (!is.null(subset))
        pheno <- pheno[ subset, ]
    test <- match.arg(test)
    switch(test,
           t.test = t.test(formula, pheno),
           coxph = coxph(formula, pheno)
           )
#    do.call(test, formula, data = phenotype(aCGH.obj))
#    invisible()
    
}

aCGH.test <-
    function(frml, aCGH.obj, test = c("survdiff", "coxph"),
             grouping = NULL, p.adjust.method = "fdr", subset = NULL)
{

    l2r <- log2.ratios.imputed(aCGH.obj)
    if (!is.null(subset))
        l2r <- l2r[ subset, ]
    test <- match.arg(test)
    pheno <- phenotype(aCGH.obj)
    resT <- 
        sapply(1:nrow(l2r),
               function(i) {
                   
                   if (i %% 100 == 0)
                       print(i)
                   clone <- l2r[ i, ]
                   switch(test,
                          survdiff = {
                              
                              survdiff.fit <-
                                  try(survdiff(as.formula(frml),
                                               data = pheno))
                              if (inherits(survdiff.fit, "try-error"))
                                  c(0, 1)
                              else
                              {
                                  
                                  etmp <- 
                                      if (is.matrix(survdiff.fit$obs))
                                          apply(survdiff.fit$exp,
                                                1,
                                                sum)
                                      else
                                          survdiff.fit$exp
                                  c(survdiff.fit$chisq,
                                    1 - pchisq(survdiff$chisq,
                                               sum(etmp > 0) - 1)
                                    )
                                  
                              }
                              
                          },
                          coxph = {

                              coxph.fit <-
                                  try(coxph(as.formula(frml),
                                            data = pheno))
                              if (inherits(coxph.fit, "try-error"))
                                  c(0, 1)
                              else
                              {
                                  
                                  logtest <-
                                      -2 * (coxph.fit$loglik[1] -
                                            coxph.fit$loglik[2])
                                  beta <- coxph.fit$coef
                                  df <- length(beta[!is.na(beta)])
                                  c(logtest, 1 - pchisq(logtest, df))
                                  
                              }
                              
                          }
                          )
                   
               }
               )
    rawp <- resT[ 2, ]
    adjp <- p.adjust(rawp, p.adjust.method)

    data.frame(index = 1:ncol(resT),
               teststat = resT[ 1, ],
               rawp = rawp,
               adjp = adjp
               )[ order(adjp), ]

}

threshold.func <-
    function(dat, thresAbs)
{
    
    out <- matrix(0, nrow = nrow(dat), ncol = ncol(dat))
    ##if the same threshold for all samples
    if (length(thresAbs) == 1)
        thresAbs <- rep(thresAbs, ncol(dat))
    if (length(thresAbs) != ncol(dat))
        stop("Error: number of threshold is not the same as number of\
samples")
##    for (i in 1:ncol(dat))
##    {
##        tmp <- dat[,i]
##        tmp[dat[,i] >=thresAbs[i] & !is.na(dat[,i])] <- 1
##        tmp[dat[,i] <=-thresAbs[i] & !is.na(dat[,i])] <- -1
##        tmp[dat[,i] > -thresAbs[i] & dat[,i] < thresAbs[i] & !is.na(dat[,i])] <- 0
        
##        out[,i] <- tmp
##    }
##    out
    sapply(1:ncol(dat),
           function(i) {
               
               tmp <- rep(0, ncol(dat))
               na.col <- is.na(dat[ ,i ])
               col <- dat[ ,i ][!na.col]
               tmp[!na.col] <-
                   ifelse(col > thresAbs[i],
                          1,
                          ifelse(col < thresAbs[i], -1, 0)
                          )
               
               tmp
               
           }
           )
    
}

changeProp.func <-
    function(dat = data.screen.norm.thres, colMatr)
{
    
    out <- matrix(0, nrow = nrow(dat), ncol = nrow(colMatr))
    for (i in 1:nrow(colMatr))
        for (j in 1:nrow(dat))
        {
            
            vec <- dat[j, colMatr[ i, ] == 1]
            out[j, i] <- 
                if (lengthLoss.na(vec) < lengthGain.na(vec))
                    propGain.na(vec)
                else
                    propLoss.na(vec)
            
        }
    out
    
}

changeProp.overall.func <-
    function(dat)
    apply(dat,
          1,
          function(vec) {
               
              if (lengthLoss.na(vec) < lengthGain.na(vec))
                  propGain.na(vec)
              else
                  propLoss.na(vec)
              
          }
          )

table.bac.func <-
    function(dat, colMatr)
{

    nr <- 
        if (nrow(colMatr) > 1)
            6 * (nrow(colMatr) + 1)
        else
            6
    out <- matrix(0, nrow=nrow(dat), ncol=nr)	
    
    ##number of samples:

    sample.ind <- which(colMatr[ 1, ] == 1)
    if (nrow(colMatr) > 1)
        for (j in 2:nrow(colMatr))
            sample.ind <- c(sample.ind, which(colMatr[ j, ] == 1))

    ##all samples 
    sample.ind <- unique(sample.ind)
    
    dat.all <- dat[ ,sample.ind ]
    
    for (i in 1:nrow(dat))
    {
        
        len <- length(sample.ind)
        vec <- dat.all[ i, ]
        out[i, 1] <- sum(!is.na(vec)) #number present
        out[i, 2] <- lengthGain.na(vec) #number gained
        out[i, 3] <- lengthLoss.na(vec) #number lost
        out[i, 4] <- round(1 - prop.na(vec),2) #proportion present 
        out[i, 5] <- round(propGain.na(vec),2) #proportion gained
        out[i, 6] <- round(propLoss.na(vec),2) #proportion lost
	
        if (nr > 6) #if 2 or more classes
        {
            
            for (j in 1:nrow(colMatr))
            {
                
                vec <- dat[i, colMatr[ j, ] == 1]
                out[i, (6*j+1):(6*j+6)] <-
                    c(sum(!is.na(vec)), lengthGain.na(vec),
                      lengthLoss.na(vec), round(1 - prop.na(vec), 2),
                      round(propGain.na(vec), 2),
                      round(propLoss.na(vec), 2)
                      )
                
            }
            
        }
        
    }
    out

}

lengthGain.na <-
    function(x)
    sum(x == 1, na.rm = TRUE)

propGain.na <-
    function(x)
    mean(x == 1, na.rm = TRUE)

lengthLoss.na <-
    function(x)
    sum(x == -1, na.rm = TRUE)

propLoss.na <-
    function(x)
    mean(x == -1, na.rm = TRUE)

prop.na <-
    function(x)
    mean(is.na(x))

gainloss.func <-
    function (dat, cols, thres, quant = .5)
{

    if (length(thres) == 1)
        thres <- rep(thres, ncol(dat))
    if (length(thres) != ncol(dat))
        stop("Error: number of thresholds is not the same as number\
of samples")
    dt <- as.matrix(dat[ ,cols ])
    thr <- thres[cols]
    loss.med <- loss <- gain.med <- gain <- rep(0, nrow(dt))
    
    for (i in 1:nrow(dt))
        if (!all(is.na(dt[ i, ])))
        {
            
            x <- dt[ i, ]
            th <- thr[!is.na(x)]
            x <- x[!is.na(x)]
            tmp.gain <- x >= th
            gain[i] <- mean(tmp.gain)
            if (any(tmp.gain))
                gain.med[i] <- quantile(x[tmp.gain], 1 - quant)
            tmp.loss <- x <= -th
            loss[i] <- mean(tmp.loss)
            if (any(tmp.loss))
                loss.med[i] <- quantile(x[tmp.loss], quant)
            
        }
    
    list(gainP = gain,
         lossP = loss,
         gainMed = gain.med,
         lossMed = loss.med)
    
}

plotFreqStatColors <-
    function(aCGH.batch, resT, pheno, colored = TRUE, ...)
    plotfreq.stat(aCGH.batch, resT, pheno, colored = TRUE, ...)

plotFreqStatGrey <-
    function(aCGH.batch, resT, pheno, colored = FALSE, ...)
    plotfreq.stat(aCGH.batch, resT, pheno, colored = FALSE, ...)

plotFreqStat <-
    function(aCGH.obj, resT, pheno, chrominfo = human.chrom.info.Jul03,
             X = TRUE, Y = FALSE, threshold = TRUE, minChanged = 0, all = FALSE,
             rsp.uniq = unique(pheno), nlim = 1, cutplot = 0,
             titles = rsp.uniq, thres = .2, ylm = c(-1, 1),
             ngrid = 2, p.thres = c(.01, .05, .1), mincolors = .1,
             quant.col = .11, numaut = 22, onepage = TRUE, colored = TRUE,
             summarize.clones = TRUE)
{

    col.scheme <- 
        if (colored)
            list(pal =
                 c("red", "blue", "green",
                   "yellow")[1:length(p.thres)],
                 gain.low = "white",
                 gain.high = "green",
                 loss.low = "red",
                 loss.high = "white",
                 abline1 = "blue",
                 abline2 = "grey50",
                 mtext = "red",
                 kb.loc = "blue",
                 abline3 = "black",
                 abline4 = "grey50",
                 )
        else
            list(pal =
                 c("grey10", "grey40", "grey70",
                   "grey90")[1:length(p.thres)],
                 gain.low = "grey50",
                 gain.high = "grey0",
                 loss.low = "grey0",
                 loss.high = "grey50",
                 abline1 = "grey50",
                 abline2 = "grey50",
                 mtext = "black",
                 kb.loc = "black",
                 abline3 = "black",
                 abline4 = "grey50",
                 )
    data <- log2.ratios(aCGH.obj)
    datainfo <- clones.info(aCGH.obj)
    dataSign <- log2.ratios.imputed(aCGH.obj)
    rsp.uniq <- sort(rsp.uniq)
    
    ## creating response matrix colmatr

    if (!all)
	colmatr <-
            t(
              sapply(rsp.uniq,
                     function(rsp.uniq.level)
                     ifelse(pheno == rsp.uniq.level, 1, 0)
                     )
              )

    ## screening out clones that are gained or lost in < minChanged in
    ## classes under comparison
    ## indeces present:

    tmp <- apply(as.matrix(colmatr), 2, sum)
    indecesnow <- which(tmp == 1)
    data.thres <- threshold.func(data, thresAbs = thres)
    prop.ch <- changeProp.func(dat = data.thres, colMatr = colmatr)
    maxch <- changeProp.overall.func(dat = data.thres[ ,indecesnow ])
    clones.index <- which(maxch >= minChanged)

    ##removing clones to skip from the dataset

    data <- data[clones.index,]
    data.thres <- data.thres[clones.index,]
    dataSign <- dataSign[clones.index,]
    datainfo <- datainfo[clones.index,]

    ## start table:
    if (summarize.clones)
        bac.summary <-
            table.bac.func(dat = data.thres, colMatr = colmatr)

    ## creating color matrix for displaying intensity of gains and losses
    ## and for plotting p-values

    colors.gain <-
        maPalette(low = col.scheme$gain.low,
                  high = col.scheme$gain.high,
                  k = ngrid)
    colors.loss <-
        maPalette(low = col.scheme$loss.low,
                  high = col.scheme$loss.high,
                  k = ngrid)
###    sq.loss <- seq(-nlim, -mincolors, length = ngrid + 1)
###    sq.gain <- seq(mincolors, nlim, length = ngrid + 1)
###    matr.colors.loss <-
###        data.frame(sq.loss[ -length(sq.loss) ], sq.loss[-1],
###                   colors.loss)
###    matr.colors.gain <-
###        data.frame(sq.gain[ -length(sq.gain) ], sq.gain[-1],
###                   colors.gain)

    ## Now, start:
    ## if perform significance analysis on thresholded data only:

    if (threshold)
	dataSign <- threshold.func(dataSign, thres)
    nr <- nrow(colmatr)
    
    ## if 1 class only, no significance analysis:
###    if (nrow(colmatr) == 1)
###        sign <- F
###    if (sign)
###        nr <- nr + 1
    nr <- nr + 1
    
    tmp <- as.data.frame(matrix(0, ncol = 2, nrow = 1))
    colnames(tmp) <- c("gainP", "lossP")
    gainloss <-
        lapply(1:nrow(colmatr),
               function(j)
               gainloss.func(dat = data,
                             cols = which(colmatr[ j, ] == 1),
                             thres = thres,
                             quant = quant.col)
               )
    dt <- dataSign[ ,colmatr[1,] == 1, drop = FALSE ]
    rsp <- rep(1, ncol(dt))
    for (j in 2:nrow(colmatr))
    {
        
        dt <- cbind(dt, dataSign[ ,colmatr[ j, ] == 1 ])
        rsp <- c(rsp, rep(j, sum(colmatr[ j, ] == 1)))
        
    }
    rsp <- rsp - 1

    ## Process statistics
    ## for plotting test stats and p-values

    res <- resT[clones.index,]
    maxT <- res$adjp[order(res$index)]
    
    teststat <- abs(res$teststat[order(res$index)])
    st.now <-
        sapply(p.thres,
               function(threshold) {
                   
                   if (any(maxT <= threshold))
                       min(teststat[maxT <= threshold])
                   else
                       NA
                   
               }
               )
    pal.now <- col.scheme$pal

    ##append to bac summary file
    if (summarize.clones)
        bac.summary <-
            cbind(bac.summary, res$rawp[order(res$index)], maxT)
    
    ##Now preparing for plotting:

    numchr <- numaut
    if (X)
        numchr <- numchr + 1
    if (Y)
        numchr <- numchr + 1
    chrominfo <- chrominfo[ 1:numchr, ]

    ##compute cumulative kb locations
    start <- c(0, cumsum(chrominfo$length))
    kb.loc <- datainfo$kb
    for (i in 1:nrow(chrominfo))
        kb.loc[datainfo$Chrom == i] <-
            start[i] + datainfo$kb[datainfo$Chrom == i]

    ## preparation for graphs
    chrom.start <- c(0, cumsum(chrominfo$length))[1:numchr]
    chrom.centr <- chrom.start + chrominfo$centr
    chrom.mid <- chrom.start + chrominfo$length / 2

    ##now, plot
    par(mfrow = c((if (onepage) nr else 1), 1), lab = c(1, 8, 7),
        tcl = -.2,  xaxs = "i")

    for (g in 1:length(titles))
    {

        gl <- gainloss[[g]]
        tl <- as.character(titles[g])
        ylm[1] <- min(ylm, min(gl$lossP))
        ylm[2] <- max(ylm, max(gl$gainP))

###        col.nrow <-
###            sapply(gl$gainMed,
###                   function(cl) {
                       
###                       if (cl >= nlim)
###                           cl <- nlim - 10 ^ (-6)
###                       cnr <- 
###                           which(cl >= matr.colors.gain[ ,1 ] &
###                                 cl < matr.colors.gain[ ,2 ])
###                       if (length(cnr) > 0)
###                           cnr
###                       else
###                           1
                       
###                   }
###                   )
        ind <- which(gl$gainP >= cutplot)
        plot(kb.loc[ind], gl$gainP[ind],
             col = "green",
###             as.character(matr.colors.gain[ind, 3][col.nrow[ind]]),
             type = "h", xlab = "chromosome number",
             ylab = "Fraction gained or lost", pch = 18, main = tl,
             ylim = ylm,
             xlim = c(0, max(cumsum(chrominfo$length), kb.loc[ind],
             rm.na = TRUE))
             )
###        col.nrow <-
###            sapply(gl$lossMed,
###                   function(cl) {
                       
###                       if (cl <=- nlim)
###                           cl <- -nlim + 10 ^ (-6)
###                       cnr <-
###                           which(cl >= matr.colors.loss[ ,1 ] &
###                                 cl < matr.colors.loss[ ,2 ])
###                       if (length(cnr) > 0)
###                           cnr
###                       else
###                           ngrid
                       
###                   }
###                   )
        ind <- gl$lossP >= cutplot
        points(kb.loc[ind], -gl$lossP[ind],
               col = "red",
###               as.character(matr.colors.loss[ind, 3][col.nrow[ind]]),
               type = "h")

        abline(h = 0)
        abline(v = cumsum(chrominfo$length), col = col.scheme$abline1)
        abline(v = chrom.centr, lty = 2, col = col.scheme$abline2)

        for (i in seq(2, numaut, b = 2))
            mtext(paste("", i), side = 3, at = (chrom.mid[i]),
                  line = .3, col = col.scheme$mtext, cex.main = .5)
        for (i in seq(1, numaut, b = 2))
            mtext(paste("", i), side = 1, at = (chrom.mid[i]),
                  line = .3, col = col.scheme$mtext, cex.main = .5)
        if (X)
            if (i == numaut)
                mtext("X", side = 1, at = (chrom.mid[numaut + 1]),
                      line = .3, col = col.scheme$mtext, cex.main = .5)
            else
                mtext("X", side = 3, at = (chrom.mid[numaut + 1]),
                      line = .3, col = col.scheme$mtext, cex.main = .5)
        if (Y)
            if (i == numaut)
                mtext("Y", side = 3, at = (chrom.mid[numaut + 2]),
                      line = .3, col = col.scheme$mtext, cex.main = .5)
            else
                mtext("Y", side = 1, at = (chrom.mid[numaut + 2]),
                      line = .3, col = col.scheme$mtext, cex.main = .5)
        
    }
    plot(kb.loc, teststat, col = col.scheme$kb.loc,
         ylim = c(0, max(teststat)), type = "h",
         xlab = "chromosome number", ylab = "clone statistic",
         pch = 18, main = paste(titles, collapse = " vs "),
         xlim = c(0, max(cumsum(chrominfo$length), kb.loc, rm.na = TRUE))
         )
    if (length(st.now) > 0)
        abline(h = rev(st.now), col = rev(pal.now), lty = 2)
    abline(v = cumsum(chrominfo$length), col = col.scheme$abline3)
    abline(v = chrom.centr, lty = 2, col = col.scheme$abline4)

    for (i in seq(1, numaut, b = 2))
        mtext(paste("", i), side = 1, at = chrom.mid[i], line = .3,
              col = col.scheme$mtext, cex.main = .5)
    for (i in seq(2, numaut, b = 2))
        mtext(paste("", i), side = 3, at = chrom.mid[i], line = .3,
              col = col.scheme$mtext, cex.main = .5)
    if (X)
        if (i == numaut)
            mtext("X", side = 1, at = chrom.mid[numaut + 1],
                  line = .3, col = col.scheme$mtext, cex.main = .5)
        else
            mtext("X", side = 3, at = chrom.mid[numaut + 1],
                  line = .3, col = col.scheme$mtext, cex.main = .5)
    if (Y)
        if (i == numaut)
            mtext("Y", side = 3, at = chrom.mid[numaut + 2],
                  line = .3, col = col.scheme$mtext, cex.main = .5)
        else
            mtext("Y", side = 1, at = chrom.mid[numaut + 2],
                  line = .3, col = col.scheme$mtext, cex.main = .5)

    if (summarize.clones)
    {
        
        bac.summary <- as.data.frame(bac.summary)
        nms <-
            c("NumPresent", "NumGain", "NumLost", "PropPresent",
              "PropGain", "PropLost")
        cnames <- colnames(bac.summary)
        cnames[1:6] <- paste(nms, "All", sep = ".")
        if (nrow(colmatr) > 1)
            for (m in 1:length(rsp.uniq))
                cnames[ (6 * m + 1):(6 * (m + 1)) ] <-
                    paste(nms, rsp.uniq[m], sep = ".")
        cnames[(ncol(bac.summary)-1):ncol(bac.summary)] <-
            c("rawp", "adjp.maxT")
        colnames(bac.summary) <- cnames
        bac.summary <- cbind(datainfo, bac.summary)	
###    write.table(bac.summary, filetable, col.names = TRUE, row.names = FALSE,
###                sep = "\t", quote = FALSE)
        invisible(bac.summary)
        
    }
    
}

## This description is old!
##frequency plot for the whole genome using outside p-values and stats

##data
##rsp -- phenotype, NA are not allowed, have to be consequetive integers
##datainfo
##chrominfo
##titles -- the titles of the frequency plots -- has to have as many names as 
##levels in the response
##thres -- unique threshold or vector of tumor specific thresholds. In the latter
##case has to contain as many thershold as samples
##cutplot -- don't plots clones which gained/lost in fewer than <= fraction of cases
##sign -- to do significance comparison (T) or not (F). to do comparison uses
##multtest package
##nperm -- if sign =T, then how many permutations for maxT
##test -- name of the test
##ranks -- whether to work with ranked data If nor, "n"
##side -- two sisded (abs) test or 1-sided ("upper" or "lower")
##p.thres -- for which adjusted p-values show the cut-off
##filePS -- name of the ps/pdf file
##PS = "ps" or "pdf"
##X=T -- is X (23) chrom included?
##Y=F  -- is Y (24) chrom included?
##numaut=22 -- number of autosomes
##ngrid=50: density of colors
##nlim=1: upper limit for solors
##mincolors: minimum limit for colors
##by defult "white"corersponds to [-.2,.2] and red and green to [-1,-.2] and [.2,1[]
##respectively
## quant.col=.5: percentile for coloring gaind/lost clones -- <= .5, E.g. .25
##would correspond to taking 25th % for lost and 75% for gained samples

plotFreqGivenStat <-
    function(aCGH.obj, stat, statPerm, pheno, summarize.clones = FALSE,
             ...)
{

    maxstat <- apply(statPerm, 2, max, na.rm = TRUE)
    plotFreqStat(aCGH.obj,
                 resT =
                 list(teststat = stat,
                      adjp =
                      sapply(teststat,
                             function(t.i) sum(maxstat >= t.i)
                             ) / length(maxstat)
                      ),
                 pheno,
                 summarize.clones = FALSE,
                 ...)
    
}

plotfreqGivenStatFinalColors <-
    function(aCGH.obj, ...)
    plotfreq.givenstat.final.colors.func(data =
                                         log2.ratios(aCGH.obj),
                                         datainfo =
                                         clones.info(aCGH.obj),
                                         ...)
##################################################################################
##necessary libraries:

require(sma)
require(cluster)
require(multtest) #bioconductor

##################################################################################

#################################################################################
##################################################################################

##auxilliary color finction

##########################################################################

##from marrayPlot: MUCH BETTER: USED IN function now

maPalette <-
    function (low = "white", high = c("green", "red"), mid = NULL,
              k = 50)
{
    
    low <- col2rgb(low) / 255
    high <- col2rgb(high) / 255
    if (is.null(mid))
    {
        
        r <- seq(low[1], high[1], len = k)
        g <- seq(low[2], high[2], len = k)
        b <- seq(low[3], high[3], len = k)
        
    }
    if (!is.null(mid))
    {
        
        k2 <- round(k / 2)
        mid <- col2rgb(mid) / 255
        r <-
            c(seq(low[1], mid[1], len = k2),
              seq(mid[1], high[1], len = k2))
        g <-
            c(seq(low[2], mid[2], len = k2),
              seq(mid[2], high[2], len = k2))
        b <-
            c(seq(low[3], mid[3], len = k2),
              seq(mid[3], high[3], len = k2))
        
    }
    rgb(r, g, b)
    
}


##########


##maColorBar <-
##    function (x, horizontal = TRUE, col = heat.colors(50),
##              scale = 1:length(x), k = 10, ...)
##{
    
##    if (is.numeric(x))
##        colmap <- col
##    else
##    {
        
##        colmap <- x
##        low <- range(scale)[1]
##        high <- range(scale)[2]
##        x <- seq(low, high, length = length(x))
        
##    }
##    if (length(x) > k)
##        x.small <- seq(x[1], x[length(x)], length = k)
##    else x.small <- x
##    if (horizontal) {
##        image(x, 1, matrix(x, length(x), 1), axes = FALSE, xlab = "",
##              ylab = "", col = colmap, ...)
##        axis(1, at = rev(x.small), labels = signif(rev(x.small),
##                                   2), srt = 270, col="white")
##    }
##    if (!horizontal) {
##        image(1, x, matrix(x, 1, length(x)), axes = FALSE, xlab = "",
##              ylab = "", col = colmap, ...)
##        par(las = 1)
##        axis(4, at = rev(x.small), labels = signif(rev(x.small),
##                                   2), col="white")
##        par(las = 0)
##    }
##    box()
##}

##########################################################################
############################OLD::::
##########################################################################

##rgcolors.my.func <-
##    function (n = 50)
##{
    
##    k <- round(n / 2)
##    g <- c(rep(0, k), seq(0, 1, length = k))
##    r <- c(rev(seq(0, 1, length = k)), rep(0, k))
##    rgb(r, g, rep(0, 2 * k))

##}

#################################################################################
##################################################################################


##SHOULD it BE (0, lim) rather tha (0,1)

##auxilliary function for image

##rgcolors.my.black.func <-
##    function (n = 50, lm = 1)
##{
    
##    k <- round(n/2)
##    g <- c(rep(0, k), seq(0, lm, length = k))
##    r <- c(rev(seq(0, lm, length = k)), rep(0, k))
##    b <- rep(0, 2 * k)
##    rgb(r, g, b)

##}



##################################################################################
##################################################################################

##auxilliary function for image

##colorbar.my.black.func <- function(n=50, lim=1, y=1, coloraxis="black")
##{
##    mx <- lim
##    mn <- -mx
##    x<-seq(mn,mx,length=n)
##    image(1:length(x),y,matrix(x,length(x),1),col=rgcolors.my.black.func(n,lim),axes=FALSE,xlab="",ylab="")
##    ##axis(2,at=length(x):1,labels=rev(x),srt=270)
##    ##axis(1,at=length(x):1,labels=rev(x),srt=270, col.axis=coloraxis)
##    box()
##}

##if we want to create image:

##postscript("colorrange.ps", paper="letter")
##par(bg="grey20")    
##colorbar.my.black.func(lim=1,n=20, coloraxis="white")    
##box()
##dev.off()


##postscript("colorrange.ps", paper="letter")
##par(bg="grey20")    
##lm <- 1
##k <- 50
##maColorBar(x=seq(-lm,lm,len=k), col = maPalette(low="red", high="green", mid="white", k=k), h=T)  
##dev.off()
##


##old color-bar function:

##colorbar.my.black.func <- function(lim=1, y=1, coloraxis="black")
##{
##  max <- lim
##  min <- -max
##  n <- (1/(max-min))*100
##  step <- 10*max/(2*50)
##  x<-seq(min,max,by=step)
##  image(1:length(x),y,matrix(x,length(x),1),col=
##rgcolors.my.black.func(n),axes=FALSE,xlab="",ylab="")
##  ##axis(2,at=length(x):1,labels=rev(x),srt=270)
##  axis(1,at=length(x):1,labels=rev(x),srt=270, col.axis=coloraxis)
##  box()
##}

########################OLD ENDED########################################
##################################################################################
##################################################################################

##flooring function. auxilliary function for image

##floor.func <- function(x, floor)
##{
##    x[x > floor & !is.na(x)] <- floor
##    x[x < -floor & !is.na(x)] <- -floor
##    x
##}


##################################################################################
##################################################################################

##create image plots per chromosomes

##data- p by n matrix of lograt. missing values are ok (codede as NA)
##phen- phenotype appearing on the left side of the image. no missing values are allowed
##datainfo -- p by >= 3 matrix. Has to contain columns Clone, Chrom and lb
##chrominfo -- file describing lengths of chromosomes and centromere location
##chrom -- which chromosomes to show
##cutoff- where to cut-off the values too. Lower values make image colors brighter. 
##amplif -- anything >= is marked with yellow dots
##homde -- anything <= is marked with light blue dots
##bycllass-- whether to order samples and cluster them inside the class (T) or cluster
##all samples (F). Clustering is done using agglom. hierachical clustering with average
##linkage
##samplenames-- shown on the right. anything can be there
##clonenames -- names of the clones. Shown on the bottom
##ttl -- title of the image
##filePS -- name of the PS file

##Note that clustering is done based on individual chromosomes and order of ssamples
##varies from chromosome to chromosome

plotvalChrom.func <-
    function(data, phen=rep(1, ncol(data)), datainfo=clones.info,
             chrominfo=human.chrom.info.Jul03, chrom=1:20, cutoff=1, ncolors=50,
             amplif=1, homdel=-1, byclass=TRUE,
             samplenames=dimnames(data)[[2]],
             clonenames=datainfo$Clone, ttl="Image Plot",
             filePS="plotvalschrom.ps", ps=TRUE)
{
    ##label.col <- c("red", "green", "blue", "yellow", "skyblue", "orange", "pink", "gray20")
    label.col <- rainbow(6)
    if (ps)
    {
	postscript(filePS, paper="letter")
    }
    else
    {
	pdf(filePS, width=11, height=8.5)
    }
    par(bg="grey20")    
    samplenames.cp <- samplenames
    for (chr in chrom)
    {   
        resp0 <- phen
        resp <- resp0
        samplenames <- samplenames.cp
        if (!(byclass))
        {
            resp <- rep(1, length(resp0))
        }

        tbl.resp <- table(resp)
        kb <- datainfo$kb[datainfo$Chrom==chr]
        dt <- as.matrix(data[datainfo$Chrom==chr,])
        clonenms <- clonenames[datainfo$Chrom==chr]


        dt.cp <- dt
        dt <- apply(dt.cp, 2,floor.func, cutoff)       
        if (chrominfo$centr[chr] >0)
        {
            centr <- length(kb[kb<=chrominfo$centr[chr]])
        }
        dt <- dt[,order(resp)]
        dt.cp <- dt.cp[,order(resp)]
        resp0 <- resp0[order(resp)]
        samplenames <- samplenames[order(resp)]
        resp <- resp[order(resp)]


        start <- 1

        ##mapping order
        ord <- rep(0, length(resp))
        for (i in 1:(length(tbl.resp)))
        {
            
            ind <- which(resp == i)
            cr <- as.dist(1-cor.na(dt.cp[,ind]))
            ord[start:sum(tbl.resp[1:i])] <- hclust(cr, method="ave")$ord+start-1
            start <- sum(tbl.resp[1:i])+1
        }

        dt <- dt[,ord]
        dt.cp <- dt.cp[,ord]
        resp <- resp[ord]
        resp0 <- resp0[ord]
        samplenames <- samplenames[ord]

        image(x=(1:length(kb)), y=1:length(resp), z=dt, col = maPalette(low = "red", high = "green", mid = "white" ,k=ncolors), axes = FALSE, xlab = "", ylab = "", zlim=c(-cutoff, cutoff))

        if (chrominfo$centr[chr] >0)
        {
            abline(v=centr, col="black")
        }
        for (i in 1:nrow(dt))
        {

            ##if ((i %% 2) == 0)
            ##{
            ##	
            ##	mtext(paste(clonenms[i], ""), side = 1, at = i, line=.3, col="white", cex=.5, las=2)
            ##}
            ##else
            ##{	
            ##	mtext(paste(clonenms[i], ""), side = 3, at = i, line=.3, col="white", cex=.5, las=2)
            ##}
            mtext(paste(clonenms[i], ""), side = 1, at = i, line=.3, col="white", cex=.25, las=2)
            for (j in 1:ncol(dt.cp))
            {
		if (i ==1)
		{
                    mtext((resp0)[j], side = 2, at = j, line=.3, col=label.col[((resp0)[j]+1)], cex=.5, las=2)
                    mtext(paste((samplenames)[j], ""), side = 4, at = j, line=.3, col=label.col[((resp0)[j]+1)], las=2, cex=.5)
                    
		}
		if (!is.na(dt.cp[i,j]) && dt.cp[i,j]>=amplif)
		{	
                    
                    points(i, j, col="yellow", pch=20, cex=.7)
		}
		if (!is.na(dt.cp[i,j]) && dt.cp[i,j] <= homdel)
		{	
                    
                    points(i, j, col="skyblue", pch=20, cex=.7)
		}
		
            }
        }
        title(main=paste(ttl, " Chromosome ", chr), col.main="white")


    }
    dev.off()
}

##################################################################################
##################################################################################

#############################################################################

##creates the color scale graph
##k=50
##lm=1
##maColorBar(x=seq(-lm,lm,len=k), col = maPalette(low="red", high="green", mid="white", k=k), h=TRUE) 
##postscript("colorrange.ps", paper="letter")
##par(bg="grey20")    

##dev.off()
##
##
#############################################################################

##################################################################################
################################################################################
##################################################################################
##################################################################################

##plots images of correlation matrices

##X -- is p by n data matrix or p by p correlation matrix 
##new =TRUE if correlation matrix and F if data matrix and correlation needs to be computed
##

##plot.my.cor <-
##    function (X, new = TRUE, nrgcols = 50, labels = FALSE, labcols = 1,
##              title = "", ...)
##{
    
##    n <- ncol(X)
##    corr <- X
##    if (new)
##        corr <- cor.na(X)
##    image(1:n, 1:n, corr[, n:1], col = maPalette(low = "red", high = "green", mid = "black", k=nrgcols),
##          axes = FALSE, xlab = "", ylab = "",...)
##    if (length(labcols) == 1) {
##        axis(2, at = n:1, labels = labels, las = 2, cex.axis = 0.6,
##             col.axis = labcols)
##        axis(3, at = 1:n, labels = labels, las = 2, cex.axis = 0.6,
##             col.axis = labcols)
##    }
##    if (length(labcols) == n) {
##        cols <- unique(labcols)
##        for (i in 1:length(cols)) {
##            which <- (1:n)[labcols == cols[i]]
##            axis(2, at = (n:1)[which], labels = labels[which],
##                 las = 2, cex.axis = 0.6, col.axis = cols[i])
##            axis(3, at = which, labels = labels[which], las = 2,
##                 cex.axis = 0.6, col.axis = cols[i])
##        }
##    }
##    mtext(title, side = 3, line = 3)
##    box()
    
##}
################################

##################################################################################
##################################################################################

##averages correlation in a given bin. 

##cor.all -- p by p matrix of cross-correlations
##bin -- size of the bin (in kb)
##datainfo -- as before
##chrominfo -- as before
##lm -- the floor

##note that each chromosome is subdivided into the equasized number of bins
##so that their size is as close to specified bin as possible. The resulting
##bin sizes will slightly vary across chromosomes


##cor.bin.func <-
##    function(cor.all, bin, datainfo, chrominfo, lm=1)
##{
    
##    bin.num <- round( chrominfo$length/bin)
##    for (i in 1:length(bin.num))
##    {
##        if (bin.num[i] == 0)	
##        {
##            bin.num[i] <- 1
##        }
##    }
##    bin.size <- chrominfo$length/bin.num
    
##    cor.bin <- matrix(0, nrow=sum(bin.num), ncol=sum(bin.num))
    
##    chrom.bound <-  c(0,cumsum(bin.num))
##    chrom.bound.mid <- chrom.bound[-length(chrom.bound)]+diff(chrom.bound)/2
##    chrom.bound <- chrom.bound[2:(length(chrom.bound)-1)]
    

##    kb <- datainfo$kb
##    kbCum <- datainfo$kbCum
##    chr <- datainfo$Chrom
    
##    chruniq <- unique(chr)	
    

##    mx <- 1
    
##    for (ix in 1:length(chruniq))
##    {
        
##        for (jx in 1:bin.num[ix])
##        {
##            startx <- bin.size[ix]*(jx-1)
##            endx <- bin.size[ix]*jx
##            indx <- (1:length(kb))[kb >=startx & kb < endx & chr ==ix]
##            my <- 1
##            for (iy in 1:length(chruniq))
##            {
                
##                for (jy in 1:bin.num[iy])
##                {
##                    starty <- bin.size[iy]*(jy-1)
##                    endy <- bin.size[iy]*jy
##                    indy <- (1:length(kb))[kb >=starty & kb < endy & chr ==iy]
##                    if ((length(indx) > 0) && (length(indy) > 0))
##                    { 
##                        cor.mean <- mean(cor.all[indx, indy], na.rm=TRUE)
##                        if (cor.mean > lm)
##                        {
##                            cor.mean <- lm
##                        }
##                        if (cor.mean < -lm)
##                        {
##                            cor.mean <- -lm
##                        }
                        
##                    }
##                    else
##                    {
##                        cor.mean <- NA
##                    }
##                    cor.bin[mx,my] <- cor.mean
                    
##                    my <- my+1
##                }
##            }
##            mx <- mx+1
##        }
##    }
##    list(cor.bin=cor.bin, chrom.bound=chrom.bound, chrom.bound.mid=chrom.bound.mid)
##}


##################################################################################
##################################################################################

##plots genome

##plotGenome0.func <- function(sample, yScale = c(-2,2), namePSfile = "try.ps", data=Log2Rat, datainfo=clones.info, chrominfo=chrom.info, samplenames=sampleNames, naut = 22, X=TRUE, Y=TRUE, ps=TRUE, plotend=TRUE)
##{

##    nsamples <- length(sample)
##    ord <- order(datainfo$Chrom, datainfo$kb)
##    chrom <- datainfo$Chrom[ord]
##    kb <- datainfo$kb[ord]
##    data <- data[ord,]

##    chrom.rat <- chrominfo$length/max(chrominfo$length)
##    chrom.start <- rep(0, nrow(chrominfo))
##    for (i in 2:length(chrom.start))
##    {
##        chrom.start[i] <- sum(chrominfo$length[1:(i-1)])
##    }
##    ##
##    ##
##    ##chrom.mid contains middle positions of the chromosomes relative to
##    ##the whole genome (useful for plotting the whole genome)
##    ##
##    chrom.mid <- rep(0, nrow(chrominfo))
##    for (i in 1:length(chrom.start))
##    {
##        chrom.mid[i] <- chrom.start[i]+chrominfo$length[i]/2
##    }
##    if (plotend)
##    {
##        ##start a postscript file
##	if (ps)
##	{
##            postscript(namePSfile, paper="letter")
##	}
##	else
##	{
##            pdf(namePSfile, height=8.5, width=11)
##	}

##	par(mfrow=c(nsamples,1))
##    }
##    par(cex=.6, pch=18, lab=c(1,6,7), cex.axis=1.5, xaxs="i")
##    for (k in 1:nsamples)
##    {

##        vec <- data[,sample[k]]
##        name <- samplenames[sample[k]]

##        clone.genomepos <- rep(0, length(kb))
##        for (i in 1:nrow(chrominfo))
##        {
##            clone.genomepos[chrom==i] <- kb[chrom==i]+chrom.start[i]
##        }
######################

######################
##        ##Now, determine vertical scale for each chromosome:

##        y.min <- rep(yScale[1], nrow(chrominfo))
##        y.max <- rep(yScale[2], nrow(chrominfo))
        
##        for (i  in 1:nrow(chrominfo))
##        {
##            if (min.na(vec[(chrom==i)]) < y.min[i])
##            {
##                y.min[i] <- min.na(vec[(chrom==i)])
##            }
##            if (max.na(vec[(chrom==i)]) > y.max[i])
##            {
##                y.max[i] <- max.na(vec[(chrom==i)])
##            }
            
##        }
        
##        ##set genome scale to the min and mx values of the rest of the chromosomes:
        
##        ygenome.min <- min.na(y.min)
##        ygenome.max <- max.na(y.max)
        
        
        
###########################
        
##        plot(clone.genomepos/1000, vec, ylim=c(ygenome.min,ygenome.max), xlab="", ylab="", xlim=c(min(clone.genomepos[clone.genomepos>0], na.rm=TRUE)/1000, clone.genomepos[length(clone.genomepos[clone.genomepos>0])]/1000), col="black")
        
##        ##title(main=paste(name, " ", sample[k], " - Whole Genome"), ylab="Log2Ratio", xlab="Chromosome", cex.lab=1.5,cex.main=2)
##        title(main=paste(sample[k], " ", name), ylab="Log2Ratio", xlab="", cex.lab=1.5,cex.main=2)
        
##        for (i in seq(1,naut,b=2))
##        {
##            mtext(paste("", i), side = 1, at = (chrom.mid[i]/1000), line=.3, col="red")
##        }
##        for (i in seq(2,naut,b=2))
##        {
##            mtext(paste("", i), side = 3, at = (chrom.mid[i]/1000), line=.3, col="red")
##        }

##        if (X)
##        {
##            mtext("X", side = 1, at = (chrom.mid[naut+1]/1000), line=.3, col="red")
##        }
##        if (Y)
##        {
##            mtext("Y", side = 3, at = (chrom.mid[naut+2]/1000), line=.3, col="red")
##        }

##        abline(v=c(chrom.start/1000, (chrom.start[nrow(chrominfo)]+chrominfo$length[nrow(chrominfo)])/1000), lty=1)
##        ##abline(h=seq(ygenome.min,ygenome.max, b=.2), lty=3)
##        abline(h=seq(-1,1, b=.5), lty=3)

##        abline(v=(chrominfo$centromere+ chrom.start)/1000, lty=3, col="red")
##    }
##    if (plotend)
##    {
##	dev.off()
##    }
##}


##################################################################################
##################################################################################

##plots chromosomes

##plotChrom0.func <-
##    function(sample, chr, yScale = c(-1,1), namePSfile = "try.ps",
##             data, datainfo, chrominfo=human.chrom.info.Jul03,
##             samplenames=sampleNames)
##{
    
##    nsamples <- length(sample)
##    ord <- order(datainfo$Chrom, datainfo$kb)
##    chrom <- datainfo$Chrom[ord]
##    kb <- datainfo$kb[ord]
##    data <- data[ord,]
    
##    ##start a postscript file
    
##    postscript(namePSfile, paper="letter")
##    par(mfrow=c(nsamples,1))
##    par(cex=.6, pch=18, lab=c(1,6,7), cex.axis=1.5)
##    kb <- kb[chrom==chr]
##    centr.loc <- chrominfo$centromere[chr]
##    for (k in 1:nsamples)
##    {
        
##        vec <- data[chrom==chr,sample[k]]
##        name <- samplenames[sample[k]]
        
######################
##        ##Now, determine vertical scale for each chromosome:
        
##        y.min <- min(yScale[1],min.na(vec))
##        y.max <- max(yScale[2],max.na(vec))
        
        
###########################
        
##        plot(kb/1000, vec, ylim=c(y.min,y.max), xlab="", ylab="", xlim=c(min(kb[kb>0], na.rm=TRUE)/1000, kb[length(kb[kb>0])]/1000), col="black", cex=1.5)
##        lines(kb/1000, vec, col="blue",lwd=.5)
##        abline(v=centr.loc/1000, col="red", lty=2)
##        abline(h=0, col="black", lty=2)
##        abline(h=seq(-.6,.6, b=.2), lty=3)
##        title(main=paste(name, " Chr ",chr), ylab="Log2Ratio", xlab="Chromosome", cex.lab=1.5,cex.main=2)
        
##    }
##    dev.off()
##}

##################################################################################
##################################################################################

##creating chromFull.info file

##plot entire genome or chrom. or all chrom's:

##chrom.rat <- chrom.info$length/max(chrom.info$length)  
##i.e. for each chromosome it repreesents the fraction of length of the
##longest chromosome
##
##chrom.start contains starting positions of the chromosomes relative to the
##whole genome (0 for the first)
##chrom.start <- rep(0, 23)
##for (i in 2:length(chrom.start))
##{
##	chrom.start[i] <- sum(chrom.info$length[1:(i-1)])
##}
##
##chrom.mid contains middle positions of the chromosomes relative to
##the whole genome (useful for plotting the whole genome)
##chrom.mid <- rep(0, 23)
##for (i in 1:length(chrom.start))
##{
##	chrom.mid[i] <- chrom.start[i]+chrom.info$length[i]/2
##}
##
##chromFull.info <- as.data.frame(cbind(chrom.info, chrom.start, chrom.mid, chrom.rat))
##dimnames(chromFull.info)[[2]] <- c("chr", "length", "centromere", "start", "mid", "rat")
##################################################################################
##################################################################################

##plots
##either all chromsoomes and genome/whole genome/or individual chromosome
##data -- as before
##map -- clones.info
##samplename -- index or samplename of the smaple to plot
##sampNm -- vector of sample names
##whatToPlot: "All" -- all chromosomes and Gneome/ "G" -- Genome or chromosomal number

plotCGH.func <-
    function (data=data.cgh, map=map.cgh, chrominfo=human.chrom.info.Jul03,
              samplename, sampNm=sampleNames, whatToPlot= "All",
              yScale = c(-2,2), namePSfile = "plotCGH.ps")
{
################General Comments############################################
    ##Jane Fridlyand, 08/13/2001
    ##
    ##Function to plot CGH data so that the horizontail box sizes are proportinal
    ##to the physical lengths of chromosomes###
    ##
    ##Lots of comments here (required files etc)
    ##
##############################################################################
###############################NOTE##################################
    ##
    ##This function does no trouble shooting -- when one of the necessary files
    ##is in the wrong format and can not be read in or just not available,
    ##it fails.
##################End of NOTE#######################################
######################################################################
#################ARGUMENTS############################################
    ##
    ##Parametesr that probably should not be controlled by an average user:
    ##
    ##1. data: name of the data file containing intensity ratio data
    ## default is data.cgh
    ##samples are in columns and clones are in rows
    ##
    ##2. map: name of the file containing 2 columns: chr and kb
    ##default is map.cgh
    ##
    ##3. chrominfo -- name of the file containing 6 columns: chr, length, 
    ##   centromere, start, mid, rat (ratio w.r.t to the longest chrom.
    ##
#########################################
    ##
    ##Required:
    ##
    ##1. samplename or index of a sample to plot 
    ##
    ##
##########Parameters that should be controlled by an average user:
    ##
    ##1. whatToPlot: to plot
    ##    a) 23 chromosomes and whole genome (All) -- default
    ##    b) 1 chromosome only (number of a chromosome) 
    ##    c) whole genome only (G)
    ##
    ##
    ##2. yScale: 
    ##   number to which scale is fixed. default is is c(-2,2)
    ##   scales are adjusted for chromsomes which are outside that range
    ##
    ##3. namePSfile -- gets used only if PS file is to be created: -- name 
    ##   default is plotCGH.ps 
    ##
#######################################################################
#########################################################################
#########################EXAMPLES of USAGE #############################
    ##
    ##Suppose a CGH  file "/path/filename" needs to be analyzed.
    ##
###
    ##Vanilla Example:
    ##
    ##to plot 23 chromosomes and genome with vertical scale of (-2,2) and produce
    ## output ps file "plotCGH.ps" for a 5-th sample
    ##
    ##plotCGH.func(samplename=5)
    ##
###
    ##to plot 23 chromosomes and genome with vertical scale of (-1,1) 
    ##and produce output ps file "path/new.ps" for a samplename "mysample.txt"
    ##
    ##plotCGH.func(samplename="mysample.txt",yScale=c(-1,1),namePSfile ="/path/new.ps")
    ##
####
    ##plot chromosome 1 only with vertical scale (-2,2) for a smaplename 6:
    ##
    ##plotCGH.func(samplename=6,whatToPlot = 1)
    ##
###
    ##plot whole Genome only:
    ##
    ##plotCGH.func(samplename=6,whatToPlot = "G")
    ##
#########################END of EXAMPLES of USAGE ############################
#######################################################################
#########################################################################

#####################START#################################################

#########creating chromFull.info file

    chrom.rat <- chrominfo$length/max(chrominfo$length)  
    ##i.e. for each chromosome it repreesents the fraction of length of the
    ##longest chromosome
    ##
    ##chrom.start contains starting positions of the chromosomes relative to the
    ##whole genome (0 for the first)
    chrom.start <- rep(0, 23)
    for (i in 2:length(chrom.start))
    {
	chrom.start[i] <- sum(chrominfo$length[1:(i-1)])
    }
    ##
    ##chrom.mid contains middle positions of the chromosomes relative to
    ##the whole genome (useful for plotting the whole genome)
    chrom.mid <- rep(0, 23)
    for (i in 1:length(chrom.start))
    {
	chrom.mid[i] <- chrom.start[i]+chrominfo$length[i]/2
    }

    chromFull.info <- as.data.frame(cbind(chrominfo, chrom.start, chrom.mid, chrom.rat))
    dimnames(chromFull.info)[[2]] <- c("chr", "length", "centromere", "start", "mid", "rat")

########################################


    ##computing positions in genome for each clone:

    clone.genomepos <- rep(0, length(map$kb))
    for (i in 1:23)
    {
	clone.genomepos[map$Chrom==i] <- map$kb[map$Chrom==i]+chromFull.info$start[i]
    }

##########
    ##Now, determine vertical scale for each chromosome:

    y.min <- rep(yScale[1], 23)
    y.max <- rep(yScale[2], 23)

##############
    ##figure out the sample
    ##
    smpnames <- sampNm
    if ((samplename >= 1) && (samplename <= nrow(data)))
        ##samplename was the index
    {
	smp <- samplename
	samplename <- smpnames[smp]
        ##so now samplename is a name
    }
    else #samplename 
    {
	
	smp <- (1:length(smpnames))[smpnames==samplename]
    }
##############
    ##values to plot:

    vals <- data[,smp]

#############
    ##adjust scales of chromosomes that have values outside a fixed scale

    for (i in 1:23)
    {
	y.min[i] <- min(c(vals[map$Chrom==i],yScale[1]), na.rm=TRUE)
	y.max[i] <- max(c(vals[map$Chrom==i],yScale[2]), na.rm=TRUE)
    }

    ##set genome scale to the max and min values across chrom's

    ygenome.min <- min(y.min, na.rm=TRUE)
    ygenome.max <- max(y.max, na.rm=TRUE)	

#########################
    ##start a postscript file

##########start plotting:

    ##plot one chromosome only:

    if ((whatToPlot >= 1) && (whatToPlot <= 23)) 
    {
	postscript(namePSfile, paper="letter")
	par(lab=c(15,6,7), pch=18, cex=1, lwd=1)
	plot(map$kb[map$Chrom==whatToPlot]/1000, vals[map$Chrom==whatToPlot], ylim=c(y.min[whatToPlot],y.max[whatToPlot]), xlab="", ylab="", col="black", xlim=c(0, chromFull.info$length[whatToPlot]/1000))
	lines(map$kb[map$Chrom==whatToPlot]/1000, vals[map$Chrom==whatToPlot],col="blue")
	title(main=paste("Sample ", samplename, " ", smp, " Chr ",whatToPlot), xlab="kb (in 1000's)", ylab="Log2Ratio")
	abline(h=seq(-.6,.6, b=.2), lty=3)
	abline(h=0, col="black", lty=2)
	abline(v=chromFull.info$centromere[whatToPlot]/1000, lty=2, col="red")
	dev.off()
    }

    ##if plot whole genome only:

    else if (whatToPlot == "G")
    {
	postscript(namePSfile, paper="letter")
	par(cex=.6, pch=18, lab=c(1,6,7), cex.axis=1.5, xaxs="i")
	plot(clone.genomepos[map$Chrom<=23]/1000, vals[map$Chrom<=23], ylim=c(ygenome.min,ygenome.max), xlab="", ylab="", xlim=c(min(clone.genomepos[clone.genomepos>0], na.rm=TRUE)/1000, clone.genomepos[length(clone.genomepos[clone.genomepos>0])]/1000), col="black")
        title(main=paste("Sample ", samplename, " ", smp, "Whole Genome"), ylab="Log2Ratio", xlab="Chromosome", cex.lab=1.5,cex.main=2)
	for (i in seq(1,21,b=2))
	{	
            mtext(paste("", i), side = 1, at = (chromFull.info$mid[i]/1000), line=.3, col="red")
	}
	mtext("X", side = 1, at = (chromFull.info$mid[length(chromFull.info$mid)]/1000), line=.3, col="red")
	abline(v=c(chromFull.info$start/1000, (chromFull.info$start[23]+chromFull.info$length[nrow(chrominfo)])/1000), lty=1)
	abline(h=seq(ygenome.min,ygenome.max, b=.2), lty=3)
	abline(v=(chromFull.info$centromere+ chromFull.info$start)/1000, lty=3, col="red")
	dev.off()
    }
    else #if all chromosomes and genome are plotted:
    {
	postscript(namePSfile, paper="letter", horizontal=FALSE)
        ##just a safety line
	close.screen(all=TRUE)
        ##"inch" factor for to determine size of the plot in inches (for "pin" parameter)
	fact <- 3.9
        ##split the screen

	split.screen(c(9,1))
	screen(1)
	split.screen(c(1,2))
	screen(2)
	split.screen(c(1,2))
	screen(3)
	split.screen(c(1,2))
	screen(4)
	split.screen(c(1,2))
	screen(5)
	split.screen(c(1,3))
	screen(6)
	split.screen(c(1,3))
	screen(7)
	split.screen(c(1,4))
	screen(8)
	split.screen(c(1,3))
	screen(28)
	split.screen(c(1,2))
	screen(29)
	split.screen(c(1,2))

        ##plot chromosomes

	scr.seq <- c(10:27, 31:34, 30)  
	j.seq <- 1:23
	for (j in j.seq)
	{
            
            screen(scr.seq[j])
            par(cex=.5, pch=20, lab=c(15,4,7), tcl=-.2, las=1, oma=c(0,0,0,0), cex.axis=1.3, cex.main=1.3, mgp=c(0,.15,0), lwd=.5)
            par(pin=c(chromFull.info$rat[j]*fact, .65))
            
            plot(map$kb[map$Chrom==j]/1000, vals[map$Chrom==j], ylim=c(y.min[j],y.max[j]), xlab="", ylab="", type="l", col="blue", xlim=c(0, chromFull.info$length[j]/1000))
            points(map$kb[map$Chrom==j]/1000, vals[map$Chrom==j], col="black")
            
            if (j < 23)
            {
		title(main=paste("Chr",j), line=.1)
            }
            else
            {
                title(main="Chr. X", line=.1)
            }
            abline(h=seq(y.min[j],y.max[j], b=.5), lty=3)
            abline(v=0, lty=2)		
            abline(v=chromFull.info$centromere[j]/1000, lty=2, col="red")
            
	}
	
        ##plot genome:
	screen(9 )

	par(cex=.5, pch=20, lab=c(1,4,7), tcl=-.2, las=1, cex.axis=1.3, mgp=c(0,.15,0), cex.main=1.3, xaxs="i")
	par(pin=c(7.8, .55))
	plot(clone.genomepos[map$Chrom<=23]/1000, vals[map$Chrom<=23], ylim=c(ygenome.min,ygenome.max), xlab="", ylab="", xlim=c(min(clone.genomepos[clone.genomepos>0], na.rm=TRUE)/1000, clone.genomepos[length(clone.genomepos[clone.genomepos>0])]/1000), col="black", type="l", lwd=1)
	title(main="Whole Genome (not to horizontal scale)",line=.1)
	for (i in seq(1,21,b=2))
	{	
            mtext(paste("", i), side = 1, at = (chromFull.info$mid[i]/1000), line=.3, col="red", cex.main=.5)
	}
	mtext("X", side = 1, at = (chromFull.info$mid[nrow(chromFull.info)]/1000), line=.3, col="red",cex.main=.5)
	abline(v=c(chromFull.info$start/1000, (chromFull.info$start[23]+chromFull.info$length[nrow(chromFull.info)])/1000), lty=1)
	abline(h=seq(ygenome.min,ygenome.max, b=.5), lty=3)
	abline(v=(chromFull.info$centromere+chromFull.info$start)/1000, lty=3, col="red")

        mtext(paste("Sample ", samplename, " ", smp, "Log2Ratio of Intensities vs Position in 1000's kb"), outer=TRUE, line=-1.2, cex=.8)
	dev.off()
    }
####################
    

}

#################################################################################
#################################################################################
##auxilliary function for frequency plot

##gainloss.func <- function (dat, cols,thres, quant=.5)
##{

##if (length(thres) == 1)
##{

##	thres <- rep(thres, ncol(dat))
##}
##if (length(thres) != ncol(dat))
##{
##	print("Error: number of thresholds is not the same as number of tumors")
##	exit()
##}

##dt <- as.matrix(dat[,cols])
##thr <- thres[cols]
##gain <- rep(0, nrow(dt))
##gain.med <- gain
##loss <- rep(0, nrow(dt))
##loss.med <- loss

##for (i in 1:nrow(dt))
##{
##	x <- dt[i,]
##	th <- thr[!is.na(x)]
##	x <- x[!is.na(x)]
##	tmp.gain <- x-th
##	tmp.loss <- x+th
##	gain[i] <- length(tmp.gain[tmp.gain>=0])/length(x)
##	if (gain[i] > 0)
##	{
##		#gain.med[i] <- median(x[tmp.gain>=0])
##		gain.med[i] <- quantile(x[tmp.gain>=0], 1-quant)
##	}
##	loss[i] <- length(tmp.loss[tmp.loss<=0])/length(x)
##	if (loss[i] > 0)
##	{
##		#loss.med[i] <- median(x[tmp.loss<=0])
##		loss.med[i] <- quantile(x[tmp.loss<=0], quant)
##	}
##}

##list(gainP=gain, lossP=loss, gainMed=gain.med, lossMed=loss.med)

##}
#################################################################################
#################################################################################



##################################################################################
##################################################################################

##frequency plot for the whole genome

##data
##rsp -- phenotype, NA are not allowed, have to be consequetive integers
##datainfo
##chrominfo
##titles -- the titles of the frequency plots -- has to have as many names as 
##levels in the response
##thres -- unique threshold or vector of tumor specific thresholds. In the latter
##case has to contain as many thershold as samples
##cutplot -- don't plots clones which gained/lost in fewer than <= fraction of cases
##sign -- to do significance comparison (T) or not (F). to do comparison uses
##multtest package
##nperm -- if sign =TRUE, then how many permutations for maxT
##test -- name of the test
##ranks -- whether to work with ranked data If nor, "n"
##side -- two sisded (abs) test or 1-sided ("upper" or "lower")
##p.thres -- for which adjusted p-values show the cut-off
##filePS -- name of the ps/pdf file
##PS = "ps" or "pdf"
##X=TRUE -- is X (23) chrom included?
##Y=FALSE  -- is Y (24) chrom included?
##numaut=22 -- number of autosomes

plotfreq.stat.final.func <-
    function(data, rsp,datainfo, chrominfo, titles, thres=.2,cutplot =
             0, ylm=c(-1,1), sign=FALSE, dataSign=data, nperm=1000,
             test="f", ranks="y", side="abs",
             p.thres=c(.01,.05,.1,.2), X=TRUE, Y=FALSE, numaut=22,
             filePS="gainslosses.ps", PS="ps", onepage=TRUE)
{

    rsp.uniq <- unique(rsp)
    colmatr <- matrix(0, nrow=length(rsp.uniq), ncol=length(rsp))
    for (i in 1:nrow(colmatr))
    {
	colmatr[i,rsp==rsp.uniq[i]] <- 1
    }



    pal <- c("red", "blue", "green", "yellow")


    if (nrow(colmatr) == 1)
    {
	sign <- F
    }

    nr <- nrow(colmatr)
    if (sign)
    {	
	nr <- nr+1
	
    }

    tmp <- matrix(0, ncol=2,nrow=1)   
    tmp <- as.data.frame(tmp) 
    dimnames(tmp)[[2]] <- c("gainP", "lossP")   
    gainloss <- rep(list(tmp),nrow(colmatr))            

    for (j in 1:nrow(colmatr))
    {
	
	cols <- (1:ncol(colmatr))[colmatr[j,]==1]
	gainloss[[j]] <- gainloss.func(dat=data, cols=cols,thres=thres)
	
    }

    if (sign)
    {
	dt <- dataSign[,colmatr[1,]==1]
	rsp <- rep(1, ncol(dt))
	for (j in 2:nrow(colmatr))
	{
            dt <- cbind(dt, dataSign[,colmatr[j,]==1])
            rsp <- c(rsp, rep(j, ncol(dataSign[,colmatr[j,]==1])))
	}
	rsp <- rsp-1
	res <-  mt.maxT(X=dt,classlabel=rsp,test=test,side=side,fixed.seed.sampling="y",B=nperm, na=.mt.naNUM, nonpara=ranks)
	maxT <- res$adjp[order(res$index)]
        ##rawp <- res$rawp[order(res$index)]
	teststat <- abs(res$teststat[order(res$index)])
	st <- rep(NA, length(p.thres))
	for (s in 1:length(p.thres))
	{
            if (length(maxT[maxT<=p.thres[s]]) > 0)
            {
                st[s] <- min(teststat[maxT<=p.thres[s]])
            }
	}
        
        ##st.now <- st[!is.na(st)]
        ##pal.now <- pal[!is.na(st)]

	st.now <- st
	pal.now <- pal
	
    }

    numchr <- numaut
    if (X)
    {
	numchr <- numchr+1
    }
    if (Y)
    {
	numchr <- numchr+1
    }

    chrominfo <- chrominfo[1:numchr,]

    ##compute cumulative kb locations
    start <- c(0, cumsum(chrominfo$length))
    kb.loc <- datainfo$kb
    for (i in 1:numchr)
    {
        tmp <- start[i]+datainfo$kb[datainfo$Chrom==i]
        kb.loc[datainfo$Chrom==i] <- tmp
    }
    ##preparation for graphs
    chrom.start <- rep(0,numchr)
    for (i in 2:length(chrom.start))
    {
        chrom.start[i] <- sum(chrominfo$length[1:(i-1)])

    }
    chrom.centr <- rep(0,numchr)
    for (i in 1:length(chrom.centr))
    {
        chrom.centr[i] <- chrom.start[i]+chrominfo$centr[i]

    }

    chrom.mid <- rep(0, numchr)
    for (i in 1:length(chrom.start))
    {
        chrom.mid[i] <- chrom.start[i]+chrominfo$length[i]/2
    }

    ##now, plot
    ##nc <- max(length(titles)/2,1)
    nc <- 1
    
    if (PS == "ps")
    {
        postscript(filePS,paper="letter")
    }
    else if (PS == "pdf")
    {
        pdf(filePS, width = 8.5, height =11)
    }
    if (onepage)
    {
        par(mfrow=c(nr,nc), lab=c(1,8,7), tcl=-.2,  xaxs="i")
    }
    else
    {
        par(mfrow=c(1,nc), lab=c(1,8,7), tcl=-.2,  xaxs="i")
    }
    for (g in 1:length(titles))
    {
        gl <- gainloss[[g]]
        tl <- titles[g]
        ylm[1] <- min(ylm, min(gl$lossP))
        ylm[2] <- max(ylm, max(gl$gainP))
        
        plot(kb.loc[gl$gainP>=cutplot],gl$gainP[gl$gainP>=cutplot], col="green", type="h", xlab="chromosome number", ylab="Fraction gained or lost", pch=18, main=tl, ylim=ylm, xlim=c(0, max(cumsum(chrominfo$length))))
        
        points(kb.loc[gl$lossP>=cutplot],-gl$lossP[gl$lossP>=cutplot], col="red", type="h")
        
        abline(h=0)
        abline(h=seq(-.8,.8,b=.2), lty=2,lwd=.5)
        abline(v=cumsum(chrominfo$length), col="blue")
        abline(v=chrom.centr, lty=2, col="grey50")
        for (i in seq(1,(numaut),b=2))
        {
            mtext(paste("", i), side = 1, at = (chrom.mid[i]), line=.3, col="red", cex.main=.5)
        }
        for (i in seq(2,(numaut),b=2))
        {
            mtext(paste("", i), side = 3, at = (chrom.mid[i]), line=.3, col="red", cex.main=.5)
        }
        
        if(X)
        {
            if (i == numaut)
            {
                mtext("X", side = 1, at = (chrom.mid[numaut+1]), line=.3, col="red", cex.main=.5)
            }
            else
            {
                mtext("X", side = 3, at = (chrom.mid[numaut+1]), line=.3, col="red", cex.main=.5)
            }
        }
        if (Y)
        {
            if (i == numaut)
            {
                mtext("Y", side = 3, at = (chrom.mid[numaut+2]), line=.3, col="red", cex.main=.5)
            }
            else
            {
                mtext("Y", side = 1, at = (chrom.mid[numaut+2]), line=.3, col="red", cex.main=.5)
            }
            
        }
        
        
    }
    if (sign)
    {
        plot(kb.loc,teststat, col="blue", ylim=c(0,max(teststat)), type="h", xlab="chromosome number", ylab="clone statistic", pch=18, main=paste(titles, collapse=" vs "))
        if (length(st.now) > 0)
        {
            abline(h=rev(st.now), col=rev(pal.now), lty=2)
        }
        abline(v=cumsum(chrominfo$length), col="black")
        abline(v=chrom.centr, lty=2, col="grey50")
        for (i in seq(1,(numaut),b=2))
        {
            mtext(paste("", i), side = 1, at = (chrom.mid[i]), line=.3, col="red", cex.main=.5)
        }
        for (i in seq(2,(numaut),b=2))
        {
            mtext(paste("", i), side = 3, at = (chrom.mid[i]), line=.3, col="red", cex.main=.5)
        }
        
        if(X)
        {
            if (i == numaut)
            {
                mtext("X", side = 1, at = (chrom.mid[numaut+1]), line=.3, col="red", cex.main=.5)
            }
            else
            {
                mtext("X", side = 3, at = (chrom.mid[numaut+1]), line=.3, col="red", cex.main=.5)
            }
        }
        if (Y)
        {
            if (i == numaut)
            {
                mtext("Y", side = 3, at = (chrom.mid[numaut+2]), line=.3, col="red", cex.main=.5)
            }
            else
            {
                mtext("Y", side = 1, at = (chrom.mid[numaut+2]), line=.3, col="red", cex.main=.5)
            }
            
        }
        
        
    }

    dev.off()

}


#############################################################################
#############################################################################
##frequency plot for individual chromosomes

##data
##rsp -- phenotype, NA are not allowed, have to be consequetive integers
##chrom -- vector of chromosomes to show. currently bugged; so has to be 1:smthg
##datainfo
##chrominfo
##titles -- the titles of the frequency plots -- has to have as many names as 
##levels in the response
##thres -- unique threshold or vector of tumor specific thresholds. In the latter
##case has to contain as many thershold as samples
##sign -- to do significance comparison (T) or not (F). to do comparison uses
##multtest package
##nperm -- if sign =TRUE, then how many permutations for maxT
##test -- name of the test
##ranks -- whether to work with ranked data If nor, "n"
##side -- two sisded (abs) test or 1-sided ("upper" or "lower")
##p.thres -- for which adjusted p-values show the cut-off
##filePS -- name of the ps/pdf file
##PS = "ps" or "pdf"

plotfreq.stat.chrom.final.func <-
    function(data, rsp, chrom, datainfo, chrominfo, titles, thres=.2,
             ylm=c(-1,1), sign=TRUE, nperm=1000, test="f", ranks="y",
             side="abs", p.thres=c(.01,.05,.1,.2), dataSign=data,
             filePS="gainslosses.ps", PS="ps", onepage=TRUE)
{
##########compute gainloss functions:
    rsp.uniq <- unique(rsp)
    colmatr <- matrix(0, nrow=length(rsp.uniq), ncol=length(rsp))
    for (i in 1:nrow(colmatr))
    {
	colmatr[i,rsp==rsp.uniq[i]] <- 1
    }



    pal <- c("red", "blue", "green", "yellow")

    if (nrow(colmatr) == 1)
    {
	sign <- F
    }

    nr <- nrow(colmatr)
    if (sign)
    {	
	nr <- nr+1
    }

    tmp <- matrix(0, ncol=2,nrow=1)   
    tmp <- as.data.frame(tmp) 
    dimnames(tmp)[[2]] <- c("gainP", "lossP")   
    gainloss <- rep(list(tmp),nrow(colmatr))            

    for (j in 1:nrow(colmatr))
    {
	
	cols <- (1:ncol(colmatr))[colmatr[j,]==1]
	gainloss[[j]] <- gainloss.func(dat=data, cols=cols,thres=thres)
	
    }

    if (sign)
    {
	dt <- dataSign[,colmatr[1,]==1]
	rsp <- rep(1, ncol(dt))
	for (j in 2:nrow(colmatr))
	{
            dt <- cbind(dt, dataSign[,colmatr[j,]==1])
            rsp <- c(rsp, rep(j, ncol(dataSign[,colmatr[j,]==1])))
	}
	rsp <- rsp-1
	res <-  mt.maxT(X=dt,classlabel=rsp,test=test,side=side,fixed.seed.sampling="y",B=nperm, na=.mt.naNUM, nonpara=ranks)
	maxT <- res$adjp[order(res$index)]
	
        ##rawp <- res$rawp[order(res$index)]
	teststat <- abs(res$teststat[order(res$index)])
	
	st <- rep(NA, length(p.thres))
	for (s in 1:length(p.thres))
	{
            if (length(maxT[maxT<=p.thres[s]]) > 0)
            {
                st[s] <- min(teststat[maxT<=p.thres[s]])
            }
	}
        
        ##st.now <- st[!is.na(st)]
        ##pal.now <- pal[!is.na(st)]

	st.now <- st
	pal.now <- pal
	
	

    }
    
    if (PS == "ps")
    {
        postscript(filePS,paper="letter")
    }
    else if (PS == "pdf")
    {
        pdf(filePS, width = 8.5, height = 11)
    }
    else
    {
        print("no legimate file format is specified")
        exit()
    }
    nc <- 1
    ##	for (ch in 1:length(chrom))
    for (ch in chrom)
    {
        ##chrom.ind <- (1:nrow(datainfo))[datainfo$Chrom== chrom[ch]]
        chrom.ind <- (1:nrow(datainfo))[datainfo$Chrom== ch]
        
        kb <- datainfo$kb[chrom.ind]
        chrom.centr <- chrominfo$centr[ch]
        if (onepage)
        {
            par(mfrow=c(nr,nc), xaxs="i")
        }
        else
        {
            par(mfrow=c(1,nc), xaxs="i")
        }
        
        for (g in 1:length(titles))
        {
            gl <- gainloss[[g]]
            tl <- titles[g]
            plot(kb,(gl$gainP[chrom.ind]), col="green", ylim=ylm, type="h", xlab="chromosome number", ylab="Fraction gained or lost", pch=18, main=paste(tl, " chrom ", ch))
            
            points(kb,(-gl$lossP[chrom.ind]), col="red", type="h")
            
            abline(h=0)
            abline(h=seq(-.8,.8,b=.2), lty=2,lwd=.5)
            abline(v=chrom.centr, lty=2, col="grey50")
            
            
        }
	if (sign)
	{
            plot(kb,teststat[chrom.ind], col="blue", ylim=c(0,max(teststat[chrom.ind])), type="h", xlab="kb", ylab="clone statistic", pch=18, main=paste(paste(titles, collapse=" vs "), " -- chrom ", ch))
            if (length(st.now) > 0)
            {
                
                abline(h=rev(st.now), col=rev(pal.now), lty=2)
            }
            
            abline(v=chrom.centr, lty=2, col="grey50")
            
            
	}
        
    }
    dev.off()

}


#############################################################################
#############################################################################
##################################################################################
##################################################################################

##frequency plot for the whole genome

##data
##rsp -- phenotype, NA are not allowed, have to be consequetive integers
##datainfo
##chrominfo
##titles -- the titles of the frequency plots -- has to have as many names as 
##levels in the response
##thres -- unique threshold or vector of tumor specific thresholds. In the latter
##case has to contain as many thershold as samples
##cutplot -- don't plots clones which gained/lost in fewer than <= fraction of cases
##sign -- to do significance comparison (T) or not (F). to do comparison uses
##multtest package
##nperm -- if sign =TRUE, then how many permutations for maxT
##test -- name of the test
##ranks -- whether to work with ranked data If nor, "n"
##side -- two sisded (abs) test or 1-sided ("upper" or "lower")
##p.thres -- for which adjusted p-values show the cut-off
##filePS -- name of the ps/pdf file
##PS = "ps" or "pdf"
##X=TRUE -- is X (23) chrom included?
##Y=FALSE  -- is Y (24) chrom included?
##numaut=22 -- number of autosomes
##ngrid=50: density of colors
##nlim=1: upper limit for solors
##mincolors: minimum limit for colors
##by defult "white"corersponds to [-.2,.2] and red and green to [-1,-.2] and [.2,1[]
##respectively
## quant.col=.5: percentile for coloring gaind/lost clones -- <= .5, E.g. .25
##would correspond to taking 25th % for lost and 75% for gained samples


##plotfreq.stat.final.colors.func <- function(data, rsp,datainfo, chrominfo, titles, thres=.2,cutplot = 0, ylm=c(-1,1), sign=FALSE, dataSign=data, nperm=1000, test="f", ranks="y", side="abs", p.thres=c(.01,.05,.1,.2), filePS="gainslosses.ps", ngrid=50, nlim=1, mincolors=.2, quant.col=.5, X=TRUE, Y=FALSE, numaut=22, PS="ps", onepage=TRUE)
##{

##rsp.uniq <- unique(rsp)
##colmatr <- matrix(0, nrow=length(rsp.uniq), ncol=length(rsp))
##for (i in 1:nrow(colmatr))
##{
##	colmatr[i,rsp==rsp.uniq[i]] <- 1
##}



##pal <- c("red", "blue", "green", "yellow")
##pal <- pal[1:length(p.thres)]

##colors.gain <- maPalette(low = "white", high = "green", k=ngrid)
##colors.loss <- maPalette(low = "red", high = "white", k=ngrid)

##sq.loss <- seq(-nlim, -mincolors, length=(ngrid+1))
##sq.gain <- seq(mincolors, nlim, length=(ngrid+1))

######################################################

##matr.colors.loss <- data.frame(sq.loss[-length(sq.loss)], sq.loss[-1], colors.loss)
##matr.colors.gain <- data.frame(sq.gain[-length(sq.gain)], sq.gain[-1], colors.gain)

##if (nrow(colmatr) == 1)
##{
##	sign <- F
##}

##nr <- nrow(colmatr)
##if (sign)
##{	
##	nr <- nr+1

##}

##tmp <- matrix(0, ncol=2,nrow=1)   
##tmp <- as.data.frame(tmp) 
##dimnames(tmp)[[2]] <- c("gainP", "lossP")   
##gainloss <- rep(list(tmp),nrow(colmatr))            

##for (j in 1:nrow(colmatr))
##{

##	cols <- (1:ncol(colmatr))[colmatr[j,]==1]
##	gainloss[[j]] <- gainloss.func(dat=data, cols=cols,thres=thres, quant=quant.col)

##}



##if (sign)
##{
##	dt <- dataSign[,colmatr[1,]==1]
##	rsp <- rep(1, ncol(dt))
##	for (j in 2:nrow(colmatr))
##	{
##		dt <- cbind(dt, dataSign[,colmatr[j,]==1])
##		rsp <- c(rsp, rep(j, ncol(dataSign[,colmatr[j,]==1])))
##	}
##	rsp <- rsp-1
##	res <-  mt.maxT(X=dt,classlabel=rsp,test=test,side=side,fixed.seed.sampling="y",B=nperm, na=.mt.naNUM, nonpara=ranks)
##	maxT <- res$adjp[order(res$index)]
##	#rawp <- res$rawp[order(res$index)]
##	teststat <- abs(res$teststat[order(res$index)])
##	st <- rep(NA, length(p.thres))
##	for (s in 1:length(p.thres))
##	{
##		if (length(maxT[maxT<=p.thres[s]]) > 0)
##		{
##			st[s] <- min(teststat[maxT<=p.thres[s]])
##		}
##	}

##	#st.now <- st[!is.na(st)]
##	#pal.now <- pal[!is.na(st)]

##	st.now <- st
##	pal.now <- pal

##}



##numchr <- numaut
##if (X)
##{
##	numchr <- numchr+1
##}
##if (Y)
##{
##	numchr <- numchr+1
##}

##chrominfo <- chrominfo[1:numchr,]


###compute cumulative kb locations
##        start <- c(0, cumsum(chrominfo$length))
##        kb.loc <- datainfo$kb
##        for (i in 1:nrow(chrominfo))
##        {
##                tmp <- start[i]+datainfo$kb[datainfo$Chrom==i]
##                kb.loc[datainfo$Chrom==i] <- tmp
##        }
###preparation for graphs
##        chrom.start <- rep(0,nrow(chrominfo))
##        for (i in 2:length(chrom.start))
##        {
##                chrom.start[i] <- sum(chrominfo$length[1:(i-1)])

##        }
##        chrom.centr <- rep(0,nrow(chrominfo))
##        for (i in 1:length(chrom.centr))
##        {
##                chrom.centr[i] <- chrom.start[i]+chrominfo$centr[i]

##        }

##        chrom.mid <- rep(0, nrow(chrominfo))
##        for (i in 1:length(chrom.start))
##        {
##              chrom.mid[i] <- chrom.start[i]+chrominfo$length[i]/2
##        }

###now, plot
##        #nc <- max(length(titles)/2,1)
##	nc <- 1

##	if (PS == "ps")
##	{
##		postscript(filePS,paper="letter")
##	}
##	else if (PS == "pdf")
##	{
##		pdf(filePS, width = 8.5, height =11)
##      	}
##	if (onepage)
##	{
##		par(mfrow=c(nr,nc), lab=c(1,8,7), tcl=-.2,  xaxs="i")
##	}
##	else
##	{
##		par(mfrow=c(1,nc), lab=c(1,8,7), tcl=-.2,  xaxs="i")
##	}
##        for (g in 1:length(titles))
##        {
##                gl <- gainloss[[g]]
##		tl <- titles[g]
##		ylm[1] <- min(ylm, min(gl$lossP))
##		ylm[2] <- max(ylm, max(gl$gainP))

##		cl <- gl$gainMed	

##		col.nrow <- rep(0, length(cl))
##		for (i in 1:length(cl))
##		{
##			if (cl[i]>=nlim)
##			{
##				cl[i] <- nlim-10^(-6)
##			}
##			if (length((1:nrow(matr.colors.gain))[cl[i]>=matr.colors.gain[,1] & cl[i]<matr.colors.gain[,2]]) > 0)
##			{
##				col.nrow[i] <- (1:nrow(matr.colors.gain))[cl[i]>=matr.colors.gain[,1] & cl[i]<matr.colors.gain[,2]]
##			}
##			else
##			{
##				col.nrow[i] <- 1
##			}
##		}		


##		plot(kb.loc[gl$gainP>=cutplot],gl$gainP[gl$gainP>=cutplot], col=as.character(matr.colors.gain[gl$gainP>=cutplot,3][col.nrow[gl$gainP>=cutplot]]), type="h", xlab="chromosome number", ylab="Fraction gained or lost", pch=18, main=tl, ylim=ylm, xlim=c(0, max(cumsum(chrominfo$length))))

##		cl <- gl$lossMed

##		col.nrow <- rep(0, length(cl))
##		for (i in 1:length(cl))
##		{
##			if (cl[i]<=-nlim)
##			{
##				cl[i] <- -nlim+10^(-6)
##			}
##			if (length((1:nrow(matr.colors.loss))[cl[i]>=matr.colors.loss[,1] & cl[i]<matr.colors.loss[,2]]) > 0)
##			{
##				col.nrow[i] <- (1:nrow(matr.colors.loss))[cl[i]>=matr.colors.loss[,1] & cl[i]<matr.colors.loss[,2]]
##			}
##			else
##			{
##				col.nrow[i] <- ngrid
##			}
##		}		


##                points(kb.loc[gl$lossP>=cutplot],-gl$lossP[gl$lossP>=cutplot], col=as.character(matr.colors.loss[gl$lossP>=cutplot,3][col.nrow[gl$lossP>=cutplot]]), type="h")

##                abline(h=0)
##                abline(h=seq(-.8,.8,b=.2), lty=2,lwd=.5)
##                abline(v=cumsum(chrominfo$length), col="blue")
##                abline(v=chrom.centr, lty=2, col="grey50")

##		for (i in seq(2,(numaut),b=2))
##                {
##                     mtext(paste("", i), side = 3, at = (chrom.mid[i]), line=.3, col="red", cex.main=.5)
##		}
##		for (i in seq(1,(numaut),b=2))
##                {
##                     mtext(paste("", i), side = 1, at = (chrom.mid[i]), line=.3, col="red", cex.main=.5)
##		}

##		if(X)
##		{
##			if (i == numaut)
##			{
##				mtext("X", side = 1, at = (chrom.mid[numaut+1]), line=.3, col="red", cex.main=.5)
##			}
##			else
##			{
##				mtext("X", side = 3, at = (chrom.mid[numaut+1]), line=.3, col="red", cex.main=.5)
##			}
##		}
##		if (Y)
##		{
##			if (i == numaut)
##			{
##				mtext("Y", side = 3, at = (chrom.mid[numaut+2]), line=.3, col="red", cex.main=.5)
##			}
##			else
##			{
##				mtext("Y", side = 1, at = (chrom.mid[numaut+2]), line=.3, col="red", cex.main=.5)
##			}

##		}

##        }
##	if (sign)
##	{
##		plot(kb.loc,teststat, col="blue", ylim=c(0,max(teststat)), type="h", xlab="chromosome number", ylab="clone statistic", pch=18, main=paste(titles, collapse=" vs "), xlim=c(0, max(cumsum(chrominfo$length))))
##		if (length(st.now) > 0)
##		{
##			abline(h=rev(st.now), col=rev(pal.now), lty=2)
##		}
##		abline(v=cumsum(chrominfo$length), col="black")
##                abline(v=chrom.centr, lty=2, col="grey50")

##		for (i in seq(1,(numaut),b=2))
##                {
##                     mtext(paste("", i), side = 1, at = (chrom.mid[i]), line=.3, col="red", cex.main=.5)
##		}
##		for (i in seq(2,(numaut),b=2))
##                {
##                     mtext(paste("", i), side = 3, at = (chrom.mid[i]), line=.3, col="red", cex.main=.5)
##		}

##		if(X)
##		{
##			if (i == numaut)
##			{
##				mtext("X", side = 1, at = (chrom.mid[numaut+1]), line=.3, col="red", cex.main=.5)
##			}
##			else
##			{
##				mtext("X", side = 3, at = (chrom.mid[numaut+1]), line=.3, col="red", cex.main=.5)
##			}
##		}
##		if (Y)
##		{
##			if (i == numaut)
##			{
##				mtext("Y", side = 3, at = (chrom.mid[numaut+2]), line=.3, col="red", cex.main=.5)
##			}
##			else
##			{
##				mtext("Y", side = 1, at = (chrom.mid[numaut+2]), line=.3, col="red", cex.main=.5)
##			}

##		}


##	}

##	dev.off()

##}


#############################################################################
#############################################################################
#############################################################################
#############################################################################
##################################################################################
##################################################################################

##frequency plot for the whole genome using outside p-values and stats

##data
##rsp -- phenotype, NA are not allowed, have to be consequetive integers
##datainfo
##chrominfo
##titles -- the titles of the frequency plots -- has to have as many names as 
##levels in the response
##thres -- unique threshold or vector of tumor specific thresholds. In the latter
##case has to contain as many thershold as samples
##cutplot -- don't plots clones which gained/lost in fewer than <= fraction of cases
##sign -- to do significance comparison (T) or not (F). to do comparison uses
##multtest package
##nperm -- if sign =TRUE, then how many permutations for maxT
##test -- name of the test
##ranks -- whether to work with ranked data If nor, "n"
##side -- two sisded (abs) test or 1-sided ("upper" or "lower")
##p.thres -- for which adjusted p-values show the cut-off
##filePS -- name of the ps/pdf file
##PS = "ps" or "pdf"
##X=TRUE -- is X (23) chrom included?
##Y=FALSE  -- is Y (24) chrom included?
##numaut=22 -- number of autosomes
##ngrid=50: density of colors
##nlim=1: upper limit for solors
##mincolors: minimum limit for colors
##by defult "white"corersponds to [-.2,.2] and red and green to [-1,-.2] and [.2,1[]
##respectively
## quant.col=.5: percentile for coloring gaind/lost clones -- <= .5, E.g. .25
##would correspond to taking 25th % for lost and 75% for gained samples

plotfreq.givenstat.final.colors.func <-
    function(data, rsp,datainfo, chrominfo, titles, thres=.2,cutplot =
             0, ylm=c(-1,1), sign=FALSE, stat=stats, statPerm=statsPerm,
             p.thres=c(.01,.05,.1,.2), filePS="gainslosses.ps",
             ngrid=50, nlim=1, mincolors=.2, quant.col=.5, X=TRUE, Y=FALSE,
             numaut=22, PS="ps", onepage=TRUE)
{

    rsp.uniq <- unique(rsp)
    colmatr <- matrix(0, nrow=length(rsp.uniq), ncol=length(rsp))
    for (i in 1:nrow(colmatr))
    {
	colmatr[i,rsp==rsp.uniq[i]] <- 1
    }



    pal <- c("red", "blue", "green", "yellow")
    pal <- pal[1:length(p.thres)]

    colors.gain <- maPalette(low = "white", high = "green", k=ngrid)
    colors.loss <- maPalette(low = "red", high = "white", k=ngrid)

    sq.loss <- seq(-nlim, -mincolors, length=(ngrid+1))
    sq.gain <- seq(mincolors, nlim, length=(ngrid+1))
    
####################################################

    matr.colors.loss <- data.frame(sq.loss[-length(sq.loss)], sq.loss[-1], colors.loss)
    matr.colors.gain <- data.frame(sq.gain[-length(sq.gain)], sq.gain[-1], colors.gain)

    if (nrow(colmatr) == 1)
    {
	sign <- F
    }

    nr <- nrow(colmatr)
    if (sign)
    {	
	nr <- nr+1
	
    }

    tmp <- matrix(0, ncol=2,nrow=1)   
    tmp <- as.data.frame(tmp) 
    dimnames(tmp)[[2]] <- c("gainP", "lossP")   
    gainloss <- rep(list(tmp),nrow(colmatr))            

    for (j in 1:nrow(colmatr))
    {
	
	cols <- (1:ncol(colmatr))[colmatr[j,]==1]
	gainloss[[j]] <- gainloss.func(dat=data, cols=cols,thres=thres, quant=quant.col)
	
    }



    if (sign)
    {
	
	teststat <- stat
	maxstat <- apply(statPerm,2,max, na.rm=TRUE)
	maxT <- rep(NA, length(maxstat))
	for (i in 1:length(teststat)) 
	{
            maxT[i] <- length(maxstat[maxstat>=teststat[i]])
	}
	maxT <- maxT/length(maxstat)
	
	st <- quantile(maxstat, (1-p.thres))
	st.now <- st
	pal.now <- pal
	
    }



    numchr <- numaut
    if (X)
    {
	numchr <- numchr+1
    }
    if (Y)
    {
	numchr <- numchr+1
    }

    chrominfo <- chrominfo[1:numchr,]


    ##compute cumulative kb locations
    start <- c(0, cumsum(chrominfo$length))
    kb.loc <- datainfo$kb
    for (i in 1:nrow(chrominfo))
    {
        tmp <- start[i]+datainfo$kb[datainfo$Chrom==i]
        kb.loc[datainfo$Chrom==i] <- tmp
    }
    ##preparation for graphs
    chrom.start <- rep(0,nrow(chrominfo))
    for (i in 2:length(chrom.start))
    {
        chrom.start[i] <- sum(chrominfo$length[1:(i-1)])

    }
    chrom.centr <- rep(0,nrow(chrominfo))
    for (i in 1:length(chrom.centr))
    {
        chrom.centr[i] <- chrom.start[i]+chrominfo$centr[i]

    }

    chrom.mid <- rep(0, nrow(chrominfo))
    for (i in 1:length(chrom.start))
    {
        chrom.mid[i] <- chrom.start[i]+chrominfo$length[i]/2
    }

    ##now, plot
    ##nc <- max(length(titles)/2,1)
    nc <- 1
    
    if (PS == "ps")
    {
        postscript(filePS,paper="letter")
    }
    else if (PS == "pdf")
    {
        pdf(filePS, width = 8.5, height =11)
    }
    
    if (onepage)
    {
        par(mfrow=c(nr,nc), lab=c(1,8,7), tcl=-.2,  xaxs="i")
    }
    else
    {
        par(mfrow=c(1,nc), lab=c(1,8,7), tcl=-.2,  xaxs="i")
    }
    for (g in 1:length(titles))
    {
        gl <- gainloss[[g]]
        tl <- titles[g]
        ylm[1] <- min(ylm, min(gl$lossP))
        ylm[2] <- max(ylm, max(gl$gainP))
        
        cl <- gl$gainMed	
        
        col.nrow <- rep(0, length(cl))
        for (i in 1:length(cl))
        {
            if (cl[i]>=nlim)
            {
                cl[i] <- nlim-10^(-6)
            }
            if (length((1:nrow(matr.colors.gain))[cl[i]>=matr.colors.gain[,1] & cl[i]<matr.colors.gain[,2]]) > 0)
            {
                col.nrow[i] <- (1:nrow(matr.colors.gain))[cl[i]>=matr.colors.gain[,1] & cl[i]<matr.colors.gain[,2]]
            }
            else
            {
                col.nrow[i] <- 1
            }
        }		

        
        plot(kb.loc[gl$gainP>=cutplot],gl$gainP[gl$gainP>=cutplot],
             col=as.character(matr.colors.gain[gl$gainP>=cutplot,3][col.nrow[gl$gainP>=cutplot]]),
             type="h", xlab="chromosome number",
             ylab="Fraction gained or lost", pch=18, main=tl,
             ylim=ylm, xlim=c(0, max(cumsum(chrominfo$length))))
        
        
        cl <- gl$lossMed
        
        col.nrow <- rep(0, length(cl))
        for (i in 1:length(cl))
        {
            if (cl[i]<=-nlim)
            {
                cl[i] <- -nlim+10^(-6)
            }
            if (length((1:nrow(matr.colors.loss))[cl[i]>=matr.colors.loss[,1] & cl[i]<matr.colors.loss[,2]]) > 0)
            {
                col.nrow[i] <-
                    which(cl[i]>=matr.colors.loss[,1] &
                          cl[i]<matr.colors.loss[,2])
            }
            else
            {
                col.nrow[i] <- ngrid
            }
        }		

        
        points(kb.loc[gl$lossP>=cutplot],-gl$lossP[gl$lossP>=cutplot],
               col=as.character(matr.colors.loss[gl$lossP>=cutplot,3][col.nrow[gl$lossP>=cutplot]]),
               type="h")
        
        abline(h=0)
        abline(h=seq(-.8,.8,b=.2), lty=2,lwd=.5)
        abline(v=cumsum(chrominfo$length), col="blue")
        abline(v=chrom.centr, lty=2, col="grey50")

        for (i in seq(2,(numaut),b=2))
        {
            mtext(paste("", i), side = 3, at = (chrom.mid[i]), line=.3, col="red", cex.main=.5)
        }
        for (i in seq(1,(numaut),b=2))
        {
            mtext(paste("", i), side = 1, at = (chrom.mid[i]), line=.3, col="red", cex.main=.5)
        }
        
        if(X)
        {
            if (i == numaut)
            {
                mtext("X", side = 1, at = (chrom.mid[numaut+1]), line=.3, col="red", cex.main=.5)
            }
            else
            {
                mtext("X", side = 3, at = (chrom.mid[numaut+1]), line=.3, col="red", cex.main=.5)
            }
        }
        if (Y)
        {
            if (i == numaut)
            {
                mtext("Y", side = 3, at = (chrom.mid[numaut+2]), line=.3, col="red", cex.main=.5)
            }
            else
            {
                mtext("Y", side = 1, at = (chrom.mid[numaut+2]), line=.3, col="red", cex.main=.5)
            }
            
        }
        
    }
    if (sign)
    {
        plot(kb.loc,teststat, col="blue", ylim=c(0,max(teststat)), type="h", xlab="chromosome number", ylab="clone statistic", pch=18, main=paste(titles, collapse=" vs "), xlim=c(0, max(cumsum(chrominfo$length))))
        if (length(st.now) > 0)
        {
            abline(h=rev(st.now), col=rev(pal.now), lty=2)
        }
        abline(v=cumsum(chrominfo$length), col="black")
        abline(v=chrom.centr, lty=2, col="grey50")

        for (i in seq(1,(numaut),b=2))
        {
            mtext(paste("", i), side = 1, at = (chrom.mid[i]), line=.3, col="red", cex.main=.5)
        }
        for (i in seq(2,(numaut),b=2))
        {
            mtext(paste("", i), side = 3, at = (chrom.mid[i]), line=.3, col="red", cex.main=.5)
        }
        
        if(X)
        {
            if (i == numaut)
            {
                mtext("X", side = 1, at = (chrom.mid[numaut+1]), line=.3, col="red", cex.main=.5)
            }
            else
            {
                mtext("X", side = 3, at = (chrom.mid[numaut+1]), line=.3, col="red", cex.main=.5)
            }
        }
        if (Y)
        {
            if (i == numaut)
            {
                mtext("Y", side = 3, at = (chrom.mid[numaut+2]), line=.3, col="red", cex.main=.5)
            }
            else
            {
                mtext("Y", side = 1, at = (chrom.mid[numaut+2]), line=.3, col="red", cex.main=.5)
            }
            
        }

        
    }

    dev.off()

}
heatmap <-
    function (x=aCGH.obj, imp = TRUE, Rowv = NA, Colv = NULL, distfun = dist, 
              hclustfun = hclust, add.expr, symm = FALSE,
              revC = identical(Colv, "Rowv"), scale = "none",
              na.rm = TRUE, margins = c(5, 5), ColSideColors,
              RowSideColors, cexRow = 0.2 + 1 / log10(nr), 
              cexCol = 0.2 + 1 / log10(nc), labRow = NULL,
              labCol = NULL, main = NULL, xlab = NULL, ylab = NULL,
              verbose = getOption("verbose"), methodR = "ward",
              methodC = "ward", zlm = c(-0.5, 0.5), ...) 
{
    
    scale <- if (symm && missing(scale)) 
        "none"
    else match.arg(scale)
    if (length(di <- dim(x)) != 2 || !is.numeric(x)) 
        stop("`x' must be a numeric matrix")
    nr <- di[1]
    nc <- di[2]
    if (nr <= 1 || nc <= 1) 
        stop("`x' must have at least 2 rows and 2 columns")
    if (!is.numeric(margins) || length(margins) != 2) 
        stop("`margins' must be a numeric vector of length 2")
    doRdend <- !identical(Rowv, NA)
    doCdend <- !identical(Colv, NA)
    if (is.null(Rowv)) 
        Rowv <- rowMeans(x, na.rm = na.rm)
    if (is.null(Colv)) 
        Colv <- colMeans(x, na.rm = na.rm)
    if (doRdend)
    {
        
        if (inherits(Rowv, "dendrogram")) 
            ddr <- Rowv
        else {
            hcr <- hclustfun(distfun(x), method = methodR)
            ddr <- as.dendrogram(hcr)
            if (!is.logical(Rowv) || Rowv) 
                ddr <- reorder(ddr, Rowv)
        }
        if (nr != length(rowInd <- order.dendrogram(ddr))) 
            stop("row dendrogram ordering gave index of wrong length")
        
    }
    else rowInd <- 1:nr
    if (doCdend)
    {
        
        if (inherits(Colv, "dendrogram")) 
            ddc <- Colv
        else if (identical(Colv, "Rowv"))
        {
            if (nr != nc) 
                stop("Colv = \"Rowv\" but nrow(x) != ncol(x)")
            ddc <- ddr
        }
        else
        {
            hcc <- hclustfun(distfun(if (symm) 
                x
            else t(x)), method = methodC)
            ddc <- as.dendrogram(hcc)
            if (!is.logical(Colv) || Colv) 
                ddc <- reorder(ddc, Colv)
        }
        if (nc != length(colInd <- order.dendrogram(ddc))) 
            stop("column dendrogram ordering gave index of wrong length")
    }
    else colInd <- 1:nc
    x <- x[rowInd, colInd]
    if (is.null(labRow)) 
        labRow <- if (is.null(rownames(x))) 
            (1:nr)[rowInd]
        else rownames(x)
    if (is.null(labCol)) 
        labCol <- if (is.null(colnames(x))) 
            (1:nc)[colInd]
        else colnames(x)
    if (scale == "row") {
        x <- sweep(x, 1, rowMeans(x, na.rm = na.rm))
        sx <- apply(x, 1, sd, na.rm = na.rm)
        x <- sweep(x, 1, sx, "/")
    }
    else if (scale == "column") {
        x <- sweep(x, 2, colMeans(x, na.rm = na.rm))
        sx <- apply(x, 2, sd, na.rm = na.rm)
        x <- sweep(x, 2, sx, "/")
    }
    lmat <- rbind(c(NA, 3), 2:1)
    lwid <- c(if (doRdend) 1 else 0.05, 4)
    lhei <- c((if (doCdend) 1 else 0.05) + if (!is.null(main)) 0.2 else 0, 
        4)
    if (!missing(ColSideColors)) {
        if (!is.character(ColSideColors) || length(ColSideColors) != 
            nc) 
            stop("'ColSideColors' must be a character vector of length\
ncol(x)")
        lmat <- rbind(lmat[1, ] + 1, c(NA, 1), lmat[2, ] + 1)
        lhei <- c(lhei[1], 0.2, lhei[2])
    }
    if (!missing(RowSideColors)) {
        if (!is.character(RowSideColors) || length(RowSideColors) != 
            nr) 
            stop("'RowSideColors' must be a character vector of length\
nrow(x)")
        lmat <- cbind(lmat[, 1] + 1, c(rep(NA, nrow(lmat) - 1), 
            1), lmat[, 2] + 1)
        lwid <- c(lwid[1], 0.2, lwid[2])
    }
    lmat[is.na(lmat)] <- 0
    if (verbose) {
        cat("layout: widths = ", lwid, ", heights = ", lhei, 
            "; lmat=\n")
        print(lmat)
    }
    op <- par(no.readonly = TRUE)
    on.exit(par(op))
    layout(lmat, widths = lwid, heights = lhei, respect = TRUE)
    if (!missing(RowSideColors)) {
        par(mar = c(margins[1], 0, 0, 0.5))
        image(rbind(1:nr), col = RowSideColors[rowInd], axes = FALSE)
    }
    if (!missing(ColSideColors)) {
        par(mar = c(0.5, 0, 0, margins[2]))
        image(cbind(1:nc), col = ColSideColors[colInd], axes = FALSE)
    }
    par(mar = c(margins[1], 0, 0, margins[2]))
    if (!symm || scale != "none") 
        x <- t(x)
    if (revC) {
        iy <- nr:1
        ddr <- rev(ddr)
        x <- x[, iy]
    }
    else iy <- 1:nr
    x.floor <- x
    for (i in 1:ncol(x)) {
        ind1 <- (1:length(x[, i]))[x[, i] >= zlm[2] & !is.na(x[, 
            i])]
        ind2 <- (1:length(x[, i]))[x[, i] <= zlm[1] & !is.na(x[, 
            i])]
        x.floor[, i][ind1] <- rep((zlm[2] - 0.01), length(ind1))
        x.floor[, i][ind2] <- rep((zlm[1] + 0.01), length(ind2))
    }
    image(1:nc, 1:nr, x.floor, xlim = 0.5 + c(0, nc), ylim = 0.5 + 
        c(0, nr), axes = FALSE, xlab = "", ylab = "",
          col = maPalette(high = "green", low = "red", mid = "black"),
          zlim = zlm, ...)
    axis(1, 1:nc, labels = labCol[colInd], las = 2, line = -0.5, 
        tick = 0, cex.axis = cexCol)
    if (!is.null(xlab)) 
        mtext(xlab, side = 1, line = margins[1] - 1.25)
    axis(4, iy, labels = labRow[rowInd], las = 2, line = -0.5, 
        tick = 0, cex.axis = cexRow)
    if (!is.null(ylab)) 
        mtext(ylab, side = 4, line = margins[2] - 1.25)
    if (!missing(add.expr)) 
        eval(substitute(add.expr))
    par(mar = c(margins[1], 0, 0, 0))
    if (doRdend) 
        plot(ddr, horiz = TRUE, axes = FALSE, yaxs = "i", leaflab = "none")
    else frame()
    par(mar = c(0, 0, if (!is.null(main)) 1 else 0, margins[2]))
    if (doCdend) 
        plot(ddc, axes = FALSE, xaxs = "i", leaflab = "none")
    else if (!is.null(main)) 
        frame()
    if (!is.null(main)) 
        title(main, cex.main = 1.5 * op[["cex.main"]])
    invisible(list(rowInd = rowInd, colInd = colInd))
    
}
##performing HMM:

require(cluster)
require(repeated)
require(sma)

#####################################################################
#####################################################################

hmm.run.func <-
    function(dat, datainfo = clones.info, vr = .01, maxiter = 100,
             aic = TRUE, bic = TRUE, delta = 1)
{
    
    chrom.uniq <- unique(datainfo$Chrom)
    states <- matrix(NA, nrow=nrow(dat), ncol=(2+6*ncol(dat)))
    states[,1:2] <- cbind(datainfo$Chrom, datainfo$kb)
    nstates <-
        matrix(NA, nrow = length(chrom.uniq), ncol = ncol(dat))

    states.list <- list(states)
    nstates.list <- list(nstates)

    ##list consists of experiments starting with aic then, if bic, scroll
    ##over deltas

    nlists <- 0
    if (aic)
        nlists <- 1
    if (bic)
        for (j in 1:length(delta))
            nlists <- nlists+1
    if (nlists > 1)
        for (j in 2:nlists)
        {
            states.list[[j]] <- states.list[[1]]
            nstates.list[[j]] <- nstates.list[[1]]
        }
    for (i in 1:ncol(dat))
    {
        
###        print(paste("sample is ", i))
        colstart <- 2+(i-1)*6+1
        colend <- 2+i*6
        for (j in 1:length(chrom.uniq))
        {
###            print(paste("chrom is ", j))
            
            res <-
                try(
                    states.hmm.func(sample = i, chrom = j,
                                    dat = dat,
                                    datainfo = datainfo,
                                    vr = vr,
                                    maxiter = maxiter,
                                    aic = aic, bic = bic,
                                    delta = delta,
                                    nlists = nlists
                                    )
                    )
            
            for (m in 1:nlists)
            {

                states.list[[m]][((1:nrow(states))[states[,1]==j]),colstart:colend] <-
                    as.matrix(res$out.list[[m]])
                nstates.list[[m]][j,i] <- res$nstates.list[[m]]
                
            }
            
            
        }
        
    }
    list(states.hmm = states.list, nstates.hmm = nstates.list)
    
}
#####################################################################
#####################################################################

##auxilliary function

mu1.func <-
    function(p) 
{
    matrix(p, nrow=1)
}

#####################################################################
#####################################################################

states.hmm.func <-
    function(sample, chrom, dat, datainfo = clones.info, vr = .01,
             maxiter = 100, aic = FALSE, bic = TRUE, delta = 1,
             nlists = 1)
{

    obs <- dat[datainfo$Chrom==chrom, sample]
    kb <- datainfo$kb[datainfo$Chrom==chrom]
    ##with current sproc files, data is already ordered by kb's
    obs.ord <- obs[order(kb)]
    kb.ord <- kb[order(kb)]

    ind.nonna <- (1:length(obs.ord))[!is.na(obs.ord)]

    y <- obs.ord[ind.nonna]
    kb <- kb.ord[ind.nonna]


#####################################

    numobs <- length(y)

######################################

    ##have been taken outside
    ##mu1.func <- function(p) {matrix(p, nrow=1)}

######################################
    ##initial clustering:

    pam2 <- pam(y,2)
    pam3 <- pam(y,3)
    pam4 <- pam(y,4)
    pam5 <- pam(y,5)

#####################
    ##means:

    mu2 <- c(pam2$medoids)
    mu3 <- c(pam3$medoids)
    mu4 <- c(pam4$medoids)
    mu5 <- c(pam5$medoids)

####################################
    ##trans. matrices:

    gamma2 <- matrix(c(.9,.1,.1,.9), ncol = 2, b = TRUE)
    gamma3 <-
        matrix(c(.9,.05,.05,.05,.9,.05,.05,.05,.9), ncol = 3,
               b = TRUE)
    gamma4 <-
        matrix(c(.9, rep(.1/3,3), .1/3,.9, rep(.1/3,2),
                 rep(.1/3,2),.9,.1/3, rep(.1/3,3),.9 ), ncol = 4,
               b = TRUE)
    gamma5 <-
        matrix(c(.9, rep(.025,4), .025, .9,
                 rep(.025,3),rep(.025,2), .9, rep(.025,2),
                 rep(.025,3), .9, .025,rep(.025,4), .9),ncol=5,
               b = TRUE)
    

####################################
    ##df's for each model
    k1 <- 2
    k2 <- 5
    ##k2.heter <- 6
    k3 <- 10
    ##k3.heter <- 12
    k4 <- 12
    ##k4.heter <- 15
    k5 <- 16
    ##k5.heter <- 30

###################################

    z1 <- -sum(log(dnorm(y, mean=mean(y), sd=sqrt(var(y)))))
    z2 <-
        try(hidden(y,dist="normal", cmu=mu1.func, pcmu=mu2, pshape=vr,
                   pgamma=gamma2, iterlim=maxiter))
    ##z2.heter <- try(hidden(y,dist="normal", cmu=mu1.func, pcmu=mu2, pshape=rep(vr,2), pgamma=gamma2, iterlim=maxiter))
    z3 <-
        try(hidden(y,dist="normal", cmu=mu1.func, pcmu=mu3, pshape=vr,
                   pgamma=gamma3, iterlim=maxiter))
    ##z3.heter <- try(hidden(y,dist="normal", cmu=mu1.func, pcmu=mu3, pshape=rep(vr,3), pgamma=gamma3, iterlim=maxiter))
    z4 <-
        try(hidden(y,dist="normal", cmu=mu1.func, pcmu=mu4, pshape=vr,
                   pgamma=gamma4, iterlim=maxiter))
    ##z4.heter <- try(hidden(y,dist="normal", cmu=mu1.func, pcmu=mu4, pshape=rep(vr,4), pgamma=gamma4, iterlim=maxiter))
    z5 <-
        try(hidden(y,dist="normal", cmu=mu1.func, pcmu=mu5, pshape=vr,
                   pgamma=gamma5, iterlim=maxiter))
    ##z5.heter <- try(hidden(y,dist="normal", cmu=mu1.func, pcmu=mu5, pshape=rep(vr,5), pgamma=gamma5, iterlim=maxiter))

###############Comments#########################
###previously had the messages regarding failure of the model fitting for a given
###number of components shown. However, this interferes with vignette building.
###thus we took it out. May possibly look for a more elegant way in the future to
###identify such fits

###    options(show.error.messages = TRUE)
    opts <- options(show.error.messages = FALSE)

#################################

    if (length(names(z2)) == 0)
        z2$maxlik <- NA
    ##if (length(names(z2.heter)) == 0)
    ##{
    ##        z2.heter$maxlik <- NA
    ##}

    if (length(names(z3)) == 0)
    {
        z3$maxlik <- NA
    }
    ##if (length(names(z3.heter)) == 0)
    ##{
    ##        z3.heter$maxlik <- NA
    ##}
    
    if (length(names(z4)) == 0)
    {
        z4$maxlik <- NA
    }
    ##if (length(names(z4.heter)) == 0)
    ##{
    ##        z4.heter$maxlik <- NA
    ##}
    if (length(names(z5)) == 0)
    {
        z5$maxlik <- NA
    }
    ##if (length(names(z5.heter)) == 0)
    ##{
    ##        z5.heter$maxlik <- NA
    ##}


###############################################3
###############################################3
    ##identify the model with the smallest model selection criteria

    ##now, scroll over all options:

    for (nl in 1:nlists)
    {
        if ((aic) && (nl==1))
        {
            ##-2loglik+2*k
            factor <- 2
        }
        else if (bic)
        {
            ##-2loglik+2*k*log(n)*delta
            if (aic)
            {
                factor <- log(numobs)*delta[nl-1]
            }
            else
            {
                factor <- log(numobs)*delta[nl]
            }
        }

        lik <-
            c(2*z1+2*k1*factor, 2*z2$maxlik+2*k2*factor,
              2*z3$maxlik+2*k3*factor, 2*z4$maxlik+2*k4*factor,
              2*z5$maxlik+2*k5*factor)
        switch(which.min(lik),
           {
               
               z <- z1
               name <- "z1"
               nstates <- 1
               
           },
           {
               
               z <- z2
               name <- "z2"
               nstates <- 2
               
           },
           {
               
               z <- z3
               name <- "z3"
               nstates <- 3
               
           },
           {
               
               z <- z4
               name <- "z4"
               nstates <- 4
               
           },
           {
               
               z <- z5
               name <- "z5"
               nstates <- 5
               
           }
               )
        
######################################
        ##out rpred and state

        if (nstates  > 1) #if non-generic
        {
            ##print(nstates)
            maxstate <- apply(z$filter,2,which.max)
            rpred <- z$rpred
            prob <- apply(z$filter,2,max)
            ##pred <- z$coef[maxstate]
            ##use median for prediction and mad for state dispersions
            maxstate.unique <- unique(maxstate)
            pred <- rep(0, length(y))
            disp <- rep(0, length(y))
            for (m in 1:length(maxstate.unique))
            {
                
                pred[maxstate==maxstate.unique[m]] <-
                    median(y[maxstate==maxstate.unique[m]])
                disp[maxstate==maxstate.unique[m]] <-
                    mad(y[maxstate==maxstate.unique[m]])
                
            }

            ##if (length(z$pshape) == 1)
            ##{
            ##        disp <- rep(z$pshape, length(maxstate))
            ##}
            ##else
            ##{
            ##        disp <- z$pshape[maxstate]
            ##}
            
        }
        else #if generic
        {
            maxstate <- rep(1, length(y))
            ##rpred <- rep(mean(y), length(y))
            rpred <- rep(median(y), length(y))
            prob <- rep(1, length(y))
            ##pred <- rep(mean(y), length(y))
            pred <- rep(median(y), length(y))
            ##disp <- rep(var(y), length(y))
            disp <- rep(mad(y), length(y))
            
        }
        
        out <-
            cbind(matrix(maxstate, ncol=1), matrix(rpred, ncol=1),
                  matrix(prob, ncol=1), matrix(pred, ncol=1),
                  matrix(disp, ncol=1))
        out.all <- matrix(NA, nrow=length(kb.ord), ncol=6)
        out.all[ind.nonna,1:5] <- out
        out.all[,6] <- obs.ord
        out.all <- as.data.frame(out.all)
        dimnames(out.all)[[2]] <-
            c("state", "rpred", "prob", "pred", "disp", "obs")
        
        
        if (nl==1)
        {
            out.all.list <- list(out.all)
            nstates.list <- list(nstates)
        }
        else
        {
            out.all.list[[nl]] <- out.all
            nstates.list[[nl]] <- nstates
        }
        
        ##cloneinfo <- as.data.frame(cbind(rep(chrom, length(kb.ord)), kb.ord))
        ##dimnames(cloneinfo)[[2]] <- c("Chrom", "kb")
    }
    options(opts)
    
    list(out.list = out.all.list, nstates.list = nstates.list)
    
}

as.matrix.dist <- 
    function (x)
{
    size <- attr(x, "Size")
    df <- matrix(0, size, size)
    df[row(df) > col(df)] <- x
    df <- df + t(df)
    labels <- attr(x, "Labels")
    dimnames(df) <- if (is.null(labels))
        list(1:size, 1:size)
    else list(labels, labels)
    df
}

#################################################################################
#################################################################################
mergeFunc <-
    function(statesres = states.bic, minDiff = .1)
{
    ##merging states which are too close to each other to avoid showing technical
    ##rather than biological artifacts.
    ##
    ##start with two states closest to each other, if there are close enough , merge them
    ##and continue while treating them as the same state. Stop when no more states
    ##can be merged. write out states.merge file

    ##with merging only states and predicted values need to be changed


    sq.state <- seq(3, ncol(statesres), b=6)
    sq.pred <- seq(6, ncol(statesres), b=6)
    sq.obs <- seq(8, ncol(statesres), b=6)

    chrom <- statesres[,1]

    for (i in 1:length(sq.state)) #over all samples
    {
###        print(i)

        for (j in 1:length(unique(chrom))) ##over all chromosomes
        {
            ##missing values
            statesr <- statesres[ chrom == j, ]
            ind.nonna <- which(!is.na(statesr[ ,sq.obs[i] ]))
            states <- statesr[,sq.state[i] ][ind.nonna] #states
            obs <- statesr[ ,sq.obs[i] ][ind.nonna] #observations
            pred <- statesr[ ,sq.pred[i] ][ind.nonna] #predicted (medians in a state)

            ##if there are K states, there can't be more than (K-1) merges

            num.states <- length(unique(states)) ##number of states:

            ##if more than 1 state
            if (num.states > 1)
            {
                for (m in 1:(num.states-1))
                {

#########

                    states.uniq <- unique(states) ##unique list of states
                    pred.states.uniq <- rep(0, length(states.uniq)) ##unique list of predictions for that states
                    for (s in 1:length(states.uniq))
                    {

                        pred[states ==states.uniq[s]] <- median(obs[states ==states.uniq[s]])
                        pred.states.uniq[s] <- (pred[states==states.uniq[s]])[1]
                    }
#########

                    dst <- abs(dist(pred.states.uniq)) ##paiwise distances
                    if (min(dst)  >= minDiff)
                        ##if minimum difference is large enough
                    {
                        ##record the merged version
                        statesres[chrom==j, sq.state[i]][ind.nonna] <-
                            states
                        statesres[chrom==j, sq.pred[i]][ind.nonna] <- pred
                        
                        break
                    }
                    else
                        ##if closest are close enough
                    {
                        pred.dist.matr <- as.matrix.dist(dst)
                        ##find the closest two states, in the case of the tie take the first one
                        for (s1 in 1:(nrow(pred.dist.matr)-1))
                        {
                            for (s2 in (s1+1):ncol(pred.dist.matr))                                                        {
                                if (pred.dist.matr[s1,s2] == min(dst))
                                    ##s1 and s2 are  the first two states that are too close to each other
                                {
                                    states[states==states.uniq[s2]] <- states.uniq[s1] ##update states
                                    pred[states==states.uniq[s1]] <- median(obs[states==states.uniq[s1]])
                                    break
                                }
                            }
                        }
                    }
                }
                
            }
            statesres[chrom==j, sq.state[i]][ind.nonna] <- states
            statesres[chrom==j, sq.pred[i]][ind.nonna] <- pred
        }
    }
    list(states.hmm = statesres)
    
}

#################################################################################
#################################################################################

computeSD.func <-
    function(statesres=states.bic, maxmadUse = .2, maxmedUse = .2,
             maxState=3, maxStateChange = 10, minClone=20,
             maxChrom=22)
{
    ##1. maxmadUse : use state only if its mad <= maxmadUse (to avoid cases where
    ##points HMM does not seprate reults into several states (e.g. when
    ##individual clones fall out)
    ##maxmedUse: use state only if median is less < maxmedUse (states
    ##with chnages may have higher sd beause not all clones acquare a given
    ##aberration
    ##2. maxState: use only those chromosomes that contain fewer than maxState
    ##states (may modify to state transitions later
    ##3. minClone: use only those states that contain greater than minClone
    ##observations
    ##4. maxChrom: use up to maxChrom (e.g. avoid using X and Y)
    chrom <- statesres[,1]
    sq.state <- seq(3, ncol(statesres), b=6)
    sq.obs <- seq(8, ncol(statesres), b=6)
    madChrom <- matrix(NA, nrow=length(unique(chrom)), ncol=length(sq.state))
    madGenome <- rep(NA, length(sq.state))
    for (i in 1:length(sq.obs))
    {

        mad.tmp <- NA
        for (j in 1:maxChrom)
        {
            ind.nonna <- (1:length(statesres[chrom==j, sq.obs[i]]))[!is.na(statesres[chrom==j, sq.obs[i]])]
            mad.tmp1 <- NA
            states.uniq <- unique(statesres[chrom==j, sq.state[i]][ind.nonna])
            states <- statesres[chrom==j, sq.state[i]][ind.nonna]
            obs <- statesres[chrom==j, sq.obs[i]][ind.nonna]
            ##use only chromosomes with <= maxState

            states.change <- diff(states)
            states.change.num <- length(states.change[states.change!=0])
            
            ##if (length(states.uniq) <= maxState)
            if ((length(states.uniq) <= maxState) && (states.change.num <= maxStateChange))
            {
                
                for (k in states.uniq)
                {
                    obs.state <- obs[states==k]
                    md <- mad(obs.state, na.rm = TRUE)
                    med <- median(obs.state, na.rm = TRUE)
                    
                    ##use only states with >=  minClone and mad of state is <= maxmadUse and
                    ##median of state is < maxmedUse
                    if ((length(obs.state) >= minClone) && (md <= maxmadUse) && (abs(med) <= maxmedUse))
                    {
                        
                        mad.tmp1 <- c(mad.tmp1, md)
                        
                    }
                }
            }
            if (length(mad.tmp1[!is.na(mad.tmp1)]) > 0)
            {
                mad.tmp1 <- mad.tmp1[-1]
                mad.tmp <- c(mad.tmp, mad.tmp1)
                madChrom[j,i] <- median(mad.tmp1)
            }
        }
        if (length(mad.tmp[!is.na(mad.tmp)]) > 0)
        {
            mad.tmp <- mad.tmp[-1]
            madGenome[i] <- median(mad.tmp)
        }
        
    }
    if (length(madGenome[is.na(madGenome)]) > 0)
        cat("Warning: MAD could not had ben computed for one of the\
samples\n")
    
    list(madChrom = madChrom, madGenome = madGenome)
    
}
#################################
#################################

findOutliers.func <-
    function(thres=madGenome, factor=4, statesres=states.bic)
{
    ##"state", "rpred", "prob", "pred", "disp", "obs"
    
    thres <- thres*factor
    
    chrom <- statesres[,1]
    sq.state <- seq(3, ncol(statesres), b=6)
    sq.rpred <- seq(4, ncol(statesres), b=6)
    sq.prob <- seq(5, ncol(statesres), b=6)
    sq.pred <- seq(6, ncol(statesres), b=6)
    sq.obs <- seq(8, ncol(statesres), b=6)

    ##outputs
    ##1 = outlier	
    outlier <- matrix(0, nrow=length(chrom), ncol=length(sq.state))
    states.out <- matrix(0, nrow=length(chrom), ncol=length(sq.state))

    ##predicted values for all (including outliers) with median computed without outliers	
    pred.out <- matrix(0, nrow=length(chrom), ncol=length(sq.state))
    ##predicted values for all but outliers
    pred.obs.out <- matrix(0, nrow=length(chrom), ncol=length(sq.state))
    for (i in 1:length(sq.state))
    {
###        print(i)
        for (j in 1:length(unique(chrom)))
        {
            ind.nonna <- (1:length(statesres[chrom==j, sq.obs[i]]))[!is.na(statesres[chrom==j, sq.obs[i]])]
            states <- statesres[chrom==j, sq.state[i]][ind.nonna]
            obs <- statesres[chrom==j, sq.obs[i]][ind.nonna]
            pred <- statesres[chrom==j, sq.pred[i]][ind.nonna]
            pred.obs <- pred
            ##identify outliers
            for (k in 1:length(obs))
            {
                md <-  median(obs[states==states[k]],na.rm = TRUE)
                if ((obs[k] >  md + thres[i]) || (obs[k] < md - thres[i]))
                {
                    outlier[chrom==j, i][ind.nonna][k] <- 1
                    ##assigning observed value for a clone instead of predicted
                    pred.obs[k] <- obs[k]

#####NO longer do this ####################################################
                    ##state is -1 : will reassign state later as well as predicted value
                    ##possibly using pam() clustering and siluette width as a measure

					#states[k] <- -1
#####NO longer do this ####################################################
                }
            }
            ##recompute medians (predicted) without outliers -- use medians now	
            ##Note that predicted before indicated means and now indicate median

            ##states other than "-1" -- i.e. statesless
            
            states.uniq <- unique(states)
            for (m in 1:length(states.uniq))
            {
                ##predictions for all
                pred[states==states.uniq[m]] <-  median(obs[states==states.uniq[m] & outlier[chrom==j, i][ind.nonna] == 0])
                ##predictions for non-outliers only
                pred.obs[states==states.uniq[m] & outlier[chrom==j, i][ind.nonna] == 0] <-  median(obs[states==states.uniq[m] & outlier[chrom==j, i][ind.nonna] == 0])
                
            }
            
            pred.obs.out[chrom==j, i][ind.nonna] <- pred.obs
            pred.out[chrom==j, i][ind.nonna] <- pred
        }
    }
    list(outlier=outlier, pred.obs.out=pred.obs.out, pred.out=pred.out)
}

#################################
#################################

findAber.func <-
    function(maxClones =1, maxLen = 1000, statesres = states.bic)
{
    ##either fewer than maxClones or length <= maxLen. 

    chrom <- statesres[,1]
    kb <- statesres[,2]
    sq.state <- seq(3, ncol(statesres), b=6)
    sq.obs <- seq(8, ncol(statesres), b=6)
    aber <- matrix(0, nrow=length(chrom), ncol=length(sq.state))
    for (i in 1:length(sq.state))
    {
###        print(i)
        for (j in 1:length(unique(chrom)))
        {
            ind.nonna <- (1:length(statesres[chrom==j, sq.obs[i]]))[!is.na(statesres[chrom==j, sq.obs[i]])]
            states <- statesres[chrom==j, sq.state[i]][ind.nonna]
            kbnow <- kb[chrom==j][ind.nonna]
            
            abernow <- rep(0, length(kbnow))

            num <- 1
            for (m in 2:length(states))
            {
                if (states[m-1] != states[m])
                {
                    ##first clone is different from 2nd <- it's aberration	
                    if (m == 2)
                    {
                        abernow[1] <- 1
                    }
                    ##2nd clone is dif't from 3rd
                    if (m == 3)
                    {
                        abernow[1:2] <- 1
                    }
                    
                    ##last clone is different from previous <- it's aberration	
                    ##the clones before last may be an aberration as well
                    if (m == length(states))
                    {
                        
                        abernow[length(states)] <- 1
                        
                    }

                    ##clone before last is different from previous <- it's aberration	
                    if (m == (length(states)-1))
                    {
                        
                        abernow[(length(states)-1):(length(states))] <- 1
                        
                    }
                    
                    if (m <= length(states))
                    {	
                        ##take middle distances: if number of clones is small or they are very close together
                        
                        if ((num <= maxClones) || ((kbnow[m-1]-kbnow[m-num]) <= maxLen))
                            
                        {
                            abernow[(m-num):(m-1)] <- 1
                        }
                    }
                    num <- 1
                }
                else
                {
                    num <- num + 1
                }
            }
            aber[chrom==j, i][ind.nonna] <- abernow
        }
    }
    list(aber=aber)
}

#################################
#################################

findTrans.func <-
    function(outliers=res1$outliers, aber=res2$aber,
             statesres=states.bic)
{

    ##exclude aberrations but keep outliers in

    chrom <- statesres[,1]
    kb <- statesres[,2]
    sq.state <- seq(3, ncol(statesres), b=6)
    sq.obs <- seq(8, ncol(statesres), b=6)
    ##transition matrix
    trans.matrix <- matrix(0, nrow=length(chrom), ncol=length(sq.state))

    ##lenght of the corresponding stretch matrix: 0 for aberrations and outliers

    translen.matrix <- matrix(NA, nrow=length(chrom), ncol=length(sq.state))

    for (i in 1:length(sq.state))
    {
###        print(i)
        for (j in 1:length(unique(chrom)))
        {
            ind.nonna <-
                (1:length(statesres[chrom==j, sq.obs[i]]))[!is.na(statesres[chrom==j, sq.obs[i]])]
            kbnow <- kb[chrom==j][ind.nonna]
            states <- statesres[chrom==j, sq.state[i]][ind.nonna]
            outliersnow <- outliers[chrom==j,i][ind.nonna]
            abernow <- aber[chrom==j,i][ind.nonna]
            transnow <- rep(0, length(states))
            translennow <- rep(0, length(states))
            states.diff <- diff(states[abernow==0])
            ind <- (1:length(states.diff))[states.diff != 0]
            
            if (length(ind) > 0)
            {
                start <- ind+1
                end <-  ind
                
                transnow[abernow==0][start] <- 1
                transnow[abernow==0][end] <- 2
                
            }
            

#######
            ##compute the length of the corresponding stretches: same number is assigned for all clones
            ##between 1 and 2 including aberrations and outliers. distance to the first end is 
            ##computed from the start and of the last stretch is computed from the last clone to the
            ##end of chromosome.

            st <- c(1,(1:length(transnow))[transnow==1])
            en <- c((1:length(transnow))[transnow==2], length(transnow))
            
            for (m in 1:length(st))
            {
                translennow[st[m]:en[m]] <- kbnow[en[m]]-kbnow[st[m]]
                
            }
            
            translen.matrix[chrom==j,i][ind.nonna] <- translennow
            
            
############

            transnow[abernow==1] <- 3
            trans.matrix[chrom==j,i][ind.nonna] <- transnow
            
        }
    }
    list(trans.matrix=trans.matrix, translen.matrix=translen.matrix)

}

#################################
#################################

findAmplif.func <-
    function(absValSingle = 1, absValRegion = 1.5, diffVal1=1,
             diffVal2 = .5, maxSize =  10000, translen.matr =
             res3$translen.matrix, trans.matr = res3$trans.matr, aber
             = res2$aber, outliers= res1$outlier, pred =
             res1$pred.out, pred.obs = res1$pred.obs.out,
             statesres=states.bic)
{
    chrom <- statesres[,1]
    kb <- statesres[,2]
    sq.state <- seq(3, ncol(statesres), b=6)
    sq.obs <- seq(8, ncol(statesres), b=6)

    amplif.matrix <- matrix(0, nrow=length(kb), ncol=length(sq.state))
    
    for (i in 1:length(sq.state))
    {
###        print(i)
        for (j in 1:length(unique(chrom)))
        {
            
            ind.nonna <- (1:length(statesres[chrom==j, sq.obs[i]]))[!is.na(statesres[chrom==j, sq.obs[i]])]
            
            abernow <- aber[chrom==j,i][ind.nonna]
            outliersnow <- outliers[chrom==j,i][ind.nonna]
            ##predicted value for the stretch

            prednow <- pred[chrom==j,i][ind.nonna]
            
            ##predicted value for the stretch, outliers have observed value
            predobsnow <- pred.obs[chrom==j,i][ind.nonna]
            
            obsnow <- statesres[chrom==j,sq.obs[i]][ind.nonna]
            transnow <- trans.matr[chrom==j,i][ind.nonna]
            translennow <- translen.matr[chrom==j,i][ind.nonna]

            amplifnow <- rep(0, length(obsnow))
            
########maybe remove############		
            ##if aberration or outlier and > absValSingle 		
            ##			
            ##			amplifnow[(abernow==1 | outliersnow ==1) & obsnow >= absValSingle] <- 1
##################################
            ##if aberration and greater by diffVal1 than max of the two surrounding  
            ##stretches or
            ##if outlier and greater by diffVal2 than its stretch and > 1
            
            ##outlier is much larger (diffVal) that its stretch
            amplifnow[outliersnow ==1 & ((obsnow - prednow)	>= diffVal1)] <- 1
            ##outlier and > 1 and diffVal2 greater than its stretch

            amplifnow[outliersnow ==1 & ((obsnow - prednow)	>= diffVal2) & obsnow >= absValSingle] <- 1

            ##aberration is much larger than maximum of the two surrounding stretches
            ##need to take spacial care when no stertches to the left or to the right 
            indaber <- (1:length(amplifnow))[abernow==1]
            if (length(indaber) > 0)
            {
                
                indstretch <- (1:length(amplifnow))[abernow==0 & outliersnow==0]
                for (m in 1:length(indaber))
                {
                    stretchleft <- max(0, max(indstretch[indstretch < indaber[m]]), na.rm = TRUE)
                    stretchright <- min((length(amplifnow)+1), min(indstretch[indstretch > indaber[m]]), na.rm = TRUE)
                    ##if no stretches to the left
                    if (stretchleft == 0)
                    {
                        mx <- prednow[stretchright]
                    } ##if no stretches to the right:
                    else if (stretchright == (length(amplifnow)+1))
                    {
                        mx <- prednow[stretchleft]
                    }
                    else
                    {
                        mx <- max(prednow[stretchleft], prednow[stretchright])
                    }
                    if (!is.na(mx))
                    {
                        if (((predobsnow[indaber[m]] - mx) >= diffVal1) || ((predobsnow[indaber[m]] - mx) >= diffVal2 && (predobsnow[indaber[m]] >= absValSingle)))
                        {
                            amplifnow[indaber[m]] <- 1
                        }
                    }
                }	
            }			
            
            

            ##if part of the stretch and observed value of > absValRegion and 
            ##NOT YET: larger by diffValRegion than max of the surrounding regions regions and 
            ##size of the corresponding stretch <= maxSize
            
            amplifnow[abernow==0 & outliersnow ==0 & obsnow >= absValRegion & translennow <= maxSize] <- 1
            
            amplif.matrix[chrom==j,i][ind.nonna] <- amplifnow
            
        }
    }
    list(amplif = amplif.matrix)
}


######################################
######################################

plotChrom.hmm.func <-
    function(sample, chr, statesres=states.bic, amplif = res4$amplif,
             aber=res2$aber, outliers = res1$outlier, trans =
             res3$trans.matr, pred = res1$pred.out,  yScale = c(-2,2),
             maxChrom=23, chrominfo = human.chrom.info.Jul03,
             samplenames, namePSfile = "try.ps", ps = TRUE, plotend = TRUE)
{

    chrom.rat <- chrominfo$length / max(chrominfo$length)
    chrom.start <- rep(0, maxChrom)
    for (i in 2:length(chrom.start))
    {
        chrom.start[i] <- sum(chrominfo$length[1:(i-1)])
    }
    ##
    ##
    ##chrom.mid contains middle positions of the chromosomes relative to
    ##the whole genome (useful for plotting the whole genome)
    ##
    chrom.mid <- rep(0, maxChrom)
    for (i in 1:length(chrom.start))
    {
        chrom.mid[i] <- chrom.start[i]+chrominfo$length[i]/2
    }
###############################################



    chrom <- statesres[,1]

    if (plotend)
    {
        if (ps)
        {
            postscript(namePSfile, paper="letter")
        }
        else
        {
            pdf(namePSfile, width=11, height=8.5)
        }
        par(mfrow=c(2,1))
    }
    par(lab=c(15,6,7), pch=18, cex=1, lwd=1)

    sq.state <- seq(3, ncol(statesres), b=6)
    sq.obs <- seq(8, ncol(statesres), b=6)

    for (j in 1:length(chr))
    {

        ind.nonna <-
            which(!is.na(statesres[chrom==chr[j], sq.obs[sample]]))

        kb <- (statesres[chrom==chr[j],2][ind.nonna])/1000
        obs <- statesres[chrom==chr[j], sq.obs[sample]][ind.nonna]
        states <- statesres[chrom==chr[j], sq.state[sample]][ind.nonna]
        nstates <- length(unique(states)) 

        abernow <- aber[chrom==chr[j],sample][ind.nonna]
        outliersnow <- outliers[chrom==chr[j],sample][ind.nonna]
        amplifnow <- amplif[chrom==chr[j],sample][ind.nonna]
        transnow <- trans[chrom==chr[j],sample][ind.nonna]

        ##predicted values when non-aberration of outlier: otherwise observed
        prednow <- obs
        prednow[outliersnow == 0 & abernow==0] <-
            (pred[chrom==chr[j],sample][ind.nonna])[outliersnow == 0 &
                  abernow==0]

        y.min <- min(yScale[1], min(obs))
        y.max <- max(yScale[2], max(obs))

##################

        ##observed

        plot(kb, obs, xlab="", ylab="", ylim=c(y.min, y.max), type="l", col="blue", xlim=c(0, chrominfo$length[chr[j]]/1000))
        points(kb, obs,col="black")
        title(main=paste("Sample ", sample, " ", samplenames[sample], " - Chr ",chr[j], "Number of states ", nstates), xlab="kb (in 1000's)", ylab="data (observed)")
        abline(h=seq(y.min,y.max, b=.2), lty=3)
        abline(v=chrominfo$centromere[chr[j]]/1000, lty=2, col="red", lwd=3)
        ##start (dotted blue) and end of states (green)


        if (nstates > 1)
        {
            abline(v=kb[transnow==1], col="blue", lwd=2)
            abline(v=kb[transnow==2], col="green", lty=2, lwd=.5)
        }

###########
        ##amplif = red
        ##aber = orange
        ##outliers = yellow


        if (length(outliersnow[outliersnow ==1]) > 0)
        {
            points(kb[outliersnow ==1], obs[outliersnow ==1], col="yellow")
        }
        if (length(abernow[abernow ==1]) > 0)
        {
            points(kb[abernow ==1], obs[abernow ==1], col="orange")
        }
        if (length(amplifnow[amplifnow ==1]) > 0)
        {
            points(kb[amplifnow ==1], obs[amplifnow ==1], col="red")
        }


        
        ##predicted states:
        
        plot(kb, prednow, xlab="", ylab="", ylim=c(y.min, y.max), type="l", col="blue", xlim=c(0, chrominfo$length[chr[j]]/1000))
        points(kb, prednow,col="black")
        title(xlab="kb (in 1000's)", ylab="data (smoothed)")
        abline(h=seq(y.min,y.max, b=.2), lty=3)
        abline(v=chrominfo$centromere[chr[j]]/1000, lty=2, col="red", lwd=3)


        ##start (dotted blue) and end of states (green)
        if (nstates > 1)
        {
            abline(v=kb[transnow==1], col="blue", lwd=2)
            abline(v=kb[transnow==2], col="green", lty=2, lwd=.5)
        }



###########
        ##amplif = red
        ##aber = orange
        ##outliers = yellow


        if (length(outliersnow[outliersnow ==1]) > 0)
        {
            points(kb[outliersnow ==1], obs[outliersnow ==1], col="yellow")
        }
        if (length(abernow[abernow ==1]) > 0)
        {
            points(kb[abernow ==1], obs[abernow ==1], col="orange")
        }
        if (length(amplifnow[amplifnow ==1]) > 0)
        {
            points(kb[amplifnow ==1], obs[amplifnow ==1], col="red")
        }
    } 
    if (plotend)
    {	
	dev.off()
    }
}
##################################
##################################

plotCGH.hmm.func <-
    function (data=dat, datainfo=clones.info, chrominfo=chrominfo,
              samplename, sampNm=sampleNames, yScale = c(-2,2),
              namePSfile = "try.ps", ps = TRUE, statesres=states.bic,
              amplif = res4$amplif, aber=res2$aber, outliers =
              res1$outlier, trans = res3$trans.matr)
{
################General Comments############################################

#########creating chromFull.info file

    chrom.uniq <- unique(datainfo$Chrom)

    chrominfo <- chrominfo[chrom.uniq,]

    sq.state <- seq(3, ncol(statesres), b=6)
    sq.obs <- seq(8, ncol(statesres), b=6)



#########
    chrom.rat <- chrominfo$length/max(chrominfo$length)  
    ##i.e. for each chromosome it repreesents the fraction of length of the
    ##longest chromosome
    ##
    ##chrom.start contains starting positions of the chromosomes relative to the
    ##whole genome (0 for the first)
    chrom.start <- rep(0, length(chrom.uniq))
    for (i in 2:length(chrom.start))
    {
	chrom.start[i] <- sum(chrominfo$length[1:(i-1)])
    }
    ##
    ##chrom.mid contains middle positions of the chromosomes relative to
    ##the whole genome (useful for plotting the whole genome)
    chrom.mid <- rep(0, length(chrom.uniq))
    for (i in 1:length(chrom.start))
    {
	chrom.mid[i] <- chrom.start[i]+chrominfo$length[i]/2
    }

    chromFull.info <- as.data.frame(cbind(chrominfo, chrom.start, chrom.mid, chrom.rat))
    dimnames(chromFull.info)[[2]] <- c("chr", "length", "centromere", "start", "mid", "rat")

########################################


    ##computing positions in genome for each clone:

    clone.genomepos <- rep(0, length(datainfo$kb))
    for (i in 1:length(chrom.uniq))
    {
	clone.genomepos[datainfo$Chrom==i] <- datainfo$kb[datainfo$Chrom==i]+chromFull.info$start[i]
    }

##########
    ##Now, determine vertical scale for each chromosome:

    y.min <- rep(yScale[1], length(chrom.uniq))
    y.max <- rep(yScale[2], length(chrom.uniq))

##############
    ##figure out the sample
    ##
    smpnames <- sampNm
    if ((samplename >= 1) && (samplename <= ncol(data)))
        ##samplename was the index
    {
	smp <- samplename
	samplename <- smpnames[smp]
        ##so now samplename is a name
    }
    else ##samplename 
    {
	
	smp <- (1:length(smpnames))[smpnames==samplename]
    }
##############
    ##values to plot:

    vals <- data[,smp]

#############
    ##adjust scales of chromosomes that have values outside a fixed scale

    for (i in 1:length(chrom.uniq))
    {
	y.min[i] <- min(c(vals[datainfo$Chrom==i],yScale[1]), na.rm = TRUE)
	y.max[i] <- max(c(vals[datainfo$Chrom==i],yScale[2]), na.rm = TRUE)
    }

    ##set genome scale to the max and min values across chrom's

    ygenome.min <- min(y.min, na.rm = TRUE)
    ygenome.max <- max(y.max, na.rm = TRUE)

#########################
    ##start a postscript file

    postscript(namePSfile, paper="letter", horizontal=FALSE)
    ##just a safety line
    close.screen(all = TRUE)
    ##"inch" factor for to determine size of the plot in inches (for "pin" parameter)
    fact <- 3.9
    ##split the screen

    split.screen(c(9,1))
    screen(1)
    split.screen(c(1,2))
    screen(2)
    split.screen(c(1,2))
    screen(3)
    split.screen(c(1,2))
    screen(4)
    split.screen(c(1,2))
    screen(5)
    split.screen(c(1,3))
    screen(6)
    split.screen(c(1,3))
    screen(7)
    split.screen(c(1,4))
    screen(8)
    split.screen(c(1,3))
    screen(28)
    split.screen(c(1,2))
    screen(29)
    split.screen(c(1,2))

    ##plot chromosomes

    scr.seq <- c(10:27, 31:34, 30)  
    j.seq <- 1:length(chrom.uniq)
    for (j in j.seq)
    {

        ind.nonna <- (1:length(vals[datainfo$Chrom==j]))[!is.na(vals[datainfo$Chrom==j])]
        screen(scr.seq[j])
        par(cex=.5, pch=20, lab=c(15,4,7), tcl=-.2, las=1, oma=c(0,0,0,0), cex.axis=1.3, cex.main=1.3, mgp=c(0,.15,0), lwd=.5)
        par(pin=c(chromFull.info$rat[j]*fact, .65))
        
        plot((datainfo$kb[datainfo$Chrom==j][ind.nonna])/1000, vals[datainfo$Chrom==j][ind.nonna], ylim=c(y.min[j],y.max[j]), xlab="", ylab="", type="l", col="blue", xlim=c(0, chromFull.info$length[j]/1000))
        points((datainfo$kb[datainfo$Chrom==j][ind.nonna])/1000, vals[datainfo$Chrom==j][ind.nonna], col="black")
        
        ##if (j < 23)
        ##{
        ##title(main=paste("Chr",j), line=.1)
        ##}
        ##else
        ##{
        ##	title(main="Chr. X", line=.1)
        ##}

        title(main=paste("Chr",j), line=.1)

        abline(h=seq(y.min[j],y.max[j], b=.5), lty=3)
        abline(v=0, lty=2)		
        abline(v=chromFull.info$centromere[j]/1000, lty=2, col="red")

####################
        ##plotting transitions and aberrations

        kb <- (datainfo$kb[datainfo$Chrom==j][ind.nonna])/1000
        chrom <- datainfo$Chrom	
        
        obs <- vals[chrom==j][ind.nonna]

        states <- statesres[chrom==j, sq.state[smp]][ind.nonna]
        nstates <- length(unique(states)) 

        abernow <- aber[chrom==j,smp][ind.nonna]
        outliersnow <- outliers[chrom==j,smp][ind.nonna]
        amplifnow <- amplif[chrom==j,smp][ind.nonna]
        transnow <- trans[chrom==j,smp][ind.nonna]


##################

        if (nstates > 1)
        {
            abline(v=kb[transnow==1], col="blue", lwd=1)
            abline(v=kb[transnow==2], col="green", lty=2, lwd=.25)
        }

###########
        ##amplif = red
        ##aber = orange
        ##outliers = yellow


        if (length(outliersnow[outliersnow ==1]) > 0)
        {
            points(kb[outliersnow ==1], obs[outliersnow ==1], col="yellow")
        }
        if (length(abernow[abernow ==1]) > 0)
        {
            points(kb[abernow ==1], obs[abernow ==1], col="orange")
        }
        if (length(amplifnow[amplifnow ==1]) > 0)
        {
            points(kb[amplifnow ==1], obs[amplifnow ==1], col="red")
        }
	



####################




        
    }
    
    ##plot genome:
    screen(9 )

    par(cex=.5, pch=20, lab=c(1,4,7), tcl=-.2, las=1, cex.axis=1.3, mgp=c(0,.15,0), cex.main=1.3, xaxs="i")
    par(pin=c(7.8, .55))
    plot(clone.genomepos/1000, vals, ylim=c(ygenome.min,ygenome.max), xlab="", ylab="", xlim=c(min(clone.genomepos[clone.genomepos>0], na.rm = TRUE)/1000, clone.genomepos[length(clone.genomepos[clone.genomepos>0])]/1000), col="black", type="l", lwd=1)
    title(main="Whole Genome (not to horizontal scale)",line=.1)
    for (i in seq(1,21,b=2))
    {	
        mtext(paste("", i), side = 1, at = (chromFull.info$mid[i]/1000), line=.3, col="red", cex.main=.5)
    }
    mtext("X", side = 1, at = (chromFull.info$mid[nrow(chromFull.info)]/1000), line=.3, col="red",cex.main=.5)
    abline(v=c(chromFull.info$start/1000, (chromFull.info$start[23]+chromFull.info$length[nrow(chromFull.info)])/1000), lty=1)
    abline(h=seq(ygenome.min,ygenome.max, b=.5), lty=3)
    abline(v=(chromFull.info$centromere+chromFull.info$start)/1000, lty=3, col="red")

    mtext(paste("Sample ", samplename, " ", smp, "Log2Ratio of Intensities vs Position in 1000's kb"), outer = TRUE, line=-1.2, cex=.8)
    dev.off()

####################
    

}

##################################
##################################
##FIX missing values further down

smoothData.func <-
    function(statesres=states.bic, aber=res2$aber, outliers =
             res1$outlier)
{
    sq.obs <- seq(8, ncol(statesres), b=6)
    data.smooth <- pred
    for (i in 1:length(sq.obs))
    {
        obs <- states.bic[,sq.obs[i]]
        if (length(aber[,i][aber[,i] ==1]) >0)
        {
            data.smooth[aber[,i]==1,i] <- obs[aber[,i]==1]
        }
        if (length(outliers[,i][outliers[,i] ==1]) >0)
        {
            data.smooth[outliers[,i]==1,i] <- obs[outliers[,i]==1]
        }
    }
    list(data.smooth = data.smooth)
    
    

}
##################################
##################################
##################################
##################################

thresholdData.func <-
    function(statesres=states.bic, amplif = res4$amplif,
             aber=res2$aber, outliers = res1$outlier, pred =
             res1$pred.out, noise = madGenome, factor=2.5, minMed =
             .1, thresSingle=FALSE)
{
    
    thres <- noise*factor	

    if (length(minMed) ==1)
    {
        minMed <- rep(minMed, length(thres))
    }

    sq.obs <- seq(8, ncol(statesres), b=6)
    data.thres <- matrix(0, nrow=nrow(pred), ncol=ncol(pred))
    for (i in 1:length(sq.obs))
    {
        obs <- states.bic[,sq.obs[i]]
        if (thresSingle)
        {
            ##if use individual thresholds for each clone
            
            data.thres[obs >= thres.i] <- 1
            data.thres[obs <= -thres,i] <- -1
            
        }
        else
        {
            ##use individual thresholds for outliers and aberrations only
            data.thres[(aber[,i]==1 | outliers[,i]==1) & obs >= thres ,i] <- 1
            data.thres[(aber[,i]==1 | outliers[,i]==1) & obs <= -thres,i ] <- -1
            data.thres[(aber[,i]==0 & outliers[,i]==0) & pred[,i] >=  minMed[i] ,i] <- 1
            data.thres[(aber[,i]==0 & outliers[,i]==0) & pred[,i] <= -minMed[i] ,i] <- -1
            
            
        }
        
    }
    list(data.thres = data.thres)
    
    

}
##################################
##################################

######################################
######################################

plotChrom.samples.func <-
    function(nr, nc, sample, chr,  statesres=states.bic, amplif =
             res4$amplif, aber=res2$aber, outliers = res1$outlier,
             trans = res3$trans.matr, pred = res1$pred.out,  yScale =
             c(-2,2), maxChrom=23, chrominfo=human.chrom.info.Jul03,
             samplenames)
{

    par(mfrow=c(nr,nc))

    chrom.rat <- chrominfo$length/max(chrominfo$length)
    chrom.start <- rep(0, maxChrom)
    for (i in 2:length(chrom.start))
    {
        chrom.start[i] <- sum(chrominfo$length[1:(i-1)])
    }
    ##
    ##
    ##chrom.mid contains middle positions of the chromosomes relative to
    ##the whole genome (useful for plotting the whole genome)
    ##
    chrom.mid <- rep(0, maxChrom)
    for (i in 1:length(chrom.start))
    {
        chrom.mid[i] <- chrom.start[i]+chrominfo$length[i]/2
    }
###############################################



    chrom <- statesres[,1]

    par(lab=c(15,6,7), pch=18, cex=1, lwd=1)

    sq.state <- seq(3, ncol(statesres), b=6)
    sq.obs <- seq(8, ncol(statesres), b=6)


    for (j in 1:length(chr))
    {

        ind.nonna <- (1:length(statesres[chrom==chr[j], sq.obs[sample[j]]]))[!is.na(statesres[chrom==chr[j], sq.obs[sample[j]]])]

        kb <- (statesres[chrom==chr[j],2][ind.nonna])/1000
        obs <- statesres[chrom==chr[j], sq.obs[sample[j]]][ind.nonna]
        states <- statesres[chrom==chr[j], sq.state[sample[j]]][ind.nonna]
        nstates <- length(unique(states)) 

        abernow <- aber[chrom==chr[j],sample[j]][ind.nonna]
        outliersnow <- outliers[chrom==chr[j],sample[j]][ind.nonna]
        amplifnow <- amplif[chrom==chr[j],sample[j]][ind.nonna]
        transnow <- trans[chrom==chr[j],sample[j]][ind.nonna]

        ##predicted values when non-aberration of outlier: otherwise observed
        prednow <- obs
        prednow[outliersnow == 0 & abernow==0] <- (pred[chrom==chr[j],sample[j]][ind.nonna])[outliersnow == 0 & abernow==0]


        y.min <- min(yScale[1], min(obs))
        y.max <- max(yScale[2], max(obs))

##################

        ##observed

        plot(kb, obs, xlab="", ylab="", ylim=c(y.min, y.max), type="l", col="blue", xlim=c(0, chrominfo$length[chr[j]]/1000))
        points(kb, obs,col="black")
        title(main=paste(samplenames[sample[j]], " - Chr ",chr[j], "Number of states ", nstates), xlab="kb (in 1000's)", ylab="data (observed)")
        ##abline(h=seq(y.min,y.max, b=.2), lty=3)
        abline(v=chrominfo$centromere[chr[j]]/1000, lty=2, col="red", lwd=3)
        ##start (dotted blue) and end of states (green)


        if (nstates > 1)
        {
            abline(v=kb[transnow==1], col="blue", lwd=2)
            abline(v=kb[transnow==2], col="green", lty=2, lwd=.5)
        }

###########
        ##amplif = red
        ##aber = orange
        ##outliers = yellow


        if (length(outliersnow[outliersnow ==1]) > 0)
        {
            points(kb[outliersnow ==1], obs[outliersnow ==1], col="yellow")
        }
        if (length(abernow[abernow ==1]) > 0)
        {
            points(kb[abernow ==1], obs[abernow ==1], col="orange")
        }
        if (length(amplifnow[amplifnow ==1]) > 0)
        {
            points(kb[amplifnow ==1], obs[amplifnow ==1], col="red")
        }

    } 

}
##################################
##################################


######################################
######################################

plotChrom.grey.samples.func <-
    function(nr, nc, sample, chr,  statesres=states.bic, amplif =
             res4$amplif, aber=res2$aber, outliers = res1$outlier,
             trans = res3$trans.matr, pred = res1$pred.out,  yScale =
             c(-2,2), maxChrom=23, chrominfo=human.chrom.info.Jul03,
             samplenames)
{

    par(mfrow=c(nr,nc))

    chrom.rat <- chrominfo$length/max(chrominfo$length)
    chrom.start <- rep(0, maxChrom)
    for (i in 2:length(chrom.start))
    {
        chrom.start[i] <- sum(chrominfo$length[1:(i-1)])
    }
    ##
    ##
    ##chrom.mid contains middle positions of the chromosomes relative to
    ##the whole genome (useful for plotting the whole genome)
    ##
    chrom.mid <- rep(0, maxChrom)
    for (i in 1:length(chrom.start))
    {
        chrom.mid[i] <- chrom.start[i]+chrominfo$length[i]/2
    }
###############################################



    chrom <- statesres[,1]

    par(lab=c(15,6,7), pch=18, cex=1, lwd=1)

    sq.state <- seq(3, ncol(statesres), b=6)
    sq.obs <- seq(8, ncol(statesres), b=6)


    for (j in 1:length(chr))
    {

        ind.nonna <- (1:length(statesres[chrom==chr[j], sq.obs[sample[j]]]))[!is.na(statesres[chrom==chr[j], sq.obs[sample[j]]])]

        kb <- (statesres[chrom==chr[j],2][ind.nonna])/1000
        obs <- statesres[chrom==chr[j], sq.obs[sample[j]]][ind.nonna]
        states <- statesres[chrom==chr[j], sq.state[sample[j]]][ind.nonna]
        nstates <- length(unique(states)) 

        abernow <- aber[chrom==chr[j],sample[j]][ind.nonna]
        outliersnow <- outliers[chrom==chr[j],sample[j]][ind.nonna]
        amplifnow <- amplif[chrom==chr[j],sample[j]][ind.nonna]
        transnow <- trans[chrom==chr[j],sample[j]][ind.nonna]

        ##predicted values when non-aberration of outlier: otherwise observed
        prednow <- obs
        prednow[outliersnow == 0 & abernow==0] <- (pred[chrom==chr[j],sample[j]][ind.nonna])[outliersnow == 0 & abernow==0]


        y.min <- min(yScale[1], min(obs))
        y.max <- max(yScale[2], max(obs))

##################

        ##observed

        plot(kb, obs, xlab="", ylab="", ylim=c(y.min, y.max), type="l", col="grey50", xlim=c(0, chrominfo$length[chr[j]]/1000))
        points(kb, obs,col="black")
        title(main=paste(samplenames[sample[j]], " - Chr ",chr[j], "Number of states ", nstates), xlab="kb (in 1000's)", ylab="data (observed)")
        ##abline(h=seq(y.min,y.max, b=.2), lty=3)
        abline(v=chrominfo$centromere[chr[j]]/1000, lty=2, col="grey50", lwd=3)
        ##start (dotted blue) and end of states (green)


        if (nstates > 1)
        {
            abline(v=kb[transnow==1], col="black", lwd=2)
            abline(v=kb[transnow==2], col="black", lty=2, lwd=.5)
        }

###########
        ##amplif = red
        ##aber = orange
        ##outliers = yellow


        if (length(outliersnow[outliersnow ==1]) > 0)
        {
            points(kb[outliersnow ==1], obs[outliersnow ==1], col="grey80")
        }
        if (length(abernow[abernow ==1]) > 0)
        {
            points(kb[abernow ==1], obs[abernow ==1], col="grey50")
        }
        if (length(amplifnow[amplifnow ==1]) > 0)
        {
            points(kb[amplifnow ==1], obs[amplifnow ==1], col="grey30")
        }

    } 

}
human.chrom.info.Jul03 <- 
    structure(list(chrom = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 
                   13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24),
                   length = c(246128, 243616, 199344, 191732, 181035,
                   170915, 158546, 146309, 136372, 135037, 134483,
                   132078, 113043, 105311, 100257, 90042, 81860,
                   76115, 63812, 63742, 46976, 49397, 153692, 50287),
                   centromere = c(130772, 93582, 92435, 50804, 47175,
                   60418, 58878, 45443, 52508, 39926, 52264, 34881,
                   17000, 18000, 20000, 41001, 23668, 15631, 28712, 
                   28334, 14000, 15000, 59139, 11473)),
              .Names = c("chrom", "length", "centromere"),
              class = "data.frame",
              row.names = c("1", "2", "3", "4", "5", "6", "7", "8",
              "9", "10", "11", "12", "13", "14", "15", "16", "17",
              "18", "19", "20", "21", "22", "23", "24"))
plotvalGenome.func <-
    function(aCGH.obj, response = as.factor(rep("All", ncol(aCGH.obj))),
             chrominfo = human.chrom.info.Jul03, cutoff=1,
             lowCol = "red", highCol = "green", midCol = "black",
             ncolors = 50, byclass = FALSE, showaber = FALSE, amplif = 1,
             homdel = -0.75, samplenames = sample.names(aCGH.obj),
             vecchrom = 1:23, titles = "Image Plot", methodS = "ward",
             dendPlot = TRUE, imp = TRUE, categoricalPheno = TRUE)
{
    if (categoricalPheno)
    {
        resp0 <- response
        resp0.num <- as.numeric(as.factor(resp0))
        resp <- as.numeric(as.factor(resp0))
        if (!(byclass))
        {
            resp <- rep(1, length(resp0))
        }

        tbl.resp <- table(resp)
        label.col <- rainbow(length(unique(resp)))
    } 
    else
    {
	byclass <- FALSE
	resp0 <- response
    	resp0.num <- resp0 
    	
	resp <- rep(1, length(resp0))
    

    	tbl.resp <- table(resp)
    ##label.col <- c("red", "green", "blue", "skyblue", "orange", "pink", "gray20")
    	label.col <- rainbow(length(unique(resp)))
    }

    #par(bg="grey20")
    
    datainfo <- clones.info(aCGH.obj)
    if (imp)
    {
    	data <- log2.ratios.imputed(aCGH.obj)
    }
    else
    {
	data <- log2.ratios(aCGH.obj)
    }
    indUse <- NA
    chromb <- 0
    for (i in 1:length(vecchrom))
    {
	indUse <- c(indUse, which(datainfo$Chrom == vecchrom[i]))
        chromb <- c(chromb, length(which(datainfo$Chrom == vecchrom[i])))
        
    }
    indUse <- indUse[-1]
    chromb <- cumsum(chromb)   

    datainfo <- datainfo[indUse,]
    data <- data[indUse,]	
    kb <- datainfo$kb
    data <- as.matrix(data)

    if (dendPlot)
    {
	ind.pres <- which(!is.na(response))
	cr <- dist(t( data[, ind.pres]))
        hcl <- hclust(cr, method=methodS)
    }

    dt.cp <- data
    dt <- apply(data, 2,floor.func, cutoff)    
    

    dt <- dt[,order(resp)]
    dt.cp <- dt.cp[,order(resp)]

    resp0 <- resp0[order(resp)]
    resp0.num <- resp0.num[order(resp)]

    samplenames <- samplenames[order(resp)]
    resp <- resp[order(resp)]


    start <- 1
    ##mapping order
    ord <- rep(0, length(resp))
    for (i in 1:(length(tbl.resp)))
    {
	
	ind <- which(resp == i)
	#cr <- as.dist(1-cor.na(data[,ind]))
        cr <- dist(t(data[,ind]))
	ord[start:sum(tbl.resp[1:i])] <- hclust(cr, method=methodS)$ord+start-1
	start <- sum(tbl.resp[1:i])+1
	
	
	
    }
    dt <- dt[,ord]
    dt.cp <- dt.cp[,ord]

    resp <- resp[ord]
    resp0 <- resp0[ord]
    resp0.num <- resp0.num[ord]
    samplenames <- samplenames[ord]
    image(x=(1:length(kb)), y=1:length(resp), z=dt, col =
          maPalette(low = lowCol, high = highCol, mid = midCol
                    ,k=ncolors), axes = FALSE, xlab = "", ylab = "",
          zlim=c(-cutoff,cutoff))
    
    ##abline(h=seq(.5, 81.5, b=1), col="gray20", lwd=.2)

    if (showaber)
    {
        ##for (i in 1:nrow(dt))
        ##{
        for (j in 1:ncol(dt))
        {
            
            tmp <- dt.cp[,j]
            i <- (1:length(tmp))[tmp >= amplif & !is.na(tmp)]
            if (length(i) > 0)
                ##if ((!is.na(dt.cp)) && (dt.cp[i,j] >= amplif))
            {
                points(i, rep(j, length(i)), col="yellow", pch=20, cex=.7)
            }
            i <- (1:length(tmp))[tmp <= homdel & !is.na(tmp)]
            if (length(i) > 0)
                ##if ((!is.na(dt.cp)) && (dt.cp[i,j] >= amplif))
            {
                points(i, rep(j, length(i)), col="skyblue", pch=20, cex=.7)
            }
            
        }
        ##}
    }
    for (j in 1:ncol(dt))
    {
	mtext((resp0)[j], side = 2, at = j, line=.3, col=label.col[((resp0.num)[j])], cex=.5, las=2)
	mtext(paste((samplenames)[j], ""), side = 4, at = j, line=.3, col=label.col[((resp0.num)[j])], cex=.3, las=2)
	
    }
    ##title(main="Whole genome", xlab = "clone", ylab = "sample", col.lab="white", col.main="white")
    title(xlab = "clone", ylab = "sample", main=titles)
    ##abline(v=centrloc, col="white", lty=2, lwd=.5)
    
    abline(v=chromb, col="white", lty=1, lwd=1)
    loc <- chromb[-1]-diff(chromb)/2
    if (length(vecchrom) > 1)
    {
    for (i in seq(2,length(vecchrom),b=2))
    {
        
        mtext(paste("", vecchrom[i]), side = 3, at = (loc[i]), line=.3,cex.main=.5)
    }
    }
    for (i in seq(1,length(vecchrom),b=2))
    {
        
        mtext(paste("", vecchrom[i]), side = 1, at = (loc[i]), line=.3, cex.main=.5)
    }

    ##mtext("X", side = 1, at = (loc[nrow(chrominfo)]), line=.3,col="white", cex.main=.5)


  if (dendPlot)
  {
	if (length(unique(resp0)) > 1)
	{
	   plot(hcl, labels=response[ind.pres], main="Dendogram")
	}
	else
	{
	  plot(hcl, labels=(sample.names(aCGH.obj))[ind.pres], main="Dendogram")
	}		
  }
}
