library(grDevices)
## Helper function
render_plot <- function(cxplot, textMessage) {
if (!is.null(cxplot)) {
tags$div(width = "100%",
align = "center",
style = "height: 400px;",
cxplot)
} else {
tags$div(width = "100%",
align = "center",
style = "height: 400px;",
HTML(rep("<br/>", 5)),
tags$p(style = "color:grey;", textMessage))
}
}
## Custom plot functions
profilePlot <- function(df, title, subtitle) {
## Need a NLP column for sizing
df$negLog10P = round(-log10(df[["P.Value"]]))
## Create Group factor column in df
df$Group = NA
df$Group <- ifelse(df[["P.Value"]] <= 0.01,
ifelse(df[["logFC"]] >= 0, "Increased", "Decreased"),
"No Change")
rnk = rank(df$Group, ties.method = "first")
rnk = rnk * -1
## Adding alpha to the colors
colors = c("deepskyblue4", "red3", "grey25")
colors[1] = paste(c("rgba(", paste(c(paste(col2rgb(colors[1], alpha = FALSE), collapse = ","), 0.5), collapse = ","), ")"), collapse = "")
colors[2] = paste(c("rgba(", paste(c(paste(col2rgb(colors[2], alpha = FALSE), collapse = ","), 0.5), collapse = ","), ")"), collapse = "")
colors[3] = paste(c("rgba(", paste(c(paste(col2rgb(colors[3], alpha = FALSE), collapse = ","), 0.5), collapse = ","), ")"), collapse = "")
## Create the canvasXpress df and var annotation
cx = data.frame(a = round(df[colnames(df) == "AveExpr"], digits = 2), b =
round(df[colnames(df) == "logFC"], digits = 2))
colnames(cx) = c("AveExpr", "logFC")
cx = cx[with(cx, order(rnk)), ]
va = data.frame(Group = df$Group, nLog10pVal = df$negLog10P)
va = va[with(va, order(rnk)), ]
rownames(va) = rownames(cx)
d = list(line = list(list(color = colors[1], width = 2, y = log2(1.5) * -1),
list(color = colors[2], width = 2, y = log2(1.5)),
list(color = colors[3], width = 2, y = 0)))
## CanvasXpress Plot
canvasXpress(
data = cx,
varAnnot = va,
decorations = d,
graphType = "Scatter2D",
colorBy = "Group",
colors = colors,
legendInside = TRUE,
legendPosition = "bottomRight",
showDecorations = TRUE,
showLoessFit = TRUE,
loessColor = "darkgoldenrod1",
sizeBy = "Group",
sizes = c(10, 10, 4, 10, 12, 14, 16, 18, 20, 22, 24, 26),
sizeByShowLegend = FALSE,
title = title,
subtitle = subtitle,
xAxis = list("AveExpr"),
yAxis = list("logFC"),
subtitleScaleFontFactor = 0.5,
showAnimation = FALSE,
width = "100%",
events = JS("{'select': function(o, e, t){if (o != null && o.y != null && o.y.vars != null) { if (o.y.vars.length != 0) { var g = $('#genes'); g[0].selectize.clear(); g[0].selectize.addItems(o.y.vars);}}; }}")
)
}
volcanoPlot <- function(df, title, subtitle) {
## Need a NLP column for sizing
df$LogInt = df[["AveExpr"]]
df$LogInt[df$LogInt < 0] = 0
df$LogInt[df$LogInt > 10] = 10
## Log Score
df$NegativeLogP = -log10(df[, "P.Value"])
## Create Group factor column in df
df$Group = NA
df$Group <- ifelse(df[["P.Value"]] <= 0.01,
ifelse(df[["logFC"]] >= 0, "Increased", "Decreased"),
"No Change")
rnk = rank(df$Group, ties.method = "first")
rnk = rnk * -1
## Adding alpha to the colors
colors = c("deepskyblue4", "red3", "grey25")
colors[1] = paste(c("rgba(", paste(c(paste(col2rgb(colors[1], alpha = FALSE), collapse = ","), 0.5), collapse = ","), ")"), collapse = "")
colors[2] = paste(c("rgba(", paste(c(paste(col2rgb(colors[2], alpha = FALSE), collapse = ","), 0.5), collapse = ","), ")"), collapse = "")
colors[3] = paste(c("rgba(", paste(c(paste(col2rgb(colors[3], alpha = FALSE), collapse = ","), 0.5), collapse = ","), ")"), collapse = "")
## Create the canvasXpress df and var annotation
cx = data.frame(a = round(df[colnames(df) == "logFC"], digits = 2),
b = round(df$NegativeLogP, digits = 2))
colnames(cx) = c("logFC", "NegativeLogP")
cx = cx[with(cx, order(rnk)), ]
va = data.frame(Group = df$Group,
LogInt = round(df$LogInt, digits = 2))
va = va[with(va, order(rnk)), ]
rownames(va) = rownames(cx)
d = list(line = list(list(color = colors[1], width = 2, x = log2(1.5) * -1),
list(color = colors[2], width = 2, x = log2(1.5)),
list(color = colors[3], width = 2, x = 0)))
## CanvasXpress Plot
canvasXpress(
data = cx,
varAnnot = va,
decorations = d,
graphType = "Scatter2D",
colorBy = "Group",
colors = colors,
legendPosition = "right",
showDecorations = TRUE,
sizeBy = "LogInt",
sizes = c(4, 10, 12, 14, 16, 18, 20, 22, 24, 26),
sizeByShowLegend = TRUE,
title = title,
subtitle = subtitle,
xAxis = c("logFC", ""),
yAxis = c("NegativeLogP", ""),
yAxisTitle = "-log10(P.Value)",
subtitleScaleFontFactor = 0.5,
showAnimation = FALSE,
width = "100%",
events = JS("{'select': function(o, e, t){if (o != null && o.y != null && o.y.vars != null) { if (o.y.vars.length != 0) { var g = $('#genes'); g[0].selectize.clear(); g[0].selectize.addItems(o.y.vars);}}; }}")
)
}
comparePlot <- function(df, title, subtitle) {
# helper function
with.seed <- function(seed, expr) {
saved.seed <- .Random.seed
on.exit(.Random.seed <<- saved.seed)
set.seed(seed)
expr
}
# Columns to plot - Capture the labels from the colname
xlabel = colnames(df)[1]
ylabel = colnames(df)[2]
#create group factor column in df
df$group = NA
df$group <- ifelse(df[["xp"]] <= 0.01,
ifelse(df[["yp"]] <= 0.01, "Common", "X Unique"),
ifelse(df[["yp"]] <= 0.01, "Y Unique", "Not Significant"))
df$group <- df$group %>% factor(levels = c("Common", "X Unique", "Y Unique", "Not Significant"))
df$order <- with.seed(1954, sample.int(nrow(df))) + nrow(df) * (df$group == "Common") + -nrow(df) * (df$group == "Not Significant")
## sort df
df = df[order(df$order), ]
## Adding alpha to the colors
colors <- c("darkgoldenrod1", "grey25", "deepskyblue4", "red3")
colors[1] = paste(c("rgba(", paste(c(paste(col2rgb(colors[1], alpha = FALSE), collapse = ","), 0.5), collapse = ","), ")"), collapse = "")
colors[2] = paste(c("rgba(", paste(c(paste(col2rgb(colors[2], alpha = FALSE), collapse = ","), 0.5), collapse = ","), ")"), collapse = "")
colors[3] = paste(c("rgba(", paste(c(paste(col2rgb(colors[3], alpha = FALSE), collapse = ","), 0.5), collapse = ","), ")"), collapse = "")
colors[4] = paste(c("rgba(", paste(c(paste(col2rgb(colors[4], alpha = FALSE), collapse = ","), 0.5), collapse = ","), ")"), collapse = "")
## Create the canvasXpress df and var annotation
cx = data.frame(a = round(df[, 1], digits = 2), b = round(df[, 2], digits = 2))
colnames(cx) = c(xlabel, ylabel)
rownames(cx) = rownames(df)
va = data.frame(Group = df$group)
colnames(va) = c("Group")
rownames(va) = rownames(cx)
d = list(line = list(list(color = "black", width = 1, x = 0),
list(color = "black", width = 1, y = 0),
list(color = colors[1], width = 2,
x = -10, x2 = 10,
y = -10, y2 = 10)))
## CanvasXpress Plot
canvasXpress(
data = cx,
varAnnot = va,
decorations = d,
graphType = "Scatter2D",
colorBy = "Group",
colors = colors,
legendInside = TRUE,
legendPosition = "bottomRight",
scatterAxesEqual = TRUE,
showDecorations = TRUE,
sizeBy = "Group",
sizes = c(10, 4, 10, 10, 12, 14, 16, 18, 20, 22, 24, 26),
sizeByShowLegend = FALSE,
title = title,
subtitle = subtitle,
xAxis = list(xlabel),
yAxis = list(ylabel),
subtitleScaleFontFactor = 0.5,
showAnimation = FALSE,
width = "100%",
events = JS("{'select': function(o, e, t){if (o != null && o.y != null && o.y.vars != null) { if (o.y.vars.length != 0) { var g = $('#genes'); g[0].selectize.clear(); g[0].selectize.addItems(o.y.vars);}}; }}")
)
}
genePlot <- function(df, block, title, subtitle) {
smpAnnot = data.frame(Group = block)
rownames(smpAnnot) = rownames(t(df))
varAnnot = data.frame(Gene = rownames(df))
rownames(varAnnot) = rownames(df)
if (length(rownames(varAnnot)) > 4) {
canvasXpress(
data = df,
smpAnnot = smpAnnot,
graphType = "Heatmap",
smpOverlays = list("Group"),
smpOverlayProperties = list(Group = list(thickness = 100, color = "Set1")),
showSampleNames = FALSE,
sortSampleByCategory = list("Group"),
heatmapSmpSeparateBy = "Group",
variablesClustered = TRUE,
showVarDendrogram = FALSE,
colorSpectrum = c("navy", "white", "firebrick3"),
title = title,
subtitle = subtitle,
subtitleScaleFontFactor = 0.5,
overlayScaleFontFactor = 1.5,
showAnimation = FALSE,
width = "100%"
)
} else {
canvasXpress(
data = df,
smpAnnot = smpAnnot,
varAnnot = varAnnot,
graphType = "Boxplot",
graphOrientation = "vertical",
groupingFactors = c("Group"),
segregateVariablesBy = list("Gene"),
colorBy = "Group",
transparency = 0.7,
title = "Top Fold Change Genes",
subtitle = subtitle,
xAxisTitle = "Log2CPM",
xAxis2Show = FALSE,
showLegend = TRUE,
showSampleNames = FALSE,
legendPosition = "top",
legendColumns = 3,
showLegendTitle = FALSE,
layoutAdjust = FALSE,
smpTextRotate = 45,
stripTextColor = "rgb(0,0,0)",
stripBackgroundBorderColor = "rgb(0,0,0)",
xAxisMinorTicks = FALSE,
boxplotMedianWidth = 2,
subtitleScaleFontFactor = 0.5,
smpTextScaleFontFactor = 0.5,
showAnimation = FALSE,
width = "100%"
)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.