R/plotLong.R

In abodein/timeOmics_BioC: Time-Course Multi-Omics data integration

#' Plot Longitudinal Profiles by Cluster
#'
#' This function provides a expression profile representation over time and by cluster.
#'
#' @param object a mixOmics result of class (s)pca, (s)pls, block.(s)pls.
#' @param time (optional) a numeric vector, the same size as \code{ncol(X)}, to change the time scale.
#' @param plot a logical, if TRUE then  a plot is produced. Otherwise, the data.frame on which the plot is based on is returned.
#' @param center a logical value indicating whether the variables should be shifted to be zero centered. 
#' @param scale a logical value indicating whether the variables should be scaled to have unit variance before the analysis takes place. 
#' @param title character indicating the title plot.
#' @param X.label x axis titles.
#' @param Y.label y axis titles.
#' @param legend a logical, to display or not the legend.
#' @param legend.title if \code{legend} is provided, title of the legend.
#' @param legend.block.name a character vector corresponding to the size of the number of blocks in the mixOmics object. 
#' 
#'
#' @return
#' a data.frame (gathered form) containing the following columns:
#' \item{time}{x axis values}
#' \item{molecule}{names of features}
#' \item{value}{y axis values}
#' \item{cluster}{assigned clusters}
#' \item{block}{name of 'blocks'}
#' 
#' @seealso 
#' \code{\link[timeOmics]{getCluster}}
#'
#' @examples
#' demo <- suppressWarnings(get_demo_cluster())
#' X <- demo$X
#' Y <- demo$Y
#' Z <- demo$Z
#' 
#' # (s)pca
#' pca.res <- mixOmics::pca(X, ncomp = 3)
#' plotLong(pca.res)
#' spca.res <- mixOmics::spca(X, ncomp =2, keepX = c(15, 10))
#' plotLong(spca.res)
#' 
#' # (s)pls
#' pls.res <- mixOmics::pls(X,Y)
#' plotLong(pls.res)
#' spls.res <- mixOmics::spls(X,Y, keepX = c(15,10), keepY=c(5,6))
#' plotLong(spls.res)
#' 
#' # (s)block.spls
#' block.pls.res <- mixOmics::block.pls(X=list(X=X,Z=Z), Y=Y)
#' plotLong(block.pls.res)
#' block.spls.res <- mixOmics::block.spls(X=list(X=X,Z=Z), Y=Y, 
#'                              keepX = list(X = c(15,10), Z = c(5,6)), 
#'                              keepY = c(3,6))
#' plotLong(block.spls.res)
#' 
#'
#' @import ggplot2
#' @import mixOmics
#' @importFrom tibble rownames_to_column
#' @importFrom dplyr mutate select left_join
#' @importFrom tidyr pivot_longer
#' @export
plotLong <- function(object, time = NULL, plot = TRUE, center = TRUE, scale = TRUE, 
                     title="Time-course Expression", X.label=NULL, Y.label=NULL, 
                     legend=FALSE, legend.title=NULL, legend.block.name = NULL)
{
    
    # Check parameters
    #-- object
    allowed_object = c("pca", "spca", "mixo_pls", "mixo_spls", "block.pls", "block.spls")
    if(!any(class(object) %in% allowed_object)){
        stop("invalid object, should be one of c(pca, spca, mixo_pls, mixo_spls, block.pls, block.spls)")
    }
    
    #-- plot : if plot is not correct, plot = FALSE
    if(is.null(plot)) plot = FALSE
    if(!is.finite(plot) || !is.logical(plot)){plot = FALSE}
    
    #-- center
    if(is.null(center)) center = TRUE
    if(!is.finite(center) || !is.logical(center)){center = TRUE}
    
    #-- scale
    if(is.null(scale)) scale = TRUE
    if(!is.finite(scale) || !is.logical(scale)){scale = TRUE}
    
    # graphical options
    #-- title
    if(!is.character(title)){title = NULL}
    
    #-- X.label
    if(!is.character(X.label)){X.label = NULL}
    
    #-- Y.label
    if(!is.character(Y.label)){Y.label = NULL}
    
    #-- legend
    if(is.null(legend)) legend = FALSE
    if(!is.finite(legend) || !is.logical(legend)){legend = FALSE}
    
    #-- legend title
    if(!is.character(legend.title)){legend.title = NULL}
    
    # cluster info
    cluster <- getCluster(object)
    
    #-- legend.block.name
    if(!is.null(legend.block.name)){
        check_legend.block.name(legend.block.name, cluster)
        new.block.name.tmp <- list(new.block = legend.block.name, block = unique(cluster$block)) %>%
            as.data.frame
        cluster <- cluster %>% left_join(new.block.name.tmp, by = c("block"="block")) %>%
            mutate(old.block = block, block = new.block) %>% 
            dplyr::select(-new.block)
    }
    
    if(is(object, "pca") || is(object, "spca")){
        #-- check time
        if(!is.null(time) && (!is_almostInteger_vector(time) || (length(time) != nrow(object$X)))){
            stop("'time' should be a numeric vector")
        }
        # scale/unscale if desired
        data <- unscale(object$X) %>%
            as.data.frame() %>%
            dplyr::select(intersect(cluster$molecule, colnames(.))) %>%
            scale(scale, center)
        
        
    } else if(is(object, "mixo_pls") || is(object, "mixo_spls")){
        #-- check time
        if(!is.null(time) && (!is_almostInteger_vector(time) || (length(time) != nrow(object$X)))){
            stop("'time' should be a numeric vector")
        }
        data.X <- unscale(object$X) %>%
            scale(scale, center)
        data.Y <- unscale(object$Y) %>%
            scale(scale, center)
        
        data <- cbind(data.X, data.Y) %>%
            as.data.frame() %>%
            dplyr::select(intersect(cluster$molecule, colnames(.)))
        
    } else if(is(object, "block.pls") || is(object, "block.spls")){
        #-- check time
        if(!is.null(time) &&(!is_almostInteger_vector(time) || (length(time) != nrow(object$X[[1]])))){
            stop("'time' should be a numeric vector")
        }
        
        data <- lapply(object$X, function(i){unscale(i) %>%
                scale(scale, center)}) %>% 
            do.call(what = "cbind")

        data <- as.data.frame(data) %>% 
            dplyr::select(intersect(cluster$molecule, colnames(.)))
    }
    
    # plot
    if(!is.null(time)){
        rownames(data) <- time   
    }
    data.gather <- data %>%
        as.data.frame() %>% 
        tibble::rownames_to_column("time") %>%
        dplyr::mutate(time = as.numeric(.$time)) %>%
        tidyr::pivot_longer(names_to = "molecule", values_to = "value", -time) %>%
        dplyr::left_join(cluster, by = c("molecule"="molecule")) %>%
        dplyr::mutate(block = factor(block))
    
    gg <- ggplot(data.gather, aes(x = time, y = value, group = molecule)) +
        geom_line(aes(color = block)) +
        facet_grid(contribution ~ comp, scales = "free") +
        scale_color_manual(values = mixOmics::color.mixo(1:length(levels(data.gather$block)))) +
        theme_bw() 
    
    if(is.character(title)){
        gg <- gg + ggtitle(title)
    }
    
    if(!is.null(X.label)){
        gg <- gg + xlab(X.label)
    } else {
        gg <- gg + xlab("Time")
    }
    
    if(!is.null(Y.label)){
        gg <- gg + ylab(Y.label)
    } else {
        gg <- gg + ylab("Expression")
    }
    
    if(!legend){
        gg <- gg + theme(legend.position = "none")
    } else { # legend is TRUE
        if(!is.null(legend.title)){
            gg <- gg + labs(color = legend.title)
        }
    }
    
    if(plot){
        print(gg)
    }
    return(invisible(gg$data))
}