R/components-intclust.R

In rickhelmus/patRoon: Workflows for Mass-Spectrometry Based Non-Target Analysis

#' @include main.R
#' @include components-clust.R
NULL

#' Components based on clustered intensity profiles.
#'
#' This class is derived from \code{\link{componentsClust}} and is used to store hierarchical clustering information
#' from intensity profiles of feature groups.
#'
#' Objects from this class are generated by \code{\link{generateComponentsIntClust}}
#'
#' @slot clusterm Numeric matrix with normalized feature group intensities that was used for clustering.
#'
#' @param obj A \code{componentsIntClust} object.
#' @param col The colour used for plotting. Set to \code{NULL} for automatic colours.
#' @param \dots Further options passed to \code{\link{heatmap.2}} / \code{\link{heatmaply}} (\code{plotHeatMap}).
#'
#' @template components-altered-note
#'
#' @seealso \code{\link{componentsClust}} for other relevant methods and \code{\link{generateComponents}}
#'
#' @templateVar class componentsIntClust
#' @template class-hierarchy
#'
#' @export
componentsIntClust <- setClass("componentsIntClust",
                               slots = c(clusterm = "matrix"),
                               contains = "componentsClust")

#' @describeIn componentsIntClust draws a heatmap using the
#'   \code{\link{heatmap.2}} or \code{\link{heatmaply}} function.
#' @param interactive If \code{TRUE} an interactive heatmap will be drawn (with
#'   \code{\link{heatmaply}}).
#' @param margins,cexCol Passed to \code{\link{heatmap.2}}
#' @return \code{plotHeatMap} returns the same as \code{\link{heatmap.2}} or
#'   \code{\link{heatmaply}}.
#' @aliases plotHeatMap
#' @export
setMethod("plotHeatMap", "componentsIntClust", function(obj, interactive = FALSE, col = NULL,
                                                        margins = c(6, 2), cexCol = 1,  ...)
{
    verifyCompNotAltered(obj)
    
    ac <- checkmate::makeAssertCollection()
    checkmate::assertFlag(interactive, add = ac)
    checkmate::reportAssertions(ac)

    if (is.null(col))
        col <- colorRampPalette(c("blue", "yellow", "red"))(300)
    
    if (interactive)
        heatmaply::heatmaply(obj@clusterm, Colv = NA, distfun = function(d) dist(d, obj@properties$metric),
                             hclustfun = function(h) hclust(h, obj@properties$method),
                             scale = "none", colors = col, showticklabels = c(FALSE, FALSE), ...)
    else
        gplots::heatmap.2(obj@clusterm, Colv = NA, distfun = function(d) dist(d, obj@properties$metric),
                          hclustfun = function(h) hclust(h, obj@properties$method),
                          scale = "none", col = col, dendrogram = "row", ylab = "feature groups",
                          labRow = FALSE, margins = margins, cexCol = cexCol, ...)
})

#' @describeIn componentsIntClust makes a plot for all (normalized) intensity
#'   profiles of the feature groups within a given cluster.
#' @param index Numeric component/cluster index or component name.
#' @param pch,type,lty Passed to \code{\link{lines}}.
#' @param plotArgs,linesArgs A \code{list} with further arguments passed to \code{\link[base]{plot}} and
#'    \code{\link[graphics]{lines}}, respectively.
#' @export
setMethod("plotInt", "componentsIntClust", function(obj, index, pch = 20, type = "b", lty = 3, col = NULL,
                                                    plotArgs = NULL, linesArgs = NULL)
{
    verifyCompNotAltered(obj)
    
    checkmate::assert(
        checkmate::checkInt(index, lower = 1, upper = length(obj)),
        checkChoiceSilent(index, names(obj))
        , .var.name = "index")
    
    aapply(checkmate::assertList, . ~ plotArgs + linesArgs, null.ok = TRUE)
    
    if (is.character(index))
        index <- which(index == names(obj))
    
    plotm <- obj@clusterm[rownames(obj@clusterm) %in% rownames(obj@gInfo)[obj@cutClusters == index], , drop = FALSE]
    nsamp <- ncol(plotm)

    do.call(plot, c(list(x = c(0, nsamp), y = c(0, max(plotm)), type = "n", xlab = "", ylab = "normalized intensity",
                         xaxt = "n"), plotArgs))
    axis(1, seq_len(nsamp), colnames(plotm), las = 2)

    if (is.null(col))
        col <- colorRampPalette(RColorBrewer::brewer.pal(12, "Paired"))(length(plotm))
    px <- seq_len(nsamp)
    for (i in seq_len(nrow(plotm)))
        do.call(lines, c(list(x = px, y = plotm[i, ], pch = pch, type = type, lty = lty, col = col[i]),
                         linesArgs))

    invisible(NULL)
})

setMethod("plotIntHash", "componentsIntClust", function(obj, index, ...)
{
    if (is.character(index))
        index <- which(index == names(obj))
    plotm <- obj@clusterm[rownames(obj@clusterm) %in% rownames(obj@gInfo)[obj@cutClusters == index], , drop = FALSE]
    return(makeHash(plotm, ...))
})

#' Generate components based on intensity profiles
#'
#' Generates components based on intensity profiles of feature groups.
#'
#' @templateVar algo hierarchical clustering of intensity profiles
#' @templateVar do generate components
#' @templateVar generic generateComponents
#' @templateVar algoParam intclust
#' @template algo_generator
#'
#' @details Hierarchical clustering is performed on normalized (and optionally replicate averaged) intensity data and
#'   the resulting dendrogram is automatically cut with \code{\link{cutreeDynamicTree}}. The distance matrix is
#'   calculated with \code{\link{daisy}} and clustering is performed with
#'   \code{\link[fastcluster:hclust]{fastcluster::hclust}}. The clustering of the resulting components can be further
#'   visualized and modified using the methods defined for \code{\link{componentsIntClust}}.
#'
#' @param metric Distance metric used to calculate the distance matrix (passed to \code{\link{daisy}}).
#' @param normalized,average Passed to \code{\link[=as.data.table,featureGroups-method]{as.data.table}} to perform
#'   normalization and averaging of data.
#'
#' @templateVar noDots TRUE
#' @template compon_algo-args
#' @template compon_gen-clust
#' @template dynamictreecut
#'
#' @inheritParams generateComponents
#'
#' @return The components are stored in objects derived from \code{\link{componentsIntClust}}.
#'
#' @section Sets workflows: In a \link[=sets-workflow]{sets workflow} normalization of feature intensities occur per
#'   set.
#'
#' @references \insertRef{Scholle2018}{patRoon}
#'
#' @templateVar what generateComponentsIntClust
#' @template main-rd-method
#' @export
setMethod("generateComponentsIntClust", "featureGroups", function(fGroups, method = "complete", metric = "euclidean",
                                                                  normalized = TRUE, average = TRUE,
                                                                  maxTreeHeight = 1, deepSplit = TRUE,
                                                                  minModuleSize = 1)
{
    ac <- checkmate::makeAssertCollection()
    checkmate::assertClass(fGroups, "featureGroups", add = ac)
    checkmate::assertString(metric, add = ac)
    checkmate::assertString(method, add = ac)
    checkmate::assertFlag(normalized, add = ac)
    checkmate::assertFlag(average, add = ac)
    assertDynamicTreeCutArgs(maxTreeHeight, deepSplit, minModuleSize, ac)
    checkmate::reportAssertions(ac)

    properties <- list(metric = metric, average = average)
    gInfo <- groupInfo(fGroups)
    
    if (length(fGroups) == 0)
        return(componentsIntClust(clusterm = matrix(), distm = NULL, method = method, gInfo = gInfo,
                                  properties = properties, maxTreeHeight = maxTreeHeight, deepSplit = deepSplit,
                                  minModuleSize = minModuleSize, algorithm = "intclust"))
    
    anas <- if (average) replicateGroups(fGroups) else analyses(fGroups)
    if (length(anas) < 2)
        stop(paste("Need at least >= 2", if (average) "replicate groups" else "analyses"))

    cat("Obtaining feature quantities... ")
    gTable <- as.data.table(fGroups, average = average, normalized = normalized)
    clusterm <- as.matrix(gTable[, anas, with = FALSE])
    rownames(clusterm) <- names(fGroups)
    cat("Done!\n")

    cat("Calculating distance matrix... ")
    distm <- daisy(clusterm, metric)
    cat("Done!\n")

    return(componentsIntClust(clusterm = clusterm, distm = distm, method = method, gInfo = gInfo,
                              properties = properties, maxTreeHeight = maxTreeHeight,
                              deepSplit = deepSplit, minModuleSize = minModuleSize, algorithm = "intclust"))
})