R/bin.color.R

In ajabadi/mixOmics2: Omics Data Integration Project

################################################################################
# Authors:
#   Ignacio Gonzalez, Genopole Toulouse Midi-Pyrenees, France
#
# created: 2009
# last modified:
#
# Copyright (C) 2009
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
################################################################################

bin.color =
function(mat, cutoff, breaks, col, symkey) 
{
    if (isTRUE(symkey)) {
        max.mat = max(abs(mat))
        min.mat = -max.mat
    }
    else {
        max.mat = max(mat)
        min.mat = min(mat)
    }
    
    if (missing(breaks) || is.null(breaks)) {
        if (is(col,"function")) breaks = 32
        else breaks = length(col)
    }
    
    if (length(breaks) == 1) {
        if (isTRUE(symkey)) {
            if ((breaks/2) - trunc(breaks/2) != 0)
            stop("'breaks' must be a even number if 'symkey = TRUE'",
            call. = FALSE)
            
            if (cutoff == 0) {
                breaks = c(seq(min.mat, max.mat, length = breaks + 1))
            } else {
                nb = breaks/2
                breaks = c(seq(min.mat, -cutoff, length = nb + 1), 0,
                seq(cutoff, max.mat, length = nb + 1))
                id = which(breaks == 0)
                breaks = breaks[-c(id - 1, id + 1)]
            }
        } else {
            breaks = breaks + 1
            
            if ((min.mat < -cutoff) & (max.mat < cutoff))
            breaks = seq(min.mat, -cutoff, length = breaks)
            
            if ((min.mat > -cutoff) & (max.mat > cutoff))
            breaks = seq(cutoff, max.mat, length = breaks)
            
            if ((min.mat < -cutoff) & (max.mat > cutoff)) {
                if (cutoff == 0){
                    breaks = c(seq(min.mat, max.mat, length = breaks))
                } else {
                    long = max.mat - min.mat - 2*cutoff
                    bin = long/breaks
                    breaks = seq(cutoff, -min.mat, by = bin)
                    o = order(breaks, decreasing = TRUE)
                    breaks = c(-breaks[o], 0, seq(cutoff, max.mat, by = bin))
                    id = which(breaks == 0)
                    breaks = breaks[-c(id - 1, id + 1)]
                }
            }
        }
    }
    
    ncol = length(breaks) - 1
    
    if (is(col, "function"))
    col = col(ncol)
    
    if (length(breaks) != length(col) + 1)
    stop("must have one more break than colour", call. = FALSE)
    
    min.breaks = min(breaks)
    max.breaks = max(breaks)
    
    mat[mat < min.breaks] = min.breaks
    mat[mat > max.breaks] = max.breaks
    
    bin = .bincode(as.double(mat), as.double(breaks), TRUE, TRUE)

    return(invisible(list(bin = bin, col = col, breaks = breaks, lim =
    c(min.mat, max.mat))))
}