R/clustering.mode.R

In kridsadakorn/ipcaps.bioc: Iterative Pruning to Capture Population Structure

#' (Internal function) Select a clustering method to be used for the ipcaps
#' process.
#'
#' @param node An integer representing the current node number which is being
#' analyzed.
#' @param work.dir A working directory.
#' @param method A clustering method selected from the \code{\link{ipcaps}}
#' function. See \code{\link{ipcaps}} for available methods.
#' @param silence.mode To enable or disable silence mode. If silence mode is
#' enabled, the fuction is processed without printing any message on the screen,
#' and it is slightly faster. Default = TRUE.
#' @param seed To specify a seed number for random generator. Default = NA,
#' which means that a seed number is automatically chose.
#'
#' @return A vector of cluster assignment, for which cluster each individual
#' belongs.
#'
#' @import stats
#' @import fpc
#' @import LPCM
#' @importFrom apcluster apcluster negDistMat
#' @importFrom Rmixmod mixmodCluster mixmodPredict mixmodStrategy
#' @import KRIS
#'
#' @seealso \code{\link{ipcaps}}

clustering.mode <-
    function(node,
            work.dir,
            method,
            silence.mode = FALSE,
            seed = NULL)
    {
        start.time <- Sys.time()

        if (!silence.mode)
            cat(paste0("Node ", node, ": Start clustering\n"))

        PCs <- NULL
        no.significant.PC <- NULL

        # load experiment condition
        file.name <-
            file.path(work.dir, "RData", paste0("node", node, ".RData"))
        if (!silence.mode)
            cat(paste0("Node ", node, ": Loading ", file.name, "\n"))
        load(file = file.name)

        if (method == "clara")
        {
            cl <- pamk(PCs, krange = 2:2, usepam = FALSE)
            cluster <- cl$pamobject$clustering
        } else if (method == "pam")
        {
            cl <- pamk(PCs, krange = 2:2, usepam = TRUE)
            cluster <- cl$pamobject$clustering
        } else if (method == "mixmod")
        {
            subPCs <- as.data.frame(PCs[, seq(1, no.significant.PC)])
            mixmodStrategy(seed = seed)
            mmc <- mixmodCluster(
                data = subPCs,
                nbCluster = seq(1, 3),
                criterion = c("BIC", "ICL", "NEC"),
                models = NULL
            )
            pmm <-
                mixmodPredict(data = subPCs,
                            classificationRule = mmc["bestResult"])
            cluster <- pmm["partition"]
        } else if (method == "meanshift")
        {
            subPCs <- as.data.frame(PCs[, seq(1, no.significant.PC)])
            fit <- ms(subPCs, h = 0.095, plot = 0)
            cluster <- fit$cluster.label
        } else if (method == "apcluster")
        {
            subPCs <- as.data.frame(PCs[, seq(1, no.significant.PC)])
            ap1 <- apcluster(negDistMat(r = 5), subPCs, q = 0.001)
            # ap2 <- aggExCluster(x=ap1)
            cluster <- rep(0, dim(subPCs)[1])
            no.cluster <- length(ap1)
            for (i in seq(1, no.cluster))
            {
                cluster[ap1@clusters[[i]]] <- i
            }
        } else if (method == "hclust")
        {
            dis <- dist(PCs)
            hc <- hclust(dis, method = "complete")
            cluster <- cutree(hc, k = 2)
        } else if (method == "rubikclust")
        {
            cluster <- rubikclust(PCs[, seq(1, 3)], min.space = 0.15)
        } else
        {
            # default Mixed clustering methods
            cluster <- rubikclust(PCs[, seq(1, 3)])
            if (length(unique(cluster)) == 1)
            {
                # swith to mixmod
                subPCs <- as.data.frame(PCs[, seq(1, no.significant.PC)])
                mmc <- mixmodCluster(
                    data = subPCs,
                    nbCluster = seq(1, 3),
                    criterion = c("BIC", "ICL", "NEC"),
                    models = NULL
                )
                pmm <- mixmodPredict(data = subPCs,
                                    classificationRule = mmc["bestResult"])
                cluster <- pmm["partition"]
            }
        }

        end.time <- Sys.time()
        if (!silence.mode)
            cat(paste0("Node ", node, ": done for clustering\n"))
        if (!silence.mode)
            cat(paste0("Node ", node, ": processed in ",
                    format(end.time - start.time)))
        return(cluster)

    }