#' 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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.