mixOmics: Omics Data Integration Project

###############################################################################
# Authors:
#   Ignacio Gonzalez,
#   Francois Bartolo,
#   Kim-Anh Le Cao,
#
# created: 2009
# last modified: 2015
#
# 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.
################################################################################


# --------------------------------------------
# imageMap
# --------------------------------------------


imageMap <-
    function (mat,
              color,
              row.names,
              col.names,
              row.sideColors,
              col.sideColors,
              row.cex = NULL,
              col.cex = NULL,
              cluster,
              ddr,
              ddc,
              cut.tree = c(0, 0),
              transpose = FALSE,
              symkey = TRUE,
              keysize = c(1, 1),
              keysize.label,
              zoom = FALSE,
              title = NULL,
              xlab = NULL,
              ylab = NULL,
              margins = c(5, 5),
              lhei = NULL,
              lwid = NULL)
    {
        #-- image map -------------------------------------------------------------#
        #----------
        
        if (isTRUE(symkey)) {
            max.mat = max(abs(mat), na.rm = TRUE)
            min.mat = -max.mat
        }
        else {
            max.mat = max(mat, na.rm = TRUE)
            min.mat = min(mat, na.rm = TRUE)
        }
        
        if (isTRUE(transpose)) {
            mat = t(mat)
            
            temp = col.sideColors
            col.sideColors = row.sideColors
            row.sideColors = temp
            
            temp = col.names
            col.names = row.names
            row.names = temp
            
            if (cluster == "both")
            {temp = ddc
            ddc = ddr
            ddr = temp}
            else if (cluster == "column")
                ddr=ddc
            else if (cluster == "row")
                ddc=ddr
            
            lhei = NULL
            lwid = NULL
        }
        
        nr = nrow(mat)
        nc = ncol(mat)
        
        #-- row.cex and col.cex
        if (is.null(row.cex)) row.cex = min(1, 0.2 + 1/log10(nr))
        if (is.null(col.cex)) col.cex = min(1, 0.2 + 1/log10(nc))
        
        #-- breaks
        breaks = length(color) + 1
        breaks = seq(min.mat, max.mat, length = breaks)
        
        nbr = length(breaks)
        ncol = nbr - 1
        
        min.breaks = min(breaks)
        max.breaks = max(breaks)
        mat[mat < min.breaks] = min.breaks
        mat[mat > max.breaks] = max.breaks
        mat = t(mat)
        #-- layout matrix
        lmat = matrix(c(1, 2, 3, 4), 2, 2, byrow = TRUE)
        csc = rsc = FALSE
        
        if (!is.null(col.sideColors)) {
            lmat = rbind(lmat[1, ], c(NA, 3), lmat[2, ] + 1)
            n.csc = ncol(col.sideColors)
            if (is.null(lhei)) {
                lhei = c(keysize[2], 0.15 + 0.1 * (n.csc - 1), 4)
            }
            csc = TRUE
        }
        
        if (!is.null(row.sideColors)) {
            lmat = cbind(lmat[, 1], c(rep(NA, nrow(lmat) - 1), nrow(lmat) + 2),
                         lmat[, 2] + c(rep(0, nrow(lmat) - 1), 1))
            if (is.null(lwid)) {
                n.rsc = ncol(row.sideColors)
                lwid = c(keysize[2], 0.15 + 0.1 * (n.rsc - 1), 4)
            }
            rsc = TRUE
        }
        
        lmat[is.na(lmat)] = 0
        
        if (is.null(lhei))
            lhei = c(keysize[2], 4)
        
        if (is.null(lwid))
            lwid = c(keysize[1], 4)
        
        if (isTRUE(zoom)) {
            graphics.off()
            dev.new(pos=-1)#x11(xpos = -1)
        }
        
        op = par(no.readonly = TRUE)
        on.exit(par(op))
        layout(lmat, widths = lwid, heights = lhei, respect = FALSE)
        
        #-- layout 1 --#
        par(mar = c(5, 2, 2, 1), cex = 0.75)
        
        z = seq(0, 1, length = length(color))
        z = matrix(z, ncol = 1)
        image(z, col = color, xaxt = "n", yaxt = "n")
        box()
        par(usr = c(0, 1, 0, 1))
        lv = c(min.breaks, (3*min.breaks + max.breaks)/4,
               (min.breaks + max.breaks)/2,
               (3*max.breaks + min.breaks)/4, max.breaks)
        xv = (as.numeric(lv) - min.mat) / (max.mat - min.mat)
        axis(1, at = xv, labels = round(lv, 2), cex.axis = keysize.label)
        title("Color key", font.main = 1, cex.main = keysize.label)
        
        #-- layout 2 --#
        par(mar = c(ifelse(cut.tree[2] != 0, 0.5, 0), 0,
                    ifelse(!is.null(title), 5, 0), margins[2]))
        if ((cluster == "both") || (!transpose && cluster == "column") ||
            (transpose && cluster == "row" )) {
            h = attr(ddc, "height")
            plot(ddc, axes = FALSE, xaxs = "i", leaflab = "none",
                 ylim = c(cut.tree[2] * h, h))
        }
        else {
            plot(0, 0, axes = FALSE, type = "n", xlab = "", ylab = "")
        }
        
        if (!is.null(title))
            title(title, cex.main = 1.5 * op[["cex.main"]])
        
        #-- layout 3 --#
        if (isTRUE(csc)) {
            par(mar = c(0.5, 0, 0, margins[2]))
            sideColors = as.vector(col.sideColors)
            img = matrix(c(1:(n.csc * nc)), ncol = n.csc, byrow = FALSE)
            
            image(1:nc, 1:n.csc, img, col = sideColors, axes = FALSE, xlab = "",
                  ylab = "")
            abline(h = 1:(n.csc - 1) + 0.5, lwd = 2,
                   col = ifelse(par("bg") == "transparent", "white", par("bg")))
        }
        
        #-- layout 4 --#
        par(mar = c(margins[1], 0, 0, ifelse(cut.tree[1] != 0, 0.5, 0)))
        if ((cluster == "both") || (cluster == "row" & !transpose) ||
            (cluster == "column" & transpose)) {
            h = attr(ddr, "height")
            plot(ddr, horiz = TRUE, axes = FALSE, yaxs = "i", leaflab = "none",
                 xlim = c(h, cut.tree[1] * h))
        }
        else {
            plot(0, 0, axes = FALSE, type = "n", xlab = "", ylab = "")
        }
        
        #-- layout 5 --#
        if (isTRUE(rsc)) {
            par(mar = c(margins[1], 0, 0, 0.5))
            n.rsc = ncol(row.sideColors)
            r.sideColors = row.sideColors[, n.rsc:1]
            sideColors = as.vector(r.sideColors)
            img = matrix(1:(n.rsc * nr), nrow = n.rsc, byrow = TRUE)
            
            image(1:n.rsc, 1:nr, img, col = sideColors, axes = FALSE, xlab = "",
                  ylab = "")
            abline(v = 1:(n.rsc - 1) + 0.5, lwd = 2,
                   col = ifelse(par("bg") == "transparent", "white", par("bg")))
        }
        
        #-- layout 6 --#
        par(mar = c(margins[1], 0, 0, margins[2]))
        image(1:nc, 1:nr, mat, xlim = 0.5 + c(0, nc), ylim = 0.5 +
                  c(0, nr), axes = FALSE, xlab = "", ylab = "", col = color,
              breaks = breaks)
        axis(1, 1:nc, labels = col.names, las = 2, line = -0.5, tick = 0,
             cex.axis = col.cex)
        
        if (!is.null(xlab))
            mtext(xlab, side = 1, line = margins[1] - 1.25)
        
        axis(4, 1:nr, labels = row.names, las = 2, line = -0.5, tick = 0,
             cex.axis = row.cex)
        
        if (!is.null(ylab))
            mtext(ylab, side = 4, line = margins[2] - 1.25)
        
        #-- ZOOM --#
        #----------#
        flag1 = flag2 = FALSE
        
        if (isTRUE(zoom)) {
            nD = dev.cur()
            zone = FALSE
            
            repeat {
                dev.set(nD)
                
                repeat {
                    loc = locator(1, type = "n")
                    
                    if (is.null(loc) & zone == TRUE) break
                    if (is.null(loc) & !isTRUE(flag1)) break
                    flag1 = TRUE
                    
                    x1 = round(loc[[1]] - 0.5) + 0.5
                    y1 = round(loc[[2]] - 0.5) + 0.5
                    
                    if (!(x1 < 0 | x1 > nc + 0.5 | y1 < 0 | y1 > nr + 0.5)) break
                }
                
                if (is.null(loc) & zone == TRUE) break
                
                if (!is.null(loc) & zone == TRUE) {
                    rect(xleft.old, ybottom.old, xright.old, ytop.old,
                         border = "white")
                    points(x1.old, y1.old, type = "p", pch = 3,
                           cex = 2, col = "white")
                }
                
                if (is.null(loc) & zone == FALSE) {
                    break
                }
                else {
                    x1.old = x1
                    y1.old = y1
                    
                    points(x1, y1, type = "p", pch = 3, cex = 2)
                    
                    repeat {
                        loc = locator(1, type = "n")
                        
                        if (is.null(loc) & zone == TRUE) break
                        if (is.null(loc) & !isTRUE(flag2)) break
                        flag2 = TRUE
                        
                        x2 = round(loc[[1]] - 0.5) + 0.5
                        y2 = round(loc[[2]] - 0.5) + 0.5
                        
                        if (!(x2 < 0 | x2 > nc + 0.5 | y2 < 0 | y2 > nr + 0.5)) {
                            zone = TRUE; break }
                    }
                    
                    if (is.null(loc) & zone == TRUE) break
                    if (is.null(loc) & !isTRUE(flag2)) break
                    
                    xleft.old = min(x1, x2)
                    xright.old = max(x1, x2)
                    ybottom.old = min(y1, y2)
                    ytop.old = max(y1, y2)
                    
                    rect(xleft.old, ybottom.old, xright.old, ytop.old)
                }
                
                dev.new()#x11()
                plot.par = par(no.readonly = TRUE)
                
                if (isTRUE(zone)) {
                    xleft = xleft.old + 0.5
                    ybottom = ybottom.old + 0.5
                    xright = xright.old - 0.5
                    ytop = ytop.old - 0.5
                    nr.zoom = length(xleft:xright)
                    nc.zoom = length(ybottom:ytop)
                    mat.zoom = matrix(mat[xleft:xright, ybottom:ytop],
                                      nrow = nr.zoom, ncol = nc.zoom)
                    rlab.zoom = col.names[xleft:xright]
                    clab.zoom = row.names[ybottom:ytop]
                    r.cex = min(1.2, 0.2 + 1/log10(nr.zoom))
                    c.cex = min(1.2, 0.2 + 1/log10(nc.zoom))
                    
                    layout(lmat, widths = lwid, heights = lhei, respect = FALSE)
                    
                    # layout 1
                    par(mar = c(5, 2, 2, 1), cex = 0.75)
                    image(z, col = color, xaxt = "n", yaxt = "n")
                    box()
                    par(usr = c(0, 1, 0, 1))
                    lv = c(min.breaks, (3*min.breaks + max.breaks)/4,
                           (min.breaks + max.breaks)/2,
                           (3*max.breaks + min.breaks)/4, max.breaks)
                    xv = (as.numeric(lv) - min.mat) / (max.mat - min.mat)
                    axis(1, at = xv, labels = round(lv, 2))
                    title("Color key", font.main = 1)
                    
                    #-- layout 2 --#
                    par(mar = c(ifelse(cut.tree[2] != 0, 0.5, 0), 0,
                                ifelse(!is.null(title), 5, 0), margins[2]))
                    if ((cluster == "both") || (cluster == "column" & !transpose) ||
                        (cluster == "row" & transpose)) {
                        plot(ddc, axes = FALSE, xaxs = "i", leaflab = "none",
                             xlim = c(xleft - 0.5, xright + 0.5))
                    }
                    else {
                        plot(0, 0, axes = FALSE, type = "n", xlab = "", ylab = "")
                    }
                    
                    if (!is.null(title))
                        title(title, cex.main = 1.5 * op[["cex.main"]])
                    
                    # layout 3
                    if (isTRUE(csc)) {
                        par(mar = c(0.5, 0, 0, margins[2]))
                        sideColors = as.vector(col.sideColors[xleft:xright, ])
                        img = matrix(c(1:(n.csc * nr.zoom)), ncol = n.csc,
                                     byrow = FALSE)
                        
                        image(1:nr.zoom, 1:n.csc, img, col = sideColors,
                              axes = FALSE, xlab = "", ylab = "")
                        abline(h = 1:(n.csc - 1) + 0.5, lwd = 2,
                               col = ifelse(par("bg") == "transparent", "white",
                                            par("bg")))
                    }
                    
                    #-- layout 4 --#
                    par(mar = c(margins[1], 0, 0, ifelse(cut.tree[1] != 0, 0.5, 0)))
                    if ((cluster == "both") || (cluster == "row" & !transpose) ||
                        (cluster == "column" & transpose)) {
                        plot(ddr, horiz = TRUE, axes = FALSE, yaxs = "i",
                             leaflab = "none", ylim = c(ybottom - 0.5, ytop + 0.5))
                    }
                    else {
                        plot(0, 0, axes = FALSE, type = "n", xlab = "", ylab = "")
                    }
                    
                    # layout 5
                    if (isTRUE(rsc)) {
                        par(mar = c(margins[1], 0, 0, 0.5))
                        r.sideColors = row.sideColors[ybottom:ytop, n.rsc:1]
                        sideColors = as.vector(r.sideColors)
                        img = matrix(1:(n.rsc * nc.zoom), nrow = n.rsc,
                                     byrow = TRUE)
                        
                        image(1:n.rsc, 1:nc.zoom, img, col = sideColors,
                              axes = FALSE, xlab = "", ylab = "")
                        abline(v = 1:(n.rsc - 1) + 0.5, lwd = 2,
                               col = ifelse(par("bg") == "transparent", "white",
                                            par("bg")))
                    }
                    
                    # layout 6
                    par(mar = c(margins[1], 0, 0, margins[2]))
                    image(1:nr.zoom, 1:nc.zoom, mat.zoom, col = color,
                          breaks = breaks, axes = FALSE, xlab = "", ylab = "")
                    
                    axis(1, 1:nr.zoom, labels = rlab.zoom, las = 2, 
                         line = -0.5, tick = 0, cex.axis = r.cex)
                    
                    if (!is.null(xlab)) 
                        mtext(xlab, side = 1, line = margins[1] - 1.25)
                    
                    axis(4, 1:nc.zoom, labels = clab.zoom, las = 2, 
                         line = -0.5, tick = 0, cex.axis = c.cex)
                    
                    if (!is.null(ylab)) 
                        mtext(ylab, side = 4, line = margins[2] - 1.25)
                }
                
                par(plot.par)
            }
        }  
        par(op)
    }