do_heatmap: Creating heatmap of your data

In lucanard/stat_tools: statistical tools to analyse metabolomics and complex data

Creating heatmap of your data

Description

the fuction creates an heatmap starting from a standard table with sample, subjects, time and class columns as descriptors

Usage

do_heatmap(x, result = NULL, data.info = c("sample", "subject", "time", "class"), title = "", T0 = F, time0 = NULL, distmet = "euclidean", hclustmet = "ward.D2")

Arguments

x
result
data.info
title
T0
time0
distmet
hclustmet

Author(s)

Luca Narduzzi

Examples

##---- Should be DIRECTLY executable !! ----
##-- ==>  Define data, use random,
##--	or do  help(data=index)  for the standard data sets.

## The function is currently defined as
function (x, result = NULL, data.info = c("sample", "subject", 
    "time", "class"), title = "", T0 = F, time0 = NULL, distmet = "euclidean", 
    hclustmet = "ward.D2") 
{
    if (is.null(result) == F) {
        data_only <- x[, row.names(result)]
    }
    else {
        data_only <- x[, (length(data.info) + 1):(ncol(x))]
    }
    dati <- data.frame(x[, data.info], data_only)
    if (T0 == T) {
        dati <- zero.norm(dati, data.info = data.info, time0 = time0)
    }
    data_only <- dati[, (length(data.info) + 1):(ncol(dati))]
    row.names(data_only) <- dati[, 1]
    factors <- x[, data.info]
    CLASSES <- dati$class
    group1 <- as.numeric(as.factor(as.character(CLASSES)))
    color_scale1 <- c("blue", "yellow", "red", "green")
    CLASSES <- color_scale1[match(group1, as.numeric(as.factor(color_scale1)))]
    SUBJECT <- as.numeric(factors$subject)
    n <- max(unique(as.numeric(dati$subject)))
    qual_col_pals = brewer.pal.info[brewer.pal.info$category == 
        "qual", ]
    col_vector = unlist(mapply(brewer.pal, qual_col_pals$maxcolors, 
        rownames(qual_col_pals)))
    color_scale <- sample(col_vector, n)
    SUBJECT <- color_scale[match(SUBJECT, as.numeric(as.factor(color_scale)))]
    TIME <- as.numeric(as.factor(factors$time))
    n <- max(unique(as.numeric(as.factor(dati$time))))
    qual_col_pals = brewer.pal.info[brewer.pal.info$category == 
        "qual", ]
    col_vector = unlist(mapply(brewer.pal, qual_col_pals$maxcolors, 
        rownames(qual_col_pals)))
    color_scale <- sample(col_vector, n)
    TIME <- color_scale[match(TIME, as.numeric(as.factor(color_scale)))]
    distCor <- function(x) dist(x, method = distmet)
    hclustAvg <- function(x) hclust(x, method = hclustmet)
    scale_data <- scale(data_only, center = T, scale = T)
    scale_data[which(scale_data <= -3)] <- -3
    scale_data[which(scale_data >= 3)] <- 3
    myCols = cbind(CLASSES, TIME, SUBJECT)
    p <- heatmap.plus(t(as.matrix(scale_data)), hclustfun = hclustAvg, 
        distfun = distCor, scale = "none", Colv = T, Rowv = T, 
        col = colorpanel(n = nrow(scale_data), low = "blue", 
            mid = "black", high = "red"), labCol = colnames(t(data_only)), 
        labRow = row.names(t(data_only)), cexCol = 0.8, cexRow = 0.8, 
        margins = c(4, 8), ColSideColors = myCols, main = title)
    legend("topright", legend = unique(dati$class), col = unique(CLASSES), 
        lwd = 5, lty = 1, cex = 0.7, inset = c(0, 0))
  }

lucanard/stat_tools documentation built on Dec. 10, 2022, 2:47 a.m.