R/visualization.R

Defines functions plotPCoAPlotly plotPCAPlotly

Documented in plotPCAPlotly plotPCoAPlotly

#' Plot PCA
#'
#' @param df.input Input data object that contains
#' the data to be plotted. Required
#' @param condition.color.vec color vector. Required
#' @param condition.color.name color variable name. Required
#' @param condition.shape.vec shape vector. Required
#' @param condition.shape.name shape variable name. Required
#' @param columnTitle Title to be displayed at top of heatmap.
#' @param pc.a pc.1
#' @param pc.b pc.2
#' @importFrom plotly plot_ly
#' @importFrom shinyjs useShinyjs
#' @import webshot vegan devtools
#' @return the plot
#' @export
#' @examples
#' data('iris')
#' plotPCAPlotly(t(iris[,1:4]),
#' condition.color.vec = c(rep(1,100), rep(0,50)),
#' condition.shape.vec = c(rep(0,100), rep(1,50)))

plotPCAPlotly <- function(df.input,
    condition.color.vec, condition.color.name = "condition",
    condition.shape.vec=NULL, condition.shape.name = "condition",
    columnTitle = "Title", pc.a = "PC1", pc.b = "PC2"){

    # Test and fix the constant/zero row
    if (sum(rowSums(as.matrix(df.input)) == 0) > 0){
        df.input <- df.input[-which(rowSums(as.matrix(df.input)) == 0),]
    }

    # conduct PCA
    pca.tmp<- prcomp(t(df.input), scale = TRUE)
    tmp.df <- data.frame(pca.tmp$x)

    # add color variable
    tmp.df[[paste(condition.color.name)]] <- condition.color.vec
    # add shape variable
    if (!is.null(condition.shape.vec)) {
        tmp.df[[paste(condition.shape.name)]] <- condition.shape.vec
        p <- suppressWarnings(plot_ly(tmp.df,
        x = as.formula(paste("~", pc.a, sep = "")),
        y = as.formula(paste("~", pc.b, sep = "")),
        mode = "markers",
        color = as.formula(paste("~", 
            condition.color.name, sep = "")),
            symbol = as.formula(paste("~", 
            condition.shape.name, sep = "")),
            type = "scatter",
            text = rownames(tmp.df),
            marker = list(size = 10)))
    } else {
        p <- suppressWarnings(plot_ly(tmp.df,
            x = as.formula(paste("~", pc.a, sep = "")),
            y = as.formula(paste("~", pc.b, sep = "")),
            mode = "markers",
            color = as.formula(paste("~", 
            condition.color.name, sep = "")),
            type = "scatter",
            text = rownames(tmp.df),
            marker = list(size = 10)))        
    }
    return(p)
}

#' Plot PCoA
#'
#' @param physeq.input Input data object that contains
#' the data to be plotted. Required
#' @param method which distance metric
#' @param condition.color.vec color vector. Required
#' @param condition.color.name color variable name. Required
#' @param condition.shape.vec shape vector. Required
#' @param condition.shape.name shape variable name. Required
#' @param columnTitle Title to be displayed at top of heatmap.
#' @param pc.a pc.1
#' @param pc.b pc.2
#' @importFrom plotly plot_ly
#' @return the plot
#' @export
#' @examples
#' data_dir_test <- system.file("data", package = "PathoStat")
#' pstat_test <- loadPstat(indir=data_dir_test,
#' infileName="pstat_data_2_L1.rda")
#' plotPCoAPlotly(pstat_test, condition.color.vec = rbinom(33,1,0.5),
#' condition.shape.vec = rbinom(33,1,0.5))

plotPCoAPlotly <- function(physeq.input,
    condition.color.vec, condition.color.name = "condition",
    condition.shape.vec=NULL, condition.shape.name = "condition",
    method = "bray", columnTitle = "Title",
    pc.a = "Axis.1", pc.b = "Axis.2"){
    # conduct PCoA
    # wUniFrac or bray

    #test and fix the constant/zero row
    if (sum(rowSums(as.matrix(physeq.input@otu_table@.Data)) == 0) > 0){
        physeq.input@otu_table@.Data <-
        physeq.input@otu_table@.Data[-which(rowSums(
        as.matrix(physeq.input@otu_table@.Data)) == 0),]
    }

    if (method == "bray"){
        #First get otu_table and transpose it:
        dist.matrix <- t(data.frame(otu_table(physeq.input)))
        #Then use vegdist from vegan to generate a bray distance object:
        DistBC <- vegdist(dist.matrix, method = "bray")
        #DistBC = phyloseq::distance(physeq.input, method = method)
        ordBC = ordinate(physeq.input, method = "PCoA", distance = DistBC)
        tmp.df <- data.frame(ordBC$vectors)
    } else {
        DistUF = phyloseq::distance(physeq.input, method = method)
        ordUF = ordinate(physeq.input, method = "PCoA", distance = DistUF)
        tmp.df <- data.frame(ordUF$vectors)
    }

    # add color variable
    tmp.df[[paste(condition.color.name)]] <- condition.color.vec
    # add shape variable
    if (!is.null(condition.shape.vec)) {
        tmp.df[[paste(condition.shape.name)]] <- condition.shape.vec
        p <- suppressWarnings(plot_ly(tmp.df,
                    x = as.formula(paste("~", pc.a, sep = "")),
                    y = as.formula(paste("~", pc.b, sep = "")),
                    mode = "markers",
                    color = as.formula(paste("~", 
                    condition.color.name, sep = "")),
                    symbol = as.formula(paste("~", 
                    condition.shape.name, sep = "")),
                    type = "scatter",
                    text = rownames(tmp.df),
                    marker = list(size = 10)))
    } else {
        p <- suppressWarnings(plot_ly(tmp.df,
                    x = as.formula(paste("~", pc.a, sep = "")),
                    y = as.formula(paste("~", pc.b, sep = "")),
                    mode = "markers",
                    color = as.formula(paste("~", 
                    condition.color.name, sep = "")),
                    type = "scatter",
                    text = rownames(tmp.df),
                    marker = list(size = 10)))
    }
    return(p)
}

Try the PathoStat package in your browser

Any scripts or data that you put into this service are public.

PathoStat documentation built on Nov. 8, 2020, 5:28 p.m.