R/outMap.R

In OGSA: Outlier Gene Set Analysis

#'outMap
#'
#'Creates PDF color map of where outliers occur coded for molecular type
#'@usage outMap (outList, geneList, hmName = 'PatSpecMap.pdf', plotName =
#' 'Outliers', truncGene = FALSE, clust=FALSE)
#'@param outList List with all outliers generated by outCallRank or outCallTib
#'@param geneList Gene set to compare against
#'@param hmName Name for PDF output file
#'@param plotName Header for plot
#'@param truncGene if TRUE, only include genes that have outlier in the plot, 
#'default is all genes in gene set
#'@param clust If TRUE, clusters data and produces dendrograms
#'@import gplots
#'@return A matrix used for generating heatmap
#'@examples
#'
#' data(ExampleData)
#' data('KEGG_BC_GS')
#' 
#' # Set up Phenotype
#' phenotype <- pheno  
#' names(phenotype) <- colnames(cnv)
#' 
#' #set up datalist
#' dataSet <- list(expr,meth,cnv)
#' 
#' # set up values for expr-meth-cnv in that order
#' tailLRL <- c('left', 'right', 'left')  
#' 
#' outTibLRL <- outCallTib(dataSet, phenotype=pheno, 
#'                          names=c('Expr', 'Meth', 'CNV'), tail=tailLRL)
#' 
#' # put in your pathways here
#' pdgfB <- pathGS$'BIOCARTA_PDGF_PATHWAY'
#' outMap(outTibLRL, pdgfB, hmName='BC_PDGF_TIB.pdf', plotName='PDGF
#' Outlier T-H LRL Calls')
#' 
#'@references Ochs, M. F., Farrar, J. E., Considine, M., Wei, Y., Meshinchi, S.,
#' & Arceci, R. J. (n.d.). Outlier Analysis and Top Scoring Pair for Integrated 
#' Data Analysis and Biomarker Discovery. IEEE/ACM Transactions on Computational
#'  Biology and Bioinformatics, 1-1. doi:10.1109/tcbb.2013.153
#'@export

outMap <- function(outList, geneList, hmName = 'PatSpecMap.pdf', 
                   plotName = 'Outliers', truncGene = FALSE, clust=FALSE) {

    bits <- c(1, 2, 4, 8, 16, 32, 64) # max data types = 7
    colors <- c('black', 'red', 'green', 'yellow', 'blue', 'purple',
                    'cyan', 'white')

    nType <- length(outList)
    temp <- outList[[1]]
    nTum <- dim(temp)[2]
    patNames <- colnames(temp)
    geneNames <- rownames(temp) %in% geneList
    geneNames <- rownames(temp)[geneNames]
    nGene <- length(geneNames)
    nGenePlot <- nGene

    tMap <- matrix(nrow=nTum+2, ncol=nGene)
    tMap[, ] <- 0
    
    for (i in 1:length(outList)) {
        temp <- outList[[i]]
        temp2 <- rownames(temp) %in% geneList
        temp <- t(temp[temp2, ])
        temp <- bits[i] * temp
        tMap[1:nTum, ] <- tMap[1:nTum, ] + temp
    }


    colnames(tMap) <- geneNames
    rownames(tMap) <- c(patNames, "", "Range")

    nAffect <- sum(rowSums(tMap) > 0)
    nGeneOut <- sum(colSums(tMap) > 0)
    
    if (truncGene) {
        keep <- colSums(tMap) > 0
        tMap <- tMap[, keep]
        nGenePlot <- nGeneOut
    }
    
    nStep <- floor(nGenePlot / 7)
    for (i in 1:7) {
        n1 <- ((i - 1) * nStep) +1
        n2 <- i * nStep
        tMap[nTum + 2, n1:n2] <- i
    }
    

    yLabel <- paste(nAffect, 'Patients with Outlier from', nTum, 'Total')
    xLabel <- paste(nGeneOut, 'Genes with Outlier from', nGene, 'Total') 


    xLab <- min(30.0 / nGenePlot, 1)
    yLab <- min(30.0 / nTum, 1)
    
    colRange = c(0, 2 ^ nType - 1)
    
    pdf(hmName)
    if (clust==FALSE) {
        heatmap.2(tMap, scale='none', Rowv=NA, Colv=NA, trace='none', 
              cexRow=yLab, cexCol=xLab, col=colors, 
              main=plotName, xlab=xLabel, ylab=yLabel, zlim=colRange, 
              dendrogram='none')
    } else {
        heatmap.2(tMap[1:nTum, ], scale='none', trace='none', 
        cexRow=yLab, cexCol=xLab, col=colors, 
        main=plotName, xlab=xLabel, ylab=yLabel, zlim=colRange)
    }
    dev.off()

    return(tMap)
}