diff --git a/examples/19_canvasxpress-gene-explorer/dashboard.Rmd b/examples/19_canvasxpress-gene-explorer/dashboard.Rmd new file mode 100644 index 00000000..bee4d16d --- /dev/null +++ b/examples/19_canvasxpress-gene-explorer/dashboard.Rmd @@ -0,0 +1,104 @@ +--- +title: "IPF Fibroblast data" +output: + flexdashboard::flex_dashboard: + orientation: rows + social: menu + source_code: embed + css: styles.css +runtime: shiny +--- + +```{r setup, include=FALSE} +library(knitr) +library(flexdashboard) +library(htmlwidgets) +library(canvasXpress) +library(dplyr) + +source("supporting_plots.R") + +loadData <- function(filename) { + exData <- readRDS(filename) + + # format gene names: remove first underscore and all characters after that + gsub_expression <- "_.*" + rownames(exData$Log2CPM) <- gsub(gsub_expression, "", rownames(exData$Log2CPM)) + exData$contrasts <- lapply(exData$contrasts, FUN = function(x) { + rownames(x) <- gsub(gsub_expression, "", rownames(x)) + return(x) + }) + exData +} + +# load and prep the data +exData <- loadData("data.rds") +gene_list <- rownames(exData$contrasts[[1]]) +``` + + +Sidebar {.sidebar} +======================================================================= + +```{r} +selectizeInput("contrast", "Select Contrast", names(exData$contrasts)) + +selectizeInput("genes", "Select Gene(s)", gene_list, multiple = TRUE, selected = gene_list[1:2], + options = list(placeholder = "Type/Click then Select", + searchField = "value", + plugins = list('remove_button'))) +ds1 <- reactive({ + exData$contrasts[[input$contrast]] +}) +``` + + +Dashboard +======================================================================= + +Row {data-height=500} +----------------------------------------------------------------------- + +### Profile plot + +```{r} +renderCanvasXpress({ + pp <- ds1() + if (!is.null(pp)) { + profilePlot(pp, title = paste(input$contrast, sep = "")) + } else { + canvasXpress(destroy = TRUE) + } +}) +``` + +### Volcano plot + +```{r} +renderCanvasXpress({ + vp <- ds1() + if (!is.null(vp)) { + volcanoPlot(vp, title = paste(input$contrast, sep = "")) + } else { + canvasXpress(destroy = TRUE) + } + }) +``` + +Row {data-height=500} +----------------------------------------------------------------------- + +### Explore Genes +```{r} +renderCanvasXpress({ + sel = input$genes + if (!is.null(sel)) { + dat <- exData$Log2CPM + dat <- dat[rownames(dat) %in% sel,,drop = FALSE] + des <- exData$smpAnnot$ReplicateGroup + genePlot(dat, des, title = "Expression Plot") + } else { + canvasXpress(destroy = TRUE) + } +}) +``` diff --git a/examples/19_canvasxpress-gene-explorer/data.rds b/examples/19_canvasxpress-gene-explorer/data.rds new file mode 100644 index 00000000..038f016d Binary files /dev/null and b/examples/19_canvasxpress-gene-explorer/data.rds differ diff --git a/examples/19_canvasxpress-gene-explorer/styles.css b/examples/19_canvasxpress-gene-explorer/styles.css new file mode 100644 index 00000000..e474d8bf --- /dev/null +++ b/examples/19_canvasxpress-gene-explorer/styles.css @@ -0,0 +1,3 @@ +body { + background-color: white; +} diff --git a/examples/19_canvasxpress-gene-explorer/supporting_plots.R b/examples/19_canvasxpress-gene-explorer/supporting_plots.R new file mode 100644 index 00000000..93d34bb5 --- /dev/null +++ b/examples/19_canvasxpress-gene-explorer/supporting_plots.R @@ -0,0 +1,170 @@ +# ---------------------- +# Plot Related Functions +#----------------------- + +# shared variables +logRatioCol <- "logFC" +logIntCol <- "AveExpr" +axisAlgorithm <- "wilkinsonExtended" +backgroundType <- "window" +sizes <- c(10, 10, 4, 10, 12, 14, 16, 18, 20, 22, 24, 26) +plot_colors <- c("rgba(0,104,139,0.5)", "rgba(205,0,0,0.5)", "rgba(64,64,64,0.5)") +backgroundColor <- "lightgrey" +tickColor <- "white" +legendBoxColor <- "black" +fontName <- "Arial" +sizeByShowLegend <- FALSE +titleScaleFontFactor <- 0.5 +axisScaleFontFactor <- 1.8 + +profilePlot <- function(df, title = NULL) { + + ## create CanvasXpress data + cx <- data.frame(a = round(df[colnames(df) == logIntCol], digits = 2), + b = round(df[colnames(df) == logRatioCol], digits = 2)) + va <- data.frame(Group = df$Group, + nLog10pVal = df$NegativeLogP) + rownames(va) <- rownames(cx) + + ## CanvasXpress Plot + canvasXpress( + data = cx, + varAnnot = va, + graphType = "Scatter2D", + axisAlgorithm = axisAlgorithm, + backgroundType = backgroundType, + backgroundWindow = backgroundColor, + colorBy = "Group", + colors = plot_colors, + legendBackgroundColor = backgroundColor, + legendBoxColor = legendBoxColor, + legendInside = TRUE, + legendPosition = "bottomRight", + showLoessFit = TRUE, + loessColor = "darkgoldenrod1", + sizeBy = "Group", + sizes = sizes, + sizeByShowLegend = sizeByShowLegend, + title = title, + titleScaleFontFactor = titleScaleFontFactor, + fontName = fontName, + xAxis = list(logIntCol), + xAxisTickColor = tickColor, + xAxisTitle = logIntCol, + yAxis = list(logRatioCol), + yAxisTickColor = tickColor, + yAxisTitle = logRatioCol, + axisTitleScaleFontFactor = axisScaleFontFactor + ) +} + +volcanoPlot <- function(df, title = NULL) { + + ## create CanvasXpress data + cx <- data.frame(a = round(df[colnames(df) == logRatioCol], digits = 2), + b = round(df$NegativeLogP, digits = 2)) + colnames(cx) = c(logRatioCol, "NegativeLogP") + va <- data.frame(Group = df$Group, + LogInt = round(df[[logIntCol]], digits = 2)) + rownames(va) <- rownames(cx) + + ## CanvasXpress Plot + canvasXpress( + data = cx, + varAnnot = va, + graphType = "Scatter2D", + axisAlgorithm = axisAlgorithm, + backgroundType = backgroundType, + backgroundWindow = backgroundColor, + colorBy = "Group", + colors = plot_colors, + legendBackgroundColor = backgroundColor, + legendBoxColor = legendBoxColor, + legendInside = FALSE, + legendPosition = "right", + sizeBy = "Group", + sizes = sizes, + sizeByShowLegend = sizeByShowLegend, + title = title, + titleScaleFontFactor = titleScaleFontFactor, + fontName = fontName, + xAxis = c(logRatioCol, ""), + xAxisTickColor = tickColor, + xAxisTitle = logRatioCol, + yAxis = c("NegativeLogP", ""), + yAxisTickColor = tickColor, + yAxisTitle = "-log10(P.Value)", + axisTitleScaleFontFactor = axisScaleFontFactor + ) +} + +heatmapPlot <- function(df, smpAnnot = FALSE, title = NULL) { + canvasXpress( + data = df, + smpAnnot = smpAnnot, + graphType = "Heatmap", + smpOverlays = list("Group"), + smpOverlayProperties = list(Group = list(thickness = 60, color = "Set1")), + overlayScaleFontFactor = 1.4, + showSampleNames = FALSE, + sortSampleByCategory = list("Group"), + heatmapSmpSeparateBy = "Group", + variablesClustered = TRUE, + axisAlgorithm = axisAlgorithm, + showVarDendrogram = FALSE, + heatmapIndicatorPosition = "right", + colorSpectrum = c("navy", "white", "firebrick3"), + title = title, + broadcast = FALSE, + fontName = fontName + ) +} + +genePlot <- function(df, block, title = NULL) { + 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) { + heatmapPlot(df, smpAnnot, title = title) + } else { + canvasXpress( + data = df, + smpAnnot = smpAnnot, + varAnnot = varAnnot, + graphType = "Boxplot", + graphOrientation = "vertical", + backgroundWindow = "lightgrey", + backgroundType = backgroundType, + legendBoxColor = legendBoxColor, + legendBackgroundColor = backgroundColor, + groupingFactors = c("Group"), + segregateVariablesBy = list("Gene"), + colors = rep("deepskyblue3", 4), + title = "Top Fold Changes Genes", + titleScaleFontFactor = 0.4, + xAxisTitle = "Log2CPM", + axisTitleScaleFontFactor = 1.8, + smpHairline = TRUE, + smpHairlineColor = "white", + smpHairlineWidth = 1, + xAxisTickColor = tickColor, + smpTitle = "Group", + smpTitleScaleFontFactor = 0.5, + xAxis2Show = FALSE, + axisAlgorithm = axisAlgorithm, + showLegend = FALSE, + layoutBoxShow = FALSE, + smpLabelRotate = 50, + smpLabelScaleFontFactor = 0.5, + xAxisMinorTicks = FALSE, + fontName = fontName, + boxplotMedianWidth = 2, + boxplotMedianColor = "dodgerblue4", + boxplotMean = TRUE, + marginLeft = 30, + broadcast = FALSE + ) + } +}