R/runViz.R
In BaderLab/scClustViz: Differential Expression-based scRNAseq Cluster Assessment and Viewing
Defines functions
runShiny
Documented in
runShiny
#' Run the scClustViz Shiny app
#'
#' This command runs the Shiny interactive visualization from a saved data file.
#'
#' @param filePath A character vector giving the relative filepath to an RData
#' file containing two objects: the \code{\link{sCVdata}} object generated by
#' \code{\link{CalcAllSCV}}, and the input scRNAseq data object.
#' @param outPath Optional. If you'd like to save/load any analysis files
#' to/from a different directory than the input directory (for example, if
#' you're using data from a package), specify that directory here. Otherwise
#' any files generated by the Shiny app (ie. saving the selected cluster
#' solution, saving custom set DE testing results) will be saved/loaded in
#' \code{filePath}. If you'd like to prevent users from saving anything to
#' disk (ie when hosting a web service) set this to NA.
#' @param cellMarkers Optional. If you have canonical marker genes for expected
#' cell types, list them here (see example code below). Note that the gene
#' names must match rownames of your data (ie. use ensembl IDs if your gene
#' expression matrix rownames are ensembl IDs). The Shiny app will attempt to
#' label clusters in the tSNE projection by highest median gene expression.
#' See \code{\link{labelCellTypes}} for more information.
#' @param annotationDB Optional. An AnnotationDbi object for your data's species
#' (ie. \code{\link[org.Mm.eg.db]{org.Mm.eg.db}} /
#' \code{\link[org.Hs.eg.db]{org.Hs.eg.db}} for mouse / human respectively).
#' If present, gene names will be shown in gene-specific figures, official
#' gene symbols (instead of your rownames) will be displayed in figures, and
#' gene searches performed using both official gene symbols and your rownames.
#' If the gene IDs in your data aren't official gene symbols, using this
#' argument will make the visualization tool much more useful.
#' @param rownameKeytype Optional. A character vector indicating the
#' AnnotationDbi keytype (see
#' \code{\link[AnnotationDbi]{keytypes}(annotationDB)}) that represents your
#' rownames. If the annotationDB argument is present and this is missing, the
#' function will assume the rownames are official gene symbols. If less than
#' 80% of rownames map to official gene symbols, the function will try to
#' predict the appropriate keytype of the rownames (this takes a bit of time).
#' @param imageFileType Default="png". The file format for saved figures. One of
#' \code{"pdf"} (generated with \code{\link[grDevices]{cairo_pdf}}),
#' \code{"eps"} (generated with \code{\link[grDevices]{cairo_ps}}),
#' \code{"tiff"} (generated with \code{\link[grDevices]{tiff}}), or
#' \code{"png"} (generated with \code{\link[grDevices]{png}}). Note that \code{"pdf"}
#' and \code{"eps"} outputs require the cairo graphics library. Check to see if R can
#' find it on your computer by running \code{capabilities("cairo")}.
#' @param includeHeadHTML Default=NA. If you'd like an HTML script to be included
#' the webpage <head> section (such as the Google Analytics tracking script,
#' see https://shiny.rstudio.com/articles/google-analytics.html), pass the
#' path to the script HTML file here.
#' @param ... Named options that should be passed to the
#' \code{\link[shiny]{runApp}} call (these can be any of the following:
#' "port", "launch.browser", "host", "quiet", "display.mode" and "test.mode").
#'
#' @return The function causes the scClustViz Shiny GUI app to open in a
#' seperate window.
#'
#' @examples
#' \dontrun{
#' your_cluster_columns <- grepl("res[.0-9]+$",
#' names(getMD(your_scRNAseq_data_object)))
#' # ^ Finds the cluster columns of the metadata in a Seurat object.
#'
#' your_cluster_results <- getMD(your_scRNAseq_data_object)[,your_cluster_columns]
#'
#' sCVdata_list <- CalcAllSCV(inD=your_scRNAseq_data_object,
#' clusterDF=your_cluster_results,
#' exponent=exp(1),
#' pseudocount=1,
#' DRthresh=0.1,
#' DRforClust="pca",
#' testAll=F,
#' FDRthresh=0.05,
#' calcSil=T,
#' calcDEvsRest=T,
#' calcDEcombn=T)
#'
#' save(your_scRNAseq_data_object,sCVdata_list,
#' file="for_scClustViz.RData")
#'
#' # Lets assume this is data from an embryonic mouse cerebral cortex:
#' # (This is the function call wrapped by MouseCortex::viewMouseCortex("e13"))
#' runShiny(filePath="for_scClustViz.RData",
#' outPath="./",
#' # Save any further analysis performed in the app to the
#' # working directory rather than library directory.
#' annotationDB="org.Mm.eg.db",
#' # This is an optional argument, but will add annotations.
#' cellMarkers=list("Cortical precursors"=c("Mki67","Sox2","Pax6",
#' "Pcna","Nes","Cux1","Cux2"),
#' "Interneurons"=c("Gad1","Gad2","Npy","Sst","Lhx6",
#' "Tubb3","Rbfox3","Dcx"),
#' "Cajal-Retzius neurons"="Reln",
#' "Intermediate progenitors"="Eomes",
#' "Projection neurons"=c("Tbr1","Satb2","Fezf2",
#' "Bcl11b","Tle4","Nes",
#' "Cux1","Cux2","Tubb3",
#' "Rbfox3","Dcx")
#' )
#' # This is a list of canonical marker genes per expected cell type.
#' # The app uses this list to automatically annotate clusters.
#' )
#'
#' }
#'
#' @seealso \code{\link{sCVdata}} for the input data type, and
#' \code{\link{CalcAllSCV}} or \code{\link{CalcSCV}} to do the calculations
#' necessary for this function.
#'
#' @include shinyModules.R
#'
#' @export
#'
runShiny <- function(filePath,outPath,
cellMarkers=list(),
annotationDB,rownameKeytype,
imageFileType="png",
includeHeadHTML=NA,
...) {
if (is.na(includeHeadHTML)) {
includeHeadHTML <- system.file("blank.html",package="scClustViz")
}
# ^ Load data from file ------------------------------------------------------------------
while(T) {
if (exists(".lastFilePath") & exists(".lastFileCall")) {
if (.lastFilePath == filePath) {
if (exists(.lastFileCall[1]) & exists(.lastFileCall[2])) {
lfc <- .lastFileCall
warning(paste("Skipping file loading. Reading the following",
"previously-loaded data from R environment:",
.lastFileCall[1],.lastFileCall[2],sep="\n"))
break
} else {
rm(.lastFileCall,.lastFilePath,envir=.GlobalEnv)
}
} else {
rm(.lastFileCall,.lastFilePath,envir=.GlobalEnv)
}
} else {
.lastFilePath <<- filePath
.lastFileCall <<- lfc <- load(filePath,envir=.GlobalEnv)
break
}
}
# The above weird-ass loop (or weird ass-loop if you prefer) checks to see if
# the file has already been loaded (if this function has been run previously
# this session), otherwise loads the file.
names(lfc) <- sapply(seq_along(lfc),function(X) {
if (is(get(lfc[X]))[1] %in% findMethodSignatures(getExpr)) {
return("inD")
}
if (is(get(lfc[X]))[1] == "sCVdata") {
return("sCV")
}
if (is(get(lfc[X]))[1] == "list") {
if (is(get(lfc[X])[[1]]) == "sCVdata") {
return("sCVdL")
} else {
stop("Unexpected input object. Missing CalcAllSCV output object.")
}
} else {
stop("Unexpected input object. Missing single-cell data object.")
}
})
if (any(names(lfc) == "sCV")) {
temp_sCVdL <- list(clusters=get(lfc["sCV"]))
lfc["sCVdL"] <- "temp_sCVdL"
# lfc <- lfc[-which(names(lfc) == "sCV")]
}
temp_missing_files <- setdiff(c("inD","sCVdL"),names(lfc))
if (length(temp_missing_files) > 0) {
stop(paste("Unexpected input object. Missing",
switch(temp_missing_files,
inD="single-cell data object.",
sCVdL="CalcAllSCV output object.")))
}
inD <- get(lfc["inD"])
sCVdL <- get(lfc["sCVdL"])
# ^^ dataPath & dataTitle --------------------------------------------------------------
temp_dataPath <- strsplit(filePath,"/|\\\\")
dataPath <- sub(temp_dataPath[[1]][length(temp_dataPath[[1]])],"",filePath)
if (dataPath == "") { dataPath <- "./" }
dataTitle <- sub("\\.[^.]+$","",tail(temp_dataPath[[1]],1))
rm(temp_dataPath)
if (!missing(outPath)) {
if (!is.na(outPath)) {
if (!grepl("[/\\]$",outPath)) {
outPath <- paste0(outPath,"/")
}
}
}
# Seperates the file name (which becomes the dataTitle) from the path (which
# becomes dataPath). This is used when saving and loading various things in
# the app (default cluster solution, custom set DE results).
# ^^ Load saved comparisons (if any) ---------------------------------------------------
if (!missing(outPath)) { #Load from both dataPath and outPath if outPath exists.
if (!is.na(outPath)) {
for (selDEfile in grep(paste0("^",dataTitle,".+selDE.+RData$"),list.files(outPath),value=T)) {
temp <- load(paste0(outPath,selDEfile))
if (is.list(get(temp))) {
if (all(sapply(get(temp),function(X) "sCVdata" %in% is(X)))) {
sCVdL <- append(sCVdL,get(temp))
}else {
warning(paste(selDEfile,"is not a valid list of sCVdata object(s)."))
}
} else {
warning(paste(selDEfile,"is not a valid list of sCVdata object(s)."))
}
rm(list=temp)
}
}
}
for (selDEfile in grep(paste0("^",dataTitle,"_selDE.+RData$"),list.files(dataPath),value=T)) {
temp <- load(paste0(dataPath,selDEfile))
if (is.list(get(temp))) {
if (all(sapply(get(temp),function(X) "sCVdata" %in% is(X)))) {
sCVdL <- append(sCVdL,get(temp))
}else {
warning(paste(selDEfile,"is not a valid list of sCVdata object(s)."))
}
} else {
warning(paste(selDEfile,"is not a valid list of sCVdata object(s)."))
}
rm(list=temp)
}
#### MEMORY USAGE SHENANIGANS? ####
# Load in the custom DE results from the same directory as the input file and
# add them to the relevant lists. THIS MIGHT DOUBLE MEMORY USAGE since the
# objects are now being modified from the versions stored in the list objects
# stored in the global environment, which might mean assigning them to a
# separate address in memory. CHECK ON THIS!
# ^^ Load default cluster solution (if any) --------------------------------------------
savedRes <- NULL
if (file.exists(paste0(dataPath,dataTitle,"_savedRes.RData"))) {
load(paste0(dataPath,dataTitle,"_savedRes.RData"))
}
if (!missing(outPath)) {
if (!is.na(outPath)) {
if (file.exists(paste0(outPath,dataTitle,"_savedRes.RData"))) {
load(paste0(outPath,dataTitle,"_savedRes.RData"))
}
}
}
if (is.null(savedRes) & length(sCVdL) == 1) {
savedRes <- names(sCVdL)
}
# Load the default cluster solution from the user-provided filepath (outPath)
# preferentially, otherwise load from the same directory as the input file. If
# neither exist, set to NULL. If there's no default solution but there's only
# one cluster solution in the sCVdata list, just use it. This is actually
# accomplished by overwriting the initial NULL up to two times if they both
# exist, but since it's a single character string it's not appreciably slower.
# ^^ Generate blank preamble if none saved -------------------------------------
introPath <- paste0(dataPath,dataTitle,"_intro.md")
if (!missing(outPath)) {
if (!is.na(outPath)) {
if (file.exists(paste0(outPath,dataTitle,"_intro.md"))) {
introPath <- paste0(outPath,dataTitle,"_intro.md")
}
}
}
# Generate a section of preamble text in markdown that the user can edit.
if (!file.exists(introPath)) {
write(paste0(dataTitle,": You can add to this preamble by editting ",introPath),
file=introPath)
}
# Done loading, now set dataPath so that things saved go to the right place.
if (!missing(outPath)) {
if (!is.na(outPath)) {
dataPath <- outPath
}
} else {
outPath <- dataPath
}
if (!imageFileType %in% c("pdf","eps","png","tiff")) {
warning('imageFileType must be one of c("pdf","eps","png","tiff"). Setting to "pdf".')
imageFileType <- "pdf"
}
# ^ Helper calcs for Shiny -----------------------------------------------------
# ^^ Map rownames to gene symbol -------------------
symbolMap <- NULL
if (!missing(annotationDB)) {
if (is.character(annotationDB)) {
require(annotationDB,quietly=T,character.only=T)
annotationDB <- get(annotationDB)
}
if (missing(rownameKeytype)) {
rownameKeytype <- findKeyType(rownames(getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])),
annotationDB)
}
symbolMap <- map2symbol(getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2]),
annotationDB,
rownameKeytype)
}
# ^^ Cell type annotation from cellMarkers ----------
sCVdL <- sapply(sCVdL,
FUN=labelCellTypes,
cellMarkers=cellMarkers,
symbolMap=symbolMap,
simplify=F)
# UI -------------------------------------------------------------------------------------
ui <- fixedPage(
tags$head(includeHTML(includeHeadHTML)),
fixedRow(
titlePanel(paste("scClustViz -",dataTitle)),
includeMarkdown(introPath)
),
hr(),
# ^ Clustering Solution Selection ------------------------------------------------------
#### TEMPORARY WARNING ####
fixedRow(
p(HTML(paste(
"<b>Please note:</b>",
"scClustViz is currently suffering from a bug causing plots to <em>temporarily</em> fail to load.",
"The current work-around is to toggle an input to the plot - for interactive plots",
"such as the first figure below left, attempting to zoom in/out,",
"and for others, switching an input (such as swapping between PCA and tSNE/UMAP for",
"the cell embedding plot). We're sorry for the inconvenience, and are working to",
"find and squash the bug now.")),style="color:red")
),
fixedRow(
titlePanel("Clustering Solution Selection"),
p(paste(
"Here you can compare the results of clustering at different resolutions to",
"determine the appropriate clustering solution for your data. You can see the",
"cluster solutions represented as boxplots on the left, where each boxplot",
"represents the number of genes differentially expressed between each cluster",
"and its nearest neighbour, or marker genes per cluster. The cluster selected",
"in the pulldown menu is highlighted in red, and the silhouette plot for that",
"cluster is shown on the right. The plot can be zoomed by clicking and dragging",
"to select a region to view, and double-clicking to zoom to it. Double-click",
"again to revert view to default."
)),
p(paste(
"A silhouette plot is a horizontal barplot where each bar is a cell, grouped by",
"cluster. The width of each bar represents the difference between mean distance",
"to other cells within the cluster and mean distance to cells in the nearest",
"neighbouring cluster. Distance is Euclidean in reduced dimensional space.",
"Positive silhouettes indicate good cluster cohesion."
)),
p(HTML(paste(
"Once you've selected an appropriate cluster solution (we suggest picking one",
"where all nearest neighbouring clusters have differentially expressed genes",
"between them), click <b>View clusters at this resolution</b> to proceed. If you",
"want to save this cluster solution as the default for next time, click <b>Save",
"this resolution as default</b>. All figures can be downloaded by clicking",
"the buttons next to each figure."
))),
h1()
),
fixedRow(
column(6,
fixedRow(column(6,uiOutput("resSelect"),align="left"),
column(6,align="right",
actionButton("go","View clusters at this resolution",icon("play"),
style="color: #fff; background-color: #008000"),
uiOutput("saveButton")
)
),
fixedRow(
column(9,uiOutput("deType")),
column(3,uiOutput("FDRthresh1"),align="right")
),
plotOutput("clustSep",height="500px",
dblclick="clustSep_dblclick",
brush=brushOpts(id="clustSep_brush",resetOnNew=T)
)),
column(6,plotOutput("sil",height="670px"))
),
fixedRow(
column(6,downloadButton("clustSepSave",paste("Save as",toupper(imageFileType))),align="left"),
column(6,downloadButton("silSave",paste("Save as",toupper(imageFileType))),align="right")
),
hr(),
# ^ Dataset and Cluster Metadata Inspection --------------------------------------------
fixedRow(
titlePanel("Dataset and Cluster Metadata Inspection"),
p(paste(
"Here you can explore your dataset as a whole: cluster assignments for all",
"cells; metadata overlays for cell projections; and figures for comparing",
"both numeric and categorical metadata.")),
h1()
),
fixedRow(
column(8,
p(HTML(paste(
"The top two figures show cells projected into 2D space using one of the",
"dimensionality reductions calculated in your data object. For example,",
"tSNE and UMAP place cells in space such that proximity indicates transcriptional",
"similarity. PCA is a common input for clustering and cell embedding, and it's",
"important to ensure components don't strongly correlate with technical features.",
"On the left you can see cluster assignments and the nearest neighbours used in",
"the differential expression calculations. If cell type marker genes were",
"provided in RunVizScript.R, it will also show predicted cell type annotations.",
"On the right you can add a metadata overlay to the cell projection.",
"<b>You can select any cluster for further assessment by clicking on a cell",
"from that cluster in the left figure.</b>"
)))
),
column(4,uiOutput("MD_EmbType"),
fixedRow(
column(6,uiOutput("MD_EmbDimX")),
column(6,uiOutput("MD_EmbDimY"))
)
)
),
fixedRow(
column(6,
uiOutput("tsneLabels"),
checkboxInput("nnArrow",value=F,width="100%",
label="Show nearest neighbouring clusters by differential expression score.")
),
column(4,uiOutput("tsneMDcol")),
column(2,uiOutput("tsneMDlog"))
),
fixedRow(
column(6,plotOutput("tsne",height="580px",click="tsneClick")),
column(6,plotOutput("tsneMD",height="580px"))
),
fixedRow(
column(6,align="left",downloadButton("tsneSave",paste("Save as",toupper(imageFileType)))),
column(6,align="right",downloadButton("tsneMDSave",paste("Save as",toupper(imageFileType))))
),
hr(),
fixedRow(
p(paste(
"Below",
"you can view relationships in the metadata as a scatterplot or compare clusterwise",
"distributions of metadata as bar- or box-plots. If you select a cluster of interest",
"(by clicking on a cell in the top-left plot, or from the list two sections down)",
"it will be highlighted for comparison in these figures."
)),
h1(),
column(2,uiOutput("mdScatterX")),
column(2,uiOutput("mdScatterY")),
column(2,uiOutput("scatterLog")),
column(3,uiOutput("mdFactorData")),
column(3,uiOutput("mdFactorOpts"))
),
fixedRow(
column(6,plotOutput("mdScatter",height="560px")),
column(6,plotOutput("mdFactor",height="560px"))
),
fixedRow(
column(6,align="left",downloadButton("mdScatterSave",paste("Save as",toupper(imageFileType)))),
column(4,align="right",downloadButton("mdFactorSave",paste("Save as",toupper(imageFileType)))),
column(2,align="right",downloadButton("mdFactorTable","Download metadata per cluster"))
),
hr(),
# ^ Differentially Expressed Genes per Cluster -----------------------------------------
fixedRow(
titlePanel("Differentially Expressed Genes per Cluster"),
p(HTML(paste0(
"Here you can explore the significantly differentially expressed genes per ",
"cluster. '<b>DE vs Rest</b>' refers to positively differentially expressed genes ",
"when comparing a cluster to the rest of the cells as a whole. '<b>Marker genes</b>' ",
"refers to genes positively differentially expressed versus all other clusters ",
"in a series of pairwise tests. '<b>DE vs neighbour</b>' refers to genes positively ",
"differentially expressed versus the nearest neighbouring cluster, as measured ",
"by number of differentially expressed genes between clusters. In all cases, ",
"Wilcoxon rank-sum tests with false detection rate correction are used."
))),
p(paste(
"The dotplot is generated using the differentially expressed genes from the test",
"and number of genes selected below. A dotplot is a modified heatmap where each",
"dot encodes both detection rate and average gene expression in detected cells",
"for a gene in a cluster. Darker colour indicates higher mean normalized gene expression",
"from the cells in which the gene was detected, and larger dot diameter indicates",
"that the gene was detected in greater proportion of cells from the cluster.")),
p(HTML(paste(
"Gene expression statistics per cluster can be downloaded as tab-separated text files",
"by selecting the cluster and clicking <b>Download cluster gene stats</b>. These statistics",
"are: mean log-normalized gene expression per cluster (MGE), proportion of cells in the",
"cluster in which the gene was detected (DR), and mean log-normalized gene expression",
"from the cells in which the gene was detected (MDGE). Differentially expressed gene",
"expression test results can be downloaded as tab-separated text files by selecting the",
"test type (under 'Dotplot Genes') and cluster, and clicking <b>Download DE results</b>.",
"Genes used in the dotplot can be viewed in the gene expression plots below as well."
))),
h1()
),
fixedRow(
column(2,uiOutput("heatDEtype"),
numericInput("FDRthresh2",label="FDR",value=.05,max=1)),
column(6,uiOutput("DEgeneSlider")),
column(2,uiOutput("DEclustSelect")),
column(2,
downloadButton("CGSsave0","Download cluster gene stats"),
downloadButton("deGeneSave","Download DE results"),
downloadButton("heatmapSave",paste("Save as",toupper(imageFileType))))
),
fixedRow(plotOutput("dotplot",height="600px")),
hr(),
# ^ Gene Expression Distributions per Cluster ------------------------------------------
fixedRow(
titlePanel("Gene Expression Distributions per Cluster"),
p(paste("Here you can investigate the expression of individual genes per cluster and",
"across all clusters. The first plot shows mean expression of genes in a cluster",
"as a function of their detection rate and transcript count when detected. The",
"x-axis indicates the proportion of cells in the cluster in which each gene was",
"detected (transcript count > 0), while the y-axis shows the mean normalized",
"transcript count for each gene from the cells in the cluster in which that gene",
"was detected. You can select the cluster to view from the menu below, and genes",
"can be labelled in the figure based on the cell-type markers provided in",
"RunVizScipt.R, the differentially expressed genes from the selected cluster in",
"the above heatmap, or by searching for them in the box below the figure.")),
p(paste("Clicking on the first plot will populate the list of genes near the point clicked,",
"which can be found above the next figure. By selecting a gene from this list,",
"you can compare the expression of that gene across all clusters in the second figure.",
"This list can also be populated using the gene search feature. Plotting options",
"for the second figure include the option to overlay normalized transcript count",
"from each cell in the cluster over their respective boxplots ('Include scatterplot'),",
"and the inclusion of the percentile rank of that gene's expression per cluster as",
"small triangles on the plot using the right y-axis ('Include gene rank').")),
h1()
),
fixedRow(
column(3,uiOutput("genePlotClustSelect")),
column(9,uiOutput("cgLegend"))
),
fixedRow(align="right",
plotOutput("clusterGenes",height="600px",click="cgClick"),
downloadButton("clusterGenesSave",paste("Save as",toupper(imageFileType)))
),
fixedRow(
column(3,radioButtons("searchType",label="Search by:",
choices=c("Gene list (comma-separated)"="comma",
"Regular expression"="regex"))),
column(8,uiOutput("geneSearchBox")),
column(1,actionButton("GOIgo","Search",icon=icon("search")))
),tags$style(type='text/css', "button#GOIgo { margin-top: 25px; margin-left: -25px; }"),
# ^ Gene expression comparison ---------------------------------------------------------
fixedRow(
column(3,radioButtons("boxplotGene",inline=F,
label="Genes of interest (to populate list):",
choices=c("From click on gene in plot"="click",
"From gene search"="search"))),
column(4,uiOutput("cgSelect")),
column(5,checkboxGroupInput("bxpOpts",label="Figure options:",
selected=c("sct","dr"),inline=T,
choices=list("Include scatterplot"="sct",
"Include detection rate"="dr")))
),
fixedRow(plotOutput("geneTest",height="500px"),
downloadButton("geneTestSave",paste("Save as",toupper(imageFileType)))
),
hr(),
# ^ Distribution of genes of interest --------------------------------------------------
fixedRow(
titlePanel("Cell Distribution of Genes of Interest")
),
fixedRow(
column(6,
p(paste("Here you can overlay gene expression values for individual genes of interest",
"on the cell projection. Search for your gene using the search box below,",
"then select your gene(s) of interest from the dropdown 'Select genes' menu.",
"You have the option to include the cluster labels from the first cell projection",
"figure in these plots, and to colour the clusters themselves. There are two",
"copies of this figure for ease of comparison between genes of interest."))
),
column(2,uiOutput("GOI_EmbType")),
column(2,uiOutput("GOI_EmbDimX")),
column(2,uiOutput("GOI_EmbDimY"))
),
fixedRow(
column(2,radioButtons("searchType1",label="Search by:",
choices=c("Gene list"="comma",
"Regular expression"="regex"))),
column(3,uiOutput("geneSearchBox1")),
column(1,actionButton("GOI1go","Search",icon=icon("search"))),
column(2,radioButtons("searchType2",label="Search by:",
choices=c("Gene list"="comma",
"Regular expression"="regex"))),
column(3,uiOutput("geneSearchBox2")),
column(1,actionButton("GOI2go","Search",icon=icon("search")))
),tags$style(type='text/css', paste("button#GOI1go { margin-top: 25px; margin-left: -25px; }",
"button#GOI2go { margin-top: 25px; margin-left: -25px; }")),
fixedRow(
column(3,
radioButtons("plotClust1",inline=T,label="Plot:",selected="goi",
choices=list("Clusters"="clust","Gene expression overlay"="goi")),
checkboxInput("plotLabel1",label="Include cluster labels (style as above)",value=T)
),
column(3,uiOutput("GOI1select")),
column(3,
radioButtons("plotClust2",inline=T,label="Plot:",selected="goi",
choices=list("Clusters"="clust","Gene expression overlay"="goi")),
checkboxInput("plotLabel2",label="Include cluster labels (style as above)",value=T)
),
column(3,uiOutput("GOI2select"))
),
fixedRow(
column(6,plotOutput("goiPlot1",height="580px")),
column(6,plotOutput("goiPlot2",height="580px"))
),
fixedRow(
column(6,align="left",uiOutput("goiPlot1SaveButton")),
column(6,align="right",uiOutput("goiPlot2SaveButton"))
),
hr(),
# ^ Cluster comparison -----------------------------------------------------------------
fixedRow(
titlePanel("Cluster/Set Comparison of Gene Statistics"),
p(paste("Here you can explore the results of pairwise gene expression comparisons",
"between clusters.",
"Any clusters from the currently selected cluster solution can be compared,",
"and you can switch cluster resolutions from the menu here for convenience.",
"Gene effect sizes can be viewed in the context of statistical significance",
"(volcano plots), or directly in modified Bland-Altman plots (axes swapped",
"to match volcano plots).",
"Genes can be labelled by statistical significance, maximum difference,",
"or using the gene search feature above.")),
p(HTML(paste("Summary statistics of gene expression for either cluster can be downloaded",
"as tab-separated text files using the <b>Download cluster gene stats</b>",
"button under each cluster selection menu. These statistics are:",
"Mean log-normalized transcript count per cluster",
"(mean gene expression - MGE);",
"Proportion of cells in the cluster in which the gene was detected",
"(detection rate - DR);",
"and mean log-normalized transcript count from the cells in which",
"the gene was detected (mean detected gene expression - MDGE)."))),
p(HTML(paste("Differentially expressed gene expression test results for the comparison",
"between selected clusters can be downloaded as tab-separated text file",
"using the <b>Download DE results</b> button.",
"Effect size measures for difference in mean gene expression",
"(gene expression ratio - logGER) and difference in detection rate (dDR),",
"as well as p- and FDR values for tested genes are included in the results."))),
p(paste("Similar to the gene expression distribution scatterplot above, clicking on any",
"point in this plot will populate the 'Genes of interest' list above the boxplots",
"comparing gene expression across clusters.")),
h1()
),
fixedRow(
column(7,plotOutput("setScatter",height="640px",click="scatterClick")),
column(5,
fixedRow(
column(10,uiOutput("resSelect2")),
column(2,actionButton("go2","View",icon("play"),
style="color: #fff; background-color: #008000"))
),
fixedRow(column(12,uiOutput("saveButton2"))),
fixedRow(
column(6,uiOutput("setScatterA")),
column(6,uiOutput("setScatterB"))
),
fixedRow(
column(6,downloadButton("CGSsaveA","Download cluster gene stats")),
column(6,downloadButton("CGSsaveB","Download cluster gene stats"))
),
hr(),
fixedRow(
column(8,radioButtons("scatterInput",label="Plot to display:",
choices=c(
"Volcano plot of gene expression ratio"="logGER",
"Volcano plot of difference in detection rate"="dDR",
"Gene expression ratio vs difference in detection rate"="GERvDDR",
"Compare mean gene expression"="MGE",
"Compare detection rate"="DR",
"Compare mean detected gene expression"="MDGE"
),
selected="logGER")
),
column(4,
fixedRow(radioButtons("diffLabelType",label="Label genes by:",
choices=c("Most significant"="de",
"Most different"="diff",
"From gene search"="search")),
uiOutput("diffLabelChoice")
# checkboxGroupInput("scatterLabelAngle",label="Plot options:",
# choices=c("Flip label angle"="flip"))
)
)
),
fixedRow(column(12,uiOutput("diffLabelSelect"))),
fixedRow(
column(4,downloadButton("setScatterSave",paste("Save as",toupper(imageFileType)))),
column(4,downloadButton("setComparisonSave","Download DE results"))
)
)
),tags$style(type='text/css',paste("button#go2 { margin-top: 25px; margin-left: -25px; }",
"button#updateForViz2 { margin-top: -25px; }",
"button#setComparisonSave { margin-left: -25px; }")),
hr(),
# ^ Custom sets for DE -----------------------------------------------------------------
fixedRow(titlePanel("Manually Select Cells for DE Testing or Further Analysis"),
p(paste("Here you can select sets of cells to directly compare in the figures",
"above, or to generate a new data object for further analysis in R.",
"This can be done manually, or by setting filters on the metadata.",
"Click and drag to select cells manually, and use the buttons below to",
"add or remove the selected cells to/from a set of cells.",
"Filters can be set on metadata by selecting a metadata column from the",
"pulldown menu, and selecting factors / data ranges to include cells.",
"You can include more than one metadata filter, and they will be combined",
"using the logical AND (intersection of sets). You can see the selected",
"cells bolded in the plot. When your cell set(s) are ready, if subsetting",
"just save the subset as a new RData file to disk using the save button.",
"If building a comparison of cell sets for DE testing, name the comparison",
"and click the 'Calculate differential gene expression' button. Once the",
"calculation is done the comparison will be added to the cluster list",
"at the top of the page and the current cluster solution will be updated",
"to show this comparison. The comparison can be saved by clicking 'Save",
"this comparison to disk' next to either cluster solution menu.")),
uiOutput("NoSubsetWarning")
),
#### TESTING ####
# verbatimTextOutput("TEST"),
fixedRow(
column(8,plotOutput("tsneSelDE",brush="tsneSelDEbrush",hover="tsneSelDEhover",height="750px")),
column(4,
fixedRow(
uiOutput("DEorSubset")
),
fixedRow(
column(4,uiOutput("SelDE_EmbType")),
column(4,uiOutput("SelDE_EmbDimX")),
column(4,uiOutput("SelDE_EmbDimY"))
),
hr(),
fixedRow(
column(8,uiOutput("tsneSelDEcol")),
column(2,actionButton("plusFilt","Add",icon("plus"),
style="color: #fff; background-color: #008000")),
column(2,actionButton(
"minusFilt","Remove",icon("minus"),
style="color: #008000; background-color: #fff; border-color: #008000"
))
),
uiOutput("MDfilts"),
uiOutput("MDfiltsRemoveAll"),
hr(),
fixedRow(
column(
6,htmlOutput("textSetA"),
uiOutput("addCellsA"),
uiOutput("removeCellsA")
),
column(
6,htmlOutput("textSetB"),
uiOutput("addCellsB"),
uiOutput("removeCellsB")
)
),
span(textOutput("textOverlap"),style="color:red"),
hr(),
uiOutput("DEsetName"),
uiOutput("calcDE"),
uiOutput("calcText"),
hr(),
textOutput("cellsHovered")
)
),tags$style(type='text/css',paste("button#plusFilt { margin-top: 25px; margin-left: -25px; }",
"button#minusFilt { margin-top: 25px; margin-left: -25px; }")),
h1()
)
# Server -------------------------------------------------------------------------------
server <- function(input,output,session) {
session$onSessionEnded(function() {
message("RShiny scClustViz session closed, stopping runShiny function.")
stopApp()
})
# Stops Shiny process in R when Shiny UI session ends (browser window closes)
d <- reactiveValues(MD=getMD(inD)[!names(getMD(inD)) %in% names(sCVdL)],
SCV=sCVdL)
#### TESTING ####
# output$TEST <- renderPrint(currSel())
# ^ Clustering Solution Selection ------------------------------------------------------
numClust <- sapply(sCVdL[!grepl("^Comp:",names(sCVdL))],
function(X) length(levels(Clusters(X))))
clustList <- reactive({
temp <- names(d$SCV)
names(temp)[!grepl("^Comp:",names(d$SCV))] <-
paste0(temp[!grepl("^Comp:",names(d$SCV))],": ",numClust," clusters")
if (any(grepl("^Comp:",names(d$SCV)))) {
names(temp)[grepl("^Comp:",names(d$SCV))] <-
paste0("Comparison: ",sub("Comp:","",fixed=T,
x=temp[!temp %in% names(numClust)]))
}
return(temp)
})
output$deType <- renderUI({
temp_types <- list(
"# of positive DE genes per cluster to nearest cluster"="DEneighb",
"# of positive DE genes per cluster to all other clusters"="DEmarker"
# "Distance between clusters by gene detection rates"="DR",
# "Distance between clusters by mean gene expression"="MGE",
# "Distance between clusters by mean expression in PCA space"="PCA",
# "Distance between clusters by differential expression score"="scoreDE"
)
if (all(!sapply(d$SCV[!grepl("^Comp:",names(d$SCV))],
function(X) is.null(Silhouette(X))))) {
temp_types[["Silhouette widths"]] <- "silWidth"
}
selectInput(
"deType",label="Cluster separation metric:",
choices=temp_types,
width="100%")
})
# ^^ Resolution selection buttons ----------------------------------------------------
res <- reactiveVal(savedRes)
output$resSelect <- renderUI({
selectInput("res","Resolution:",choices=clustList(),selected=res())
})
output$saveButton <- renderUI({
if (!is.na(outPath)) {
if (grepl("^Comp",input$res)) {
actionButton("updateForViz","Save this comparison to disk",icon("save"))
} else {
actionButton("save","Save this resolution as default",icon("bookmark"))
}
}
})
observeEvent(input$go,{
res(input$res)
})
observeEvent(input$go2,{
res(input$res2)
})
observeEvent(input$save,{
savedRes <<- input$res
# <<- updates variable outside scope of function. In this case, that's the enclosing
# function (runShiny), where savedRes was set.
save(savedRes,file=paste0(dataPath,dataTitle,"_savedRes.RData"))
})
# ^^ Inter-cluster DE boxplots -------------------------------------------------------
clustSepRanges <- reactiveValues(x=NULL,y=NULL)
observeEvent(input$clustSep_dblclick, {
brush <- input$clustSep_brush
if (!is.null(brush)) {
clustSepRanges$x <- c(brush$xmin, brush$xmax)
clustSepRanges$y <- c(brush$ymin, brush$ymax)
} else {
clustSepRanges$x <- NULL
clustSepRanges$y <- NULL
}
})
output$clustSep <- renderPlot({
if (input$deType %in% c("DEneighb","DEmarker") &
!all(sapply(sCVdL,function(X) length(DEcombn(X)) > 0))) {
plot(x=NA,y=NA,xlim=0:1,ylim=0:1,xaxt="n",yaxt="n",xlab=NA,ylab=NA)
text(.5,.5,switch(
input$deType,
# scoreDE=paste(
# "Can't calculate distance between clusters by differential expression score",
# "Try running CalcDEvsCombn() for all sCVdata objects in cluster resolution list.",
# sep="\n"
# ),
DEneighb=paste(
"Can't calculate number of DE genes per cluster to nearest cluster",
"Try running CalcDEvsCombn() for all sCVdata objects in cluster resolution list.",
sep="\n"
),
DEmarker=paste(
"Can't calculate number of DE genes per cluster to all other clusters",
"Try running CalcDEvsCombn() for all sCVdata objects in cluster resolution list.",
sep="\n"
)
))
} else {
print(plot_clustSep(sCVdL=d$SCV[!grepl("^Comp:",names(d$SCV))],
DEtype=input$deType,
FDRthresh=input$FDRthresh1,
res=input$res,
Xlim=clustSepRanges$x,
Ylim=clustSepRanges$y))
}
})
output$clustSepSave <- downloadHandler(
filename=paste0(dataTitle,"_ClusterResolutionBoxplots.",imageFileType),
content=function(file) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=6,width=7,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=6,width=7,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=6,width=7,units="in",res=600),
"png"=grDevices::png(file,height=6,width=7,units="in",res=600))
print(plot_clustSep(sCVdL=d$SCV[!grepl("^Comp:",names(d$SCV))],
DEtype=input$deType,
FDRthresh=input$FDRthresh1,
res=input$res,
Xlim=clustSepRanges$x,
Ylim=clustSepRanges$y))
grDevices::dev.off()
}
)
# ^^ FDRthresh Selection -------
output$FDRthresh1 <- renderUI({
if (input$deType %in% c("DEneighb","DEmarker")) {
numericInput("FDRthresh1",label="FDR",
value=.05,max=1)
}
})
# ^^ Silhouette plot -----------------------------------------------------------------
output$sil <- renderPlot({
if (is.null(Silhouette(d$SCV[[input$res]]))) {
plot(x=NA,y=NA,xlim=0:1,ylim=0:1,xaxt="n",yaxt="n",xlab=NA,ylab=NA)
if (grepl("^Comp:",input$res)) {
text(.5,.5,"Silhouette plot is not calculated for set comparisons.")
} else {
text(.5,.5,paste("Silhouette plot was not computed.",
"If the 'cluster' package is installed,",
"try running CalcSilhouette() for the",
"sCVdata object at this cluster resolution.",sep="\n"))
}
} else {
if (require(cluster)) {
plot_sil(d$SCV[[input$res]])
if (length(res()) > 0) {
d$MD$SilhouetteWidth <- Silhouette(d$SCV[[res()]])[,"sil_width"]
}
} else {
plot(x=NA,y=NA,xlim=0:1,ylim=0:1,xaxt="n",yaxt="n",xlab=NA,ylab=NA)
text(.5,.5,"Silhouette plot requires 'cluster' package to be installed.")
}
}
})
output$silSave <- downloadHandler(
filename=paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),"_Silhouette.",imageFileType),
content=function(file) {
if (!is.null(Silhouette(d$SCV[[input$res]]))) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=6,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=6,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=6,units="in",res=600),
"png"=grDevices::png(file,height=7,width=6,units="in",res=600))
plot_sil(d$SCV[[input$res]])
grDevices::dev.off()
}
}
)
# ^ Dataset and Cluster Metadata Inspection --------------------------------------------
# ^^ MD embedding type selection ####
output$MD_EmbType <- renderUI({
temp_embs <- hasEmb(inD)
temp_embs <- temp_embs[
sapply(temp_embs,function(X) ncol(getEmb(inD,X))) >= 2 &
sapply(temp_embs,function(X) nrow(getEmb(inD,X))) == nrow(getMD(inD))
]
selectInput("MD_EmbType",label="Select cell embedding:",
choices=temp_embs,
selected=temp_embs[length(temp_embs)])
})
output$MD_EmbDimX <- renderUI({
selectInput("MD_EmbDimX",label="x-axis:",
choices=colnames(getEmb(inD,input$MD_EmbType)),
selected=colnames(getEmb(inD,input$MD_EmbType))[1])
})
output$MD_EmbDimY <- renderUI({
selectInput("MD_EmbDimY",label="y-axis:",
choices=colnames(getEmb(inD,input$MD_EmbType)),
selected=colnames(getEmb(inD,input$MD_EmbType))[2])
})
# ^^ Cell-type tSNE ####
output$tsneLabels <- renderUI({
if (length(res()) > 0) {
temp_choices <- list("Cluster annotations"="ClusterNames",
"Cluster annotations (label all)"="ClusterNamesAll",
"Cluster numbers"="Clusters")
if (all(unique(attr(Clusters(d$SCV[[res()]]),"ClusterNames")) == "")) {
temp_choices <- temp_choices[3]
} else if (grepl("^Comp:",res())) {
temp_choices <- temp_choices[-1]
names(temp_choices)[1] <- "Cluster annotations"
}
radioButtons("tsneLabels","Labels:",inline=T,choices=temp_choices)
}
})
output$tsne <- renderPlot({
if (length(res()) > 0) {
plot_tsne(cell_coord=getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
md=Clusters(d$SCV[[res()]]),
md_title=NULL,
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
lab_type=input$tsneLabels
),
sel_cells=selCells())
if (input$nnArrow) {
temp_nn <- DEdistNN(DEdist(d$SCV[[res()]]))
temp_labels <- apply(getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
2,function(X) tapply(X,Clusters(d$SCV[[res()]]),mean))
sapply(names(temp_nn),function(X)
arrows(lwd=2,col=alpha("black",0.5),length=0.1,
x0=temp_labels[X,1],y0=temp_labels[X,2],
x1=temp_labels[temp_nn[[X]],1],y1=temp_labels[temp_nn[[X]],2]))
}
}
})
output$tsneSave <- downloadHandler(
filename=paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),"_CellEmbedding.",imageFileType),
content=function(file) {
if (length(res()) > 0) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=7,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=7,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=7,units="in",res=600),
"png"=grDevices::png(file,height=7,width=7,units="in",res=600))
plot_tsne(cell_coord=getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
md=Clusters(d$SCV[[res()]]),
md_title=NULL,
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
lab_type=input$tsneLabels
),
sel_cells=selCells())
if (input$nnArrow) {
temp_nn <- DEdistNN(DEdist(d$SCV[[res()]]))
temp_labels <- apply(getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
2,function(X) tapply(X,Clusters(d$SCV[[res()]]),mean))
sapply(names(temp_nn),function(X)
arrows(lwd=2,col=alpha("black",0.5),length=0.1,
x0=temp_labels[X,1],y0=temp_labels[X,2],
x1=temp_labels[temp_nn[[X]],1],y1=temp_labels[temp_nn[[X]],2]))
}
grDevices::dev.off()
}
}
)
# ^^ Cluster selection ----------------------------------------
clusterSelect <- reactiveValues(cl=NULL)
observeEvent(input$tsneClick,{ clusterSelect$cl <- input$tsneClick })
cSelected <- reactive({
t <- nearPoints(
as.data.frame(getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)]),
coordinfo=clusterSelect$cl,
xvar=input$MD_EmbDimX,yvar=input$MD_EmbDimY,threshold=5)
t2 <- Clusters(d$SCV[[res()]])[rownames(t)[1]]
if (is.na(t2)) {
return("")
} else if (t2 == "Unselected") {
return("")
} else {
return(t2)
}
})
selClust <- reactive({
if (length(res()) < 1) {
return("")
} else if (input$genePlotClust != "") {
Clusters(d$SCV[[res()]])[which(Clusters(d$SCV[[res()]]) == input$genePlotClust)[1]]
} else {
return(input$genePlotClust)
}
})
selClustName <- reactive({
attr(Clusters(d$SCV[[res()]]),"ClusterNames")[selClust()]
})
selCells <- reactive({
if (selClust() == "") {
rep(F,length(Clusters(d$SCV[[res()]])))
} else {
names(Clusters(d$SCV[[res()]]))[Clusters(d$SCV[[res()]]) %in% selClust()]
}
})
# ^^ Metadata tSNE overlay -----------------------------------------------------------
output$tsneMDcol <- renderUI({
selectInput("tsneMDcol",label="Metadata:",width="100%",choices=colnames(d$MD),
selected=grep("phase",colnames(d$MD),value=T,ignore.case=T)[1])
})
output$tsneMDlog <- renderUI({
if (!(is.factor(d$MD[[input$tsneMDcol]]) |
is.character(d$MD[[input$tsneMDcol]]))) {
if (all(d$MD[[input$tsneMDcol]] > 0)) {
checkboxGroupInput("tsneMDlog",label="Colour scale",
choices=c("Log scale"="log"),width="100%")
}
}
})
output$tsneMD <- renderPlot({
if (length(res()) > 0) {
if (length(input$tsneMDlog) > 0) {
if (input$tsneMDlog == "log") { temp_log <- T }
} else { temp_log <- F }
plot_tsne(cell_coord=getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
md=d$MD[[input$tsneMDcol]],
md_title=input$tsneMDcol,
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=temp_log,
label=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
lab_type=input$tsneLabels
),
sel_cells=selCells())
}
})
output$tsneMDSave <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),
"_CellEmbedding_",gsub("^X|[_.]","",input$tsneMDcol),".",imageFileType)
},
content=function(file) {
if (length(res()) > 0) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=7,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=7,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=7,units="in",res=600),
"png"=grDevices::png(file,height=7,width=7,units="in",res=600))
if (length(input$tsneMDlog) > 0) {
if (input$tsneMDlog == "log") { temp_log <- T }
} else { temp_log <- F }
plot_tsne(cell_coord=getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
md=d$MD[[input$tsneMDcol]],
md_title=input$tsneMDcol,
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=temp_log,
label=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
lab_type=input$tsneLabels
),
sel_cells=selCells())
grDevices::dev.off()
}
}
)
# ^^ Metadata Scatterplot ------------------------------------------------------------
output$mdScatterX <- renderUI({
temp_search <- switch(is(inD),
seurat="UMI",
SingleCellExperiment="count",
"xxxxx")
selectInput(
"mdScatterX","X axis:",choices=colnames(d$MD),
selected=ifelse(any(grepl(temp_search,colnames(d$MD),ignore.case=T)),
yes=grep(temp_search,colnames(d$MD),value=T,ignore.case=T)[1],
no=colnames(d$MD)[1])
)
})
output$mdScatterY <- renderUI({
temp_search <- switch(is(inD),
seurat="gene",
SingleCellExperiment="feature",
"xxxxx")
selectInput(
"mdScatterY","Y axis:",choices=colnames(d$MD),
selected=ifelse(any(grepl(temp_search,colnames(d$MD),ignore.case=T)),
yes=grep(temp_search,colnames(d$MD),value=T,ignore.case=T)[1],
no=colnames(d$MD)[2])
)
})
output$scatterLog <- renderUI({
temp_choices <- c()
if (is.numeric(d$MD[,input$mdScatterX]) |
is.numeric(d$MD[,input$mdScatterY]) ) {
if (is.numeric(d$MD[,input$mdScatterX])) {
if (all(d$MD[,input$mdScatterX] > 0)) {
temp_choices <- append(temp_choices,c("Log x axis"="x"))
}
}
if (is.numeric(d$MD[,input$mdScatterY])) {
if (all(d$MD[,input$mdScatterY] > 0)) {
temp_choices <- append(temp_choices,c("Log y axis"="y"))
}
}
checkboxGroupInput("scatterLog",inline=F,label=NULL,
choices=temp_choices,selected=NULL)
}
})
output$mdScatter <- renderPlot({
if (length(res()) > 0) {
plot_mdCompare(MD=d$MD,
mdX=input$mdScatterX,
mdY=input$mdScatterY,
sel_cells=selCells(),
sel_clust=selClustName(),
md_log=input$scatterLog)
}
})
output$mdScatterSave <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),"_",
gsub("^X|[_.]","",input$mdScatterX),"_vs_",
gsub("^X|[_.]","",input$mdScatterY),"_CellScatterPlot.",imageFileType)
},
content=function(file) {
if (length(res()) > 0) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=7,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=7,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=7,units="in",res=600),
"png"=grDevices::png(file,height=7,width=7,units="in",res=600))
plot_mdCompare(MD=d$MD,
mdX=input$mdScatterX,
mdY=input$mdScatterY,
sel_cells=selCells(),
sel_clust=selClustName(),
md_log=input$scatterLog)
grDevices::dev.off()
}
}
)
# ^^ Metadata Factor Barplot ---------------------------------------------------------
output$mdFactorData <- renderUI({
selectInput("mdFactorData","Metadata:",choices=colnames(d$MD),
selected=grep("phase",colnames(d$MD),value=T,ignore.case=T)[1])
})
output$mdFactorOpts <- renderUI({
if (is.factor(d$MD[,input$mdFactorData]) | is.character(d$MD[,input$mdFactorData])) {
radioButtons("mdFactorOptsF","Factor counts per cluster:",inline=T,
choices=list("Absolute"="absolute","Relative"="relative"))
} else {
if (all(d$MD[,input$mdFactorData] > 0)) {
checkboxGroupInput("mdFactorOptsN",inline=T,label="Figure options",
choices=c("Log scale"="y"),selected=NULL)
}
}
})
output$mdFactor <- renderPlot({
if (length(res()) > 0) {
if (is.character(d$MD[[input$mdFactorData]]) |
is.factor(d$MD[[input$mdFactorData]])) {
temp_opts <- input$mdFactorOptsF
} else {
if (length(input$mdFactorOptsN) == 0) {
temp_opts <- ""
} else {
temp_opts <- input$mdFactorOptsN
}
}
plot_mdPerClust(MD=d$MD,
sel=input$mdFactorData,
cl=Clusters(d$SCV[[res()]]),
opt=temp_opts,
cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"))
}
})
output$mdFactorSave <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),"_",
gsub("^X|[_.]","",input$mdFactorData),"_PerCluster.",imageFileType)
},
content=function(file) {
if (length(res()) > 0) {
if (is.character(d$MD[[input$mdFactorData]]) |
is.factor(d$MD[[input$mdFactorData]])) {
temp_opts <- input$mdFactorOptsF
} else {
if (length(input$mdFactorOptsN) == 0) {
temp_opts <- ""
} else {
temp_opts <- input$mdFactorOptsN
}
}
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=7,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=7,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=7,units="in",res=600),
"png"=grDevices::png(file,height=7,width=7,units="in",res=600))
plot_mdPerClust(MD=d$MD,
sel=input$mdFactorData,
cl=Clusters(d$SCV[[res()]]),
opt=temp_opts,
cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"))
grDevices::dev.off()
}
}
)
output$mdFactorTable <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),"_",
gsub("^X|[_.]","",input$mdFactorData),"_PerCluster.txt")
},
content=function(file) {
if (is.factor(d$MD[[input$mdFactorData]]) |
is.character(d$MD[[input$mdFactorData]])) {
outTable <- do.call(rbind,
tapply(d$MD[[input$mdFactorData]],
Clusters(d$SCV[[res()]]),
table))
rownames(outTable) <- levels(Clusters(d$SCV[[res()]]))
} else {
outTable <- do.call(rbind,
tapply(d$MD[[input$mdFactorData]],
Clusters(d$SCV[[res()]]),
summary))
rownames(outTable) <- levels(Clusters(d$SCV[[res()]]))
}
write.table(outTable,file,quote=F,sep="\t",row.names=T,col.names=NA)
}
)
# ^ Differentially Expressed Genes per Cluster -----------------------------------------
# ^^ Dotplot of DE genes per cluster -------------------------
output$heatDEtype <- renderUI({
if (length(res()) > 0) {
if (grepl("^Comp:",res())) {
temp <- list("DE vs rest"="DEvsRest",
"Set A vs Set B"="DEmarker")
} else {
temp <- list("DE vs rest"="DEvsRest",
"Marker genes"="DEmarker",
"DE vs neighbour"="DEneighb")
}
radioButtons("dotplotDEtype","Dotplot Genes:",choices=temp,selected="DEmarker")
}
})
DEgenes <- reactive({
dotplotDEgenes(sCVd=d$SCV[[res()]],
DEtype=input$dotplotDEtype,
FDRthresh=input$FDRthresh2)
})
output$DEgeneSlider <- renderUI({
if (length(res()) > 0) {
if (input$dotplotDEtype == "DEvsRest") {
temp_label <- HTML(paste(
"Positive differential gene expression of cluster over tissue",
"# of genes per cluster to show",sep="<br/>"))
} else if (input$dotplotDEtype == "DEmarker") {
if (grepl("^Comp",res())) {
temp_label <- HTML(paste(
"Positive differential gene expression between sets",
"# of genes per set to show",sep="<br/>"))
} else {
temp_label <- HTML(paste(
"Positive differential gene expression between cluster and all other clusters",
"# of genes per cluster to show",sep="<br/>"))
}
} else if (input$dotplotDEtype == "DEneighb") {
temp_label <- HTML(paste(
"Positive differential gene expression between cluster and nearest neighbour",
"# of genes per cluster to show",sep="<br/>"))
}
sliderInput("DEgeneCount",min=1,
max=max(sapply(DEgenes()[names(DEgenes()) != "Unselected"],length)),
value=5,step=1,ticks=T,width="100%",label=temp_label)
}
})
output$DEclustSelect <- renderUI({
if (length(res()) > 0) {
selectInput("DEclustNum","Cluster # for gene list",
choices=levels(Clusters(d$SCV[[res()]]))[
levels(Clusters(d$SCV[[res()]])) != "Unselected"])
}
})
output$dotplot <- renderPlot({
if (length(res()) > 0) {
plot_deDotplot(sCVd=d$SCV[[res()]],
DEgenes=DEgenes(),
DEnum=input$DEgeneCount)
}
})
output$heatmapSave <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),
"_heatmap_",input$dotplotDEtype,
"_FDR",sub("^0","",sub(".","",input$FDRthresh2,fixed=T)),
".",imageFileType)
},
content=function(file) {
if (length(res()) > 0) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=11,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=11,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=11,units="in",res=600),
"png"=grDevices::png(file,height=7,width=11,units="in",res=600))
plot_deDotplot(sCVd=d$SCV[[res()]],
DEgenes=DEgenes(),
DEnum=input$DEgeneCount)
grDevices::dev.off()
}
}
)
output$CGSsave0 <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),
"_ClustGeneStats_",
gsub("^X|[_.]","",make.names(input$DEclustNum)),".txt")
},
content=function(file) {
outTable <- ClustGeneStats(d$SCV[[res()]])[[input$DEclustNum]][,c("MGE","DR","MDGE")]
write.table(outTable,file,quote=F,sep="\t",row.names=T,col.names=NA)
}
)
output$deGeneSave <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),"_",
input$dotplotDEtype,"_",
gsub("^X|[_.]","",make.names(input$DEclustNum)),".txt")
},
content=function(file) {
outTable <- switch(
EXPR=input$dotplotDEtype,
DEvsRest=DEvsRest(d$SCV[[res()]])[[input$DEclustNum]],
DEmarker=DEmarker(d$SCV[[res()]],input$FDRthresh2)[[input$DEclustNum]],
DEneighb=DEneighb(d$SCV[[res()]],input$FDRthresh2)[[input$DEclustNum]]
)
write.table(outTable,file,quote=F,sep="\t",row.names=T,col.names=NA)
}
)
# ^ Gene Expression Distributions per Cluster ------------------------------------------
# ^^ Gene search box -----------------------------------------------------------------
output$geneSearchBox <- renderUI({
switch(input$searchType,
comma=textInput("GOI",value="Actb",width="100%",
label=paste("Enter list of genes,",
"(comma/space-separated, case-insensitive)",
"and click Search")),
regex=textInput("GOI",value="^ACTB$",width="100%",
label="Search for genes by regular expression and click Search"))
})
GOI <- eventReactive(input$GOIgo,
geneSearch(txt=as.character(input$GOI),
st=input$searchType,
CGS=ClustGeneStats(d$SCV[[res()]])[[1]]),
ignoreNULL=F)
# ^^ Scatterplot of gene expression in cluster ------------------------------------------------------
output$genePlotClustSelect <- renderUI({
if (length(res()) > 0) {
temp_cl <- c("",levels(Clusters(d$SCV[[res()]])))
names(temp_cl) <- c("",paste(levels(Clusters(d$SCV[[res()]])),
attr(Clusters(d$SCV[[res()]]),"ClusterNames"),
sep=": "))
temp_cl <- temp_cl[temp_cl != "Unselected"]
selectInput("genePlotClust",label="Cluster:",
choices=temp_cl,selected=cSelected())
}
})
output$cgLegend <- renderUI({
if (length(attr(Clusters(d$SCV[[res()]]),"cellMarkers")) > 0) {
radioButtons("cgLegend",inline=T,label="Highlighted genes:",
choices=c("Cell-type markers"="markers",
"Top DE genes (from heatmap)"="heatmap",
"Gene symbols from search box below"="search"))
} else {
radioButtons("cgLegend",inline=T,label="Highlighted genes:",
choices=c("Top DE genes (from heatmap)"="heatmap",
"Gene symbols from search box below"="search"))
}
})
clickGenes <- reactiveVal()
observeEvent(input$cgClick,{
t <- nearPoints(ClustGeneStats(d$SCV[[res()]])[[selClust()]],
input$cgClick,xvar="DR",yvar="MDGE")
temp_out <- rownames(t)
names(temp_out) <- t$genes
clickGenes(temp_out)
})
observeEvent(input$scatterClick,{
tempDF <- compareClusts_DF(sCVd=d$SCV[[res()]],
clA=input$ssA,
clB=input$ssB,
dataType=input$scatterInput)
if (input$scatterInput %in% c("MGE","MDGE","DR")) {
t <- nearPoints(tempDF,input$scatterClick,
xvar="x_diff",yvar="y_mean")
} else if (input$scatterInput == "GERvDDR") {
t <- nearPoints(tempDF,input$scatterClick,
xvar="dDR",yvar="logGER")
} else {
tempDF$FDR <- -log10(tempDF$FDR)
t <- nearPoints(tempDF,input$scatterClick,
xvar=input$scatterInput,yvar="FDR")
}
temp_out <- rownames(t)
names(temp_out) <- t$genes
clickGenes(temp_out)
})
output$clusterGenes <- renderPlot({
if (length(res()) > 0) {
switch(input$cgLegend,
markers=plot_clusterGenes_markers(
sCVd=d$SCV[[res()]],
selClust=selClust(),
cellMarkers=attr(Clusters(d$SCV[[res()]]),"cellMarkers")
),
heatmap=plot_clusterGenes_DEgenes(
sCVd=d$SCV[[res()]],
selClust=selClust(),
DEgenes=DEgenes(),
DEnum=input$DEgeneCount,
DEtype=input$dotplotDEtype
),
search=plot_clusterGenes_search(
sCVd=d$SCV[[res()]],
selClust=selClust(),
GOI=GOI()
),
{
plot(x=NA,y=NA,xlim=0:1,ylim=0:1,xaxt="n",yaxt="n",xlab=NA,ylab=NA)
text(.5,.5,"Whooops. input$cgLegend is making up words.")
})
}
}) #,res=96) # enlarge plot features in interactive session
output$clusterGenesSave <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),"_GeneExprCluster_",
gsub("^X|[_.]","",make.names(input$genePlotClust)),".",imageFileType)
},
content=function(file) {
if (length(res()) > 0) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=12,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=12,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=12,units="in",res=600),
"png"=grDevices::png(file,height=7,width=12,units="in",res=600))
switch(input$cgLegend,
markers=plot_clusterGenes_markers(
sCVd=d$SCV[[res()]],
selClust=selClust(),
cellMarkers=attr(Clusters(d$SCV[[res()]]),"cellMarkers")
),
heatmap=plot_clusterGenes_DEgenes(
sCVd=d$SCV[[res()]],
selClust=selClust(),
DEgenes=DEgenes(),
DEnum=input$DEgeneCount,
DEtype=input$dotplotDEtype
),
search=plot_clusterGenes_search(
sCVd=d$SCV[[res()]],
selClust=selClust(),
GOI=GOI()
),
{
plot(x=NA,y=NA,xlim=0:1,ylim=0:1,xaxt="n",yaxt="n",xlab=NA,ylab=NA)
text(.5,.5,"Whooops. input$cgLegend is making up words.")
})
grDevices::dev.off()
}
}
)
# ^ Gene expression comparison -------------------------------------------------------
# ^^ Gene selection by click/search --------------------------------------------------
output$cgSelect <- renderUI({
if (length(res()) > 0) {
temp_choices <- switch(input$boxplotGene,
click=clickGenes(),
search=GOI())
if (is.null(names(temp_choices))) {
temp_choices <- sort(temp_choices)
} else {
temp_choices <- temp_choices[order(names(temp_choices))]
}
selectInput("cgGene",choices=temp_choices,label="Select gene from list:")
}
})
geneNameBx <- reactive({
try(tempGN <- mapIds(annotationDB,keys=input$cgGene,keytype=rownameKeytype,
column="GENENAME",multiVals="first"),silent=T)
if (exists("tempGN")) { return(tempGN) } else { return(NULL) }
})
# ^^ Boxplots for gene expression comparison ------------------------------------------------------
output$geneTest <- renderPlot({
if (length(res()) > 0) {
plot_GEboxplot(nge=getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2]),
sCVd=d$SCV[[res()]],
gene=input$cgGene,
geneName=geneNameBx(),
opts=input$bxpOpts)
}
})
output$geneTestSave <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),
"_GeneExprBoxplot_",input$cgGene,".",imageFileType)
},
content=function(file) {
if (length(res()) > 0) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=12,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=12,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=12,units="in",res=600),
"png"=grDevices::png(file,height=7,width=12,units="in",res=600))
plot_GEboxplot(nge=getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2]),
sCVd=d$SCV[[res()]],
gene=input$cgGene,
geneName=geneNameBx(),
opts=input$bxpOpts)
grDevices::dev.off()
}
}
)
# ^ Distribution of genes of interest ------------------------------------------------
# ^^ GOI embedding type selection ####
output$GOI_EmbType <- renderUI({
temp_embs <- hasEmb(inD)
temp_embs <- temp_embs[
sapply(temp_embs,function(X) ncol(getEmb(inD,X))) >= 2 &
sapply(temp_embs,function(X) nrow(getEmb(inD,X))) == nrow(getMD(inD))
]
selectInput("GOI_EmbType",label="Select cell embedding:",
choices=temp_embs,
selected=temp_embs[length(temp_embs)])
})
output$GOI_EmbDimX <- renderUI({
selectInput("GOI_EmbDimX",label="x-axis:",
choices=colnames(getEmb(inD,input$GOI_EmbType)),
selected=colnames(getEmb(inD,input$GOI_EmbType))[1])
})
output$GOI_EmbDimY <- renderUI({
selectInput("GOI_EmbDimY",label="y-axis:",
choices=colnames(getEmb(inD,input$GOI_EmbType)),
selected=colnames(getEmb(inD,input$GOI_EmbType))[2])
})
# ^^ GOI Search boxes ####
output$geneSearchBox1 <- renderUI({
if (input$searchType1 == "comma") {
textInput("GOI1",value="Actb",width="100%",
label=paste("Enter list of genes"))
} else if (input$searchType1 == "regex") {
textInput("GOI1",value="^ACTB$",width="100%",
label="Enter regular expression")
}
})
output$geneSearchBox2 <- renderUI({
if (input$searchType2 == "comma") {
textInput("GOI2",value="Actb",width="100%",
label=paste("Search by list of genes"))
} else if (input$searchType2 == "regex") {
textInput("GOI2",value="^ACTB$",width="100%",
label="Search by regular expression")
}
})
GOI1 <- eventReactive(input$GOI1go,
geneSearch(txt=input$GOI1,
st=input$searchType1,
CGS=ClustGeneStats(d$SCV[[res()]])[[1]]))
GOI2 <- eventReactive(input$GOI2go,
geneSearch(txt=input$GOI2,
st=input$searchType2,
CGS=ClustGeneStats(d$SCV[[res()]])[[1]]))
output$GOI1select <- renderUI({
temp_choices <- GOI1()
if (is.null(names(temp_choices))) {
temp_choices <- sort(temp_choices)
} else {
temp_choices <- temp_choices[order(names(temp_choices))]
}
selectInput("goi1",label="Select genes:",choices=temp_choices)
})
output$GOI2select <- renderUI({
temp_choices <- GOI2()
if (is.null(names(temp_choices))) {
temp_choices <- sort(temp_choices)
} else {
temp_choices <- temp_choices[order(names(temp_choices))]
}
selectInput("goi2",label="Select genes:",choices=temp_choices)
})
geneNameGOI1 <- reactive({
try(tempGN <- mapIds(annotationDB,keys=input$goi1,keytype=rownameKeytype,
column="GENENAME",multiVals="first"),silent=T)
if (exists("tempGN")) {
return(paste(names(tempGN),tempGN,sep=": "))
} else {
return(input$goi1)
}
})
geneNameGOI2 <- reactive({
try(tempGN <- mapIds(annotationDB,keys=input$goi2,keytype=rownameKeytype,
column="GENENAME",multiVals="first"),silent=T)
if (exists("tempGN")) {
return(paste(names(tempGN),tempGN,sep=": "))
} else {
return(input$goi2)
}
})
# ^^ GOI plots ####
output$goiPlot1 <- renderPlot({
if (input$plotClust1 == "clust" & length(res()) > 0) {
plot_tsne(
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
md=Clusters(d$SCV[[res()]]),
md_title=NULL,
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=switch(
as.character(input$plotLabel1),
"TRUE"=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
lab_type=input$tsneLabels
),
"FALSE"=NULL
)
)
} else if (input$plotClust1 == "goi") {
if (is.null(input$goi1)) {
plot(x=NA,y=NA,xlim=0:1,ylim=0:1,xaxt="n",yaxt="n",xlab=NA,ylab=NA)
text(.5,.5,paste("To search for your gene(s) of interest,",
"type a list of genes or regex into the box above,",
"then select the gene from the drop-down list.",sep="\n"))
} else {
plot_tsne(
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
md=switch(any(is.na(c(Param(sCVdL[[1]],"exponent"),Param(sCVdL[[1]],"pseudocount")))) + 1,
getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])[input$goi1,],
log2(getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])[input$goi1,] + 1)),
md_title=geneNameGOI1(),
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=switch(
as.character(input$plotLabel1),
"TRUE"=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
lab_type=input$tsneLabels
),
"FALSE"=NULL
)
)
}
}
})
output$goiPlot2 <- renderPlot({
if (input$plotClust2 == "clust" & length(res()) > 0) {
plot_tsne(
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
md=Clusters(d$SCV[[res()]]),
md_title=NULL,
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=switch(
as.character(input$plotLabel2),
"TRUE"=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
lab_type=input$tsneLabels
),
"FALSE"=NULL
)
)
} else if (input$plotClust2 == "goi") {
if (is.null(input$goi2)) {
plot(x=NA,y=NA,xlim=0:1,ylim=0:1,xaxt="n",yaxt="n",xlab=NA,ylab=NA)
text(.5,.5,paste("To search for your gene(s) of interest,",
"type a list of genes or regex into the box above,",
"then select the gene from the drop-down list.",sep="\n"))
} else {
plot_tsne(
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
md=switch(any(is.na(c(Param(sCVdL[[1]],"exponent"),Param(sCVdL[[1]],"pseudocount")))) + 1,
getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])[input$goi2,],
log2(getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])[input$goi2,] + 1)),
md_title=geneNameGOI2(),
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=switch(
as.character(input$plotLabel2),
"TRUE"=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
lab_type=input$tsneLabels
),
"FALSE"=NULL
)
)
}
}
})
output$goiPlot1SaveButton <- renderUI({
if (input$plotClust1 == "goi") {
if (!is.null(input$goi1)) {
downloadButton("goiPlot1Save",paste("Save as",toupper(imageFileType)))
}
}
})
output$goiPlot2SaveButton <- renderUI({
if (input$plotClust2 == "goi") {
if (!is.null(input$goi2)) {
downloadButton("goiPlot2Save",paste("Save as",toupper(imageFileType)))
}
}
})
output$goiPlot1Save <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),
"_GeneExprOverlay_",input$goi1,".",imageFileType)
},
content=function(file) {
if (input$plotClust2 == "goi" & !is.null(input$goi1)) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=7,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=7,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=7,units="in",res=600),
"png"=grDevices::png(file,height=7,width=7,units="in",res=600))
plot_tsne(
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
md=switch(any(is.na(c(Param(sCVdL[[1]],"exponent"),Param(sCVdL[[1]],"pseudocount")))) + 1,
getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])[input$goi1,],
log2(getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])[input$goi1,] + 1)),
md_title=geneNameGOI1(),
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=switch(
as.character(input$plotLabel1),
"TRUE"=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
lab_type=input$tsneLabels
),
"FALSE"=NULL
)
)
grDevices::dev.off()
}
}
)
output$goiPlot2Save <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),
"_GeneExprOverlay_",input$goi2,".",imageFileType)
},
content=function(file) {
if (input$plotClust2 == "goi" & !is.null(input$goi2)) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=7,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=7,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=7,units="in",res=600),
"png"=grDevices::png(file,height=7,width=7,units="in",res=600))
plot_tsne(
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
md=switch(any(is.na(c(Param(sCVdL[[1]],"exponent"),Param(sCVdL[[1]],"pseudocount")))) + 1,
getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])[input$goi2,],
log2(getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])[input$goi2,] + 1)),
md_title=geneNameGOI2(),
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=switch(
as.character(input$plotLabel2),
"TRUE"=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
lab_type=input$tsneLabels
),
"FALSE"=NULL
)
)
grDevices::dev.off()
}
}
)
# ^ MA plot for cluster comparison ---------------------------------------------------------------
output$resSelect2 <- renderUI({
selectInput("res2","Resolution:",choices=clustList(),selected=res(),width="100%")
})
output$saveButton2 <- renderUI({
if (!is.na(outPath)) {
if (grepl("^Comp",input$res2)) {
actionButton("updateForViz2","Save this comparison to disk",icon("save"))
}
}
})
output$setScatterA <- renderUI({
if (length(res()) > 0) {
temp_cl <- c("",levels(Clusters(d$SCV[[res()]])))
names(temp_cl) <- c("",paste(levels(Clusters(d$SCV[[res()]])),
attr(Clusters(d$SCV[[res()]]),"ClusterNames"),
sep=": "))
temp_sel <- selClust()
if (grepl("^Comp:",res())) { temp_sel <- grep("Set A",temp_cl,value=T) }
selectInput("ssA",label="Cluster A (A-B comparison)",
choices=temp_cl,selected=temp_sel)
}
})
output$setScatterB <- renderUI({
if (length(res()) > 0) {
temp_cl <- c("",levels(Clusters(d$SCV[[res()]])))
names(temp_cl) <- c("",paste(levels(Clusters(d$SCV[[res()]])),
attr(Clusters(d$SCV[[res()]]),"ClusterNames"),
sep=": "))
temp_sel <- DEdistNN(DEdist(d$SCV[[res()]]))[selClust()]
if (grepl("^Comp:",res())) { temp_sel <- grep("Set B",temp_cl,value=T) }
selectInput("ssB",label="Cluster B (A-B comparison)",
choices=temp_cl,selected=temp_sel)
}
})
output$CGSsaveA <- downloadHandler(
filename=function() { paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),
"_ClustGeneStats_",input$ssA,".txt") },
content=function(file) {
outTable <- ClustGeneStats(d$SCV[[res()]])[[input$ssA]][,c("MGE","DR","MDGE")]
write.table(outTable,file,quote=F,sep="\t",row.names=T,col.names=NA)
}
)
output$CGSsaveB <- downloadHandler(
filename=function() { paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),
"_ClustGeneStats_",input$ssB,".txt") },
content=function(file) {
outTable <- ClustGeneStats(d$SCV[[res()]])[[input$ssB]][,c("MGE","DR","MDGE")]
write.table(outTable,file,quote=F,sep="\t",row.names=T,col.names=NA)
}
)
output$diffLabelChoice <- renderUI({
if (input$scatterInput == "GERvDDR" &input$diffLabelType == "diff") {
radioButtons("diffLabelChoice",label="Axis of difference:",
choices=c("Gene expression"="logGER",
"Detection rate"="dDR"))
}
})
output$diffLabelSelect <- renderUI({
if (input$diffLabelType == "diff") {
sliderInput("diffCount",min=1,max=100,value=5,step=1,width="100%",
label="Number of most different genes to label")
} else if (input$diffLabelType == "de") {
sliderInput("diffCount",min=1,max=100,value=5,step=1,width="100%",
label="Number of most significantly different genes to label")
}
})
output$setScatter <- renderPlot(
if (length(res()) > 0) {
plot_compareClusts(sCVd=d$SCV[[res()]],
clA=input$ssA,
clB=input$ssB,
dataType=input$scatterInput,
labType=input$diffLabelType,
labTypeDiff=input$diffLabelChoice,
labNum=input$diffCount,
labGenes=GOI())
}
)
output$setScatterSave <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),"_",
input$scatterInput,"_",gsub("^X|[_.]","",make.names(input$ssA)),
"_vs_",gsub("^X|[_.]","",make.names(input$ssB)),".",imageFileType)
},
content=function(file) {
if (length(res()) > 0) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=7,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=7,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=7,units="in",res=600),
"png"=grDevices::png(file,height=7,width=7,units="in",res=600))
plot_compareClusts(sCVd=d$SCV[[res()]],
clA=input$ssA,
clB=input$ssB,
dataType=input$scatterInput,
labType=input$diffLabelType,
labTypeDiff=input$diffLabelChoice,
labNum=input$diffCount,
labGenes=GOI())
grDevices::dev.off()
}
}
)
output$setComparisonSave <- downloadHandler(
filename=function() {
temp <- c(paste(input$ssA,input$ssB,sep="-"),paste(input$ssB,input$ssA,sep="-"))
tempName <- temp[temp %in% names(DEcombn(d$SCV[[res()]]))]
return(paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),
"_DEcombn_",tempName,".txt"))
},
content=function(file) {
temp <- c(paste(input$ssA,input$ssB,sep="-"),paste(input$ssB,input$ssA,sep="-"))
tempName <- temp[temp %in% names(DEcombn(d$SCV[[res()]]))]
return(write.table(DEcombn(d$SCV[[res()]])[[tempName]],
file,quote=F,sep="\t",row.names=T,col.names=NA))
}
)
# ^ Custom sets for DE ---------------------------------------------------------------
selectedSets <- reactiveValues(a=NULL,b=NULL)
# ^^ Interactive filters ---------------------------------------------------
output$tsneSelDEcol <- renderUI({
selectInput("tsneSelDEcol","Metadata overlay and cell filtering:",
choices=c(paste("Clusters:",res()),colnames(d$MD)))
})
output$DEorSubset <- renderUI({
if (is.na(outPath)) {
radioButtons("DEorSubset",inline=T,
label="Select cells for:",
choiceValues=c("DE","subset"),
choiceNames=c("DE testing","Subsetting (not available)"))
} else {
radioButtons("DEorSubset",inline=T,
label="Select cells for:",
choiceValues=c("DE","subset"),
choiceNames=c("DE testing","Subsetting data object"))
}
})
output$NoSubsetWarning <- renderUI({
if (is.na(outPath)) {
em("Manual subsetting is not available on shiny.baderlab.org")
}
})
output$addCellsA <- renderUI({
if (input$DEorSubset == "DE") {
actionButton("addCellsA","Set A: Add Cells",icon("plus"),
style="color: #fff; background-color: #a50026")
} else if (input$DEorSubset == "subset") {
actionButton("addCells2","Add Cells To Set",icon("plus"),
style="color: #fff; background-color: #a50026")
} else {
stop("DEorSubset radio button output broke")
}
})
output$addCellsB <- renderUI({
if (input$DEorSubset == "DE") {
actionButton("addCellsB","Set B: Add Cells",icon("plus"),
style="color: #fff; background-color: #313695")
} else if (input$DEorSubset == "subset") {
actionButton("removeCells2","Remove Cells From Set",icon("minus"),
style="color: #a50026; background-color: #fff; border-color: #a50026")
} else {
stop("DEorSubset radio button output broke")
}
})
output$removeCellsA <- renderUI({
if (input$DEorSubset == "DE") {
actionButton("removeCellsA","Set A: Remove Cells",icon("minus"),
style="color: #a50026; background-color: #fff; border-color: #a50026")
}
})
output$removeCellsB <- renderUI({
if (input$DEorSubset == "DE") {
actionButton("removeCellsB","Set B: Remove Cells",icon("minus"),
style="color: #313695; background-color: #fff; border-color: #313695")
}
})
output$DEsetName <- renderUI({
if (input$DEorSubset == "DE") {
textInput("DEsetName","Short name for this comparison:",
placeholder="A-z0-9_ only please")
}
})
output$calcDE <- renderUI({
if (input$DEorSubset == "DE") {
actionButton("calcDE","Calculate differential gene expression",icon("play"))
} else if (input$DEorSubset == "subset") {
if (!is.na(outPath)) {
downloadButton("DownloadSubset",
paste("Download",is(inD)[1],"object of selected cells"))
}
} else {
stop("DEorSubset radio button output broke")
}
})
output$DownloadSubset <- downloadHandler(
filename=function() { paste0(dataTitle,"_NameYourCellSubset.rds") },
content=function(file) {
temp <- subsetCells(inD,selectedSets$a)
if (is(temp) == is(inD)) {
saveRDS(temp,file=file)
} else {
stop("subsetCells failed to output data object")
}
}
)
output$calcText <- renderUI({
if (input$DEorSubset == "DE") {
span(textOutput("calcText"),style="color:red")
} else if (input$DEorSubset == "subset") {
HTML(
paste0("Compressing and saving RDS file will take time.<br/>",
"RDS files can be loaded into your R session with:<br/>",
"<code>my_subset <- readRDS('my_file.rds')</code>")
)
}
})
filtList <- reactiveValues(filts=NULL)
observeEvent(input$plusFilt,{
filtList$filts <- unique(c(filtList$filts,input$tsneSelDEcol))
})
observeEvent(input$minusFilt,{
filtList$filts <- filtList$filts[-which(filtList$filts == input$tsneSelDEcol)]
})
observeEvent(input$minusFiltALL,{ filtList$filts <- NULL })
filtValues <- reactive({
sapply(filtList$filts,function(MD) {
if (MD == paste("Clusters:",res())) {
temp_inputSlot <- "MDpicker_clusts"
} else {
temp_inputSlot <- paste0("MDpicker_",which(colnames(d$MD) == MD))
}
return(input[[temp_inputSlot]])
},simplify=F)
})
makeMDpicker <- reactive({
lapply(filtList$filts,function(MD) {
temp_val <- isolate(filtValues()[[MD]])
if (MD == "") {
} else if (MD == paste("Clusters:",res())) {
selectInput("MDpicker_clusts",label="Select cluster(s):",
choices=levels(Clusters(d$SCV[[res()]])),
multiple=T,selected=temp_val)
} else if (is.factor(d$MD[,MD]) | is.character(d$MD[,MD])) {
selectInput(paste0("MDpicker_",which(colnames(d$MD) == MD)),
label=paste0("Select cells by ",MD,":"),
choices=levels(as.factor(d$MD[,MD])),
multiple=T,selected=temp_val)
} else {
if (is.null(temp_val)) { temp_val <- range(d$MD[,MD]) }
sliderInput(paste0("MDpicker_",which(colnames(d$MD) == MD)),
label=paste0("Select cells by ",MD," range:"),
min=min(d$MD[,MD]),max=max(d$MD[,MD]),value=temp_val)
}
})
})
output$MDfilts <- renderUI({ makeMDpicker() })
output$MDfiltsRemoveAll <- renderUI({
if (length(filtList$filts) > 0) {
actionButton("minusFiltALL","Remove all filters",icon("minus"),
style="color: #008000; background-color: #fff; border-color: #008000")
}
})
# ^^ SelDE embedding type selection ####
output$SelDE_EmbType <- renderUI({
temp_embs <- hasEmb(inD)
temp_embs <- temp_embs[
sapply(temp_embs,function(X) ncol(getEmb(inD,X))) >= 2 &
sapply(temp_embs,function(X) nrow(getEmb(inD,X))) == nrow(getMD(inD))
]
selectInput("SelDE_EmbType",label="Embedding:",
choices=temp_embs,
selected=temp_embs[length(temp_embs)])
})
output$SelDE_EmbDimX <- renderUI({
selectInput("SelDE_EmbDimX",label="x-axis:",
choices=colnames(getEmb(inD,input$SelDE_EmbType)),
selected=colnames(getEmb(inD,input$SelDE_EmbType))[1])
})
output$SelDE_EmbDimY <- renderUI({
selectInput("SelDE_EmbDimY",label="y-axis:",
choices=colnames(getEmb(inD,input$SelDE_EmbType)),
selected=colnames(getEmb(inD,input$SelDE_EmbType))[2])
})
# ^^ Plot selDE tSNE -------------------------------------------------------
output$tsneSelDE <- renderPlot({
if (length(res()) == 0) {
plot(x=NA,y=NA,xlim=0:1,ylim=0:1,xaxt="n",yaxt="n",xlab=NA,ylab=NA)
text(.5,.5,paste("Select a clustering resolution in the first plot",
"by clicking 'View clusters at this resolution'",
"before using this tool.",sep="\n"))
} else {
if (input$tsneSelDEcol == paste("Clusters:",res())) {
plot_tsne(
cell_coord=getEmb(inD,input$SelDE_EmbType)[,c(input$SelDE_EmbDimX,input$SelDE_EmbDimY)],
md=Clusters(d$SCV[[res()]]),
md_title=NULL,
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$SelDE_EmbType)[,c(input$SelDE_EmbDimX,input$SelDE_EmbDimY)],
lab_type="Clusters"
),
sel_cells=currSel(),
sel_cells_A=selectedSets$a,
sel_cells_B=selectedSets$b
)
} else {
plot_tsne(
cell_coord=getEmb(inD,input$SelDE_EmbType)[,c(input$SelDE_EmbDimX,input$SelDE_EmbDimY)],
md=d$MD[[input$tsneSelDEcol]],
md_title=input$tsneSelDEcol,
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=NULL,
sel_cells=currSel(),
sel_cells_A=selectedSets$a,
sel_cells_B=selectedSets$b
)
}
}
})
# ^^ Cell selection from filters and/or brush ------------------------------
currSel <- reactive({
temp_points <- rownames(brushedPoints(
as.data.frame(getEmb(inD,input$SelDE_EmbType)[,c(input$SelDE_EmbDimX,input$SelDE_EmbDimY)]),
input$tsneSelDEbrush,
xvar=input$SelDE_EmbDimX,yvar=input$SelDE_EmbDimY
))
temp_picker <- sapply(names(filtValues()),function(X) {
if (length(filtValues()[[X]]) < 1) {
rep(T,nrow(d$MD))
} else {
if (X == paste("Clusters:",res())) {
Clusters(d$SCV[[res()]]) %in% filtValues()[[X]]
} else if (is.factor(d$MD[,X]) | is.character(d$MD[,X])) {
d$MD[,X] %in% filtValues()[[X]]
} else {
d$MD[,X] >= filtValues()[[X]][1] & d$MD[,X] <= filtValues()[[X]][2]
}
}
},simplify=F)
temp_picker <- as.logical(Reduce("*",temp_picker))
if (length(temp_points) > 0 & length(temp_picker) > 0) {
return(rownames(d$MD)[rownames(d$MD) %in% temp_points & temp_picker])
} else if (length(temp_picker) > 0 & !all(temp_picker)) {
return(rownames(d$MD)[temp_picker])
} else if (length(temp_points) > 0) {
return(temp_points)
} else { return(character()) }
})
output$cellsHovered <- renderText(
paste("Hovering over cell(s):",
paste(rownames(nearPoints(
as.data.frame(getEmb(inD,input$SelDE_EmbType)[,c(input$SelDE_EmbDimX,input$SelDE_EmbDimY)]),
input$tsneSelDEhover,
xvar=input$SelDE_EmbDimX,yvar=input$SelDE_EmbDimY
)),collapse=", "))
)
observeEvent(input$addCellsA,{
selectedSets$a <- unique(c(selectedSets$a,currSel()))
})
observeEvent(input$removeCellsA,{
selectedSets$a <- selectedSets$a[!selectedSets$a %in% currSel()]
})
observeEvent(input$addCells2,{
selectedSets$a <- unique(c(selectedSets$a,currSel()))
})
observeEvent(input$removeCells2,{
selectedSets$a <- selectedSets$a[!selectedSets$a %in% currSel()]
})
observeEvent(input$addCellsB,{
selectedSets$b <- unique(c(selectedSets$b,currSel()))
})
observeEvent(input$removeCellsB,{
selectedSets$b <- selectedSets$b[!selectedSets$b %in% currSel()]
})
observeEvent({ input$DEorSubset == "subset" },{ selectedSets$b <- NULL })
output$textSetA <- renderText(
if (input$DEorSubset == "DE") {
paste(length(selectedSets$a),"cells in Set A.")
} else if (input$DEorSubset == "subset") {
paste(length(selectedSets$a),"cells in selected set.")
} else {
stop("DEorSubset radio button output broke")
}
)
output$textSetB <- renderText(
if (input$DEorSubset == "DE") {
paste(length(selectedSets$b),"cells in Set B.")
} else if (input$DEorSubset == "subset") {
" "
} else {
stop("DEorSubset radio button output broke")
}
)
output$textOverlap <- renderText(
if (input$DEorSubset == "DE") {
if (length(intersect(selectedSets$a,selectedSets$b)) > 0) {
paste(length(intersect(selectedSets$a,selectedSets$b)),"cells in both sets.",
"Cells must be assigned to a single set prior to calculation.")
}
}
)
# ^^ Do the DE calcs -------------------------------------------------------
observeEvent(input$calcDE,{
newRes <- paste0("Comp:",gsub("[^A-Za-z0-9_]","",input$DEsetName))
if (length(intersect(selectedSets$a,selectedSets$b)) > 0) {
output$calcText <- renderText("Sets can't overlap (please assign cells to only one set).")
} else if (any(sapply(list(selectedSets$a,selectedSets$b),length) < 3)) {
output$calcText <- renderText("Each set must contain at least 3 cells.")
} else if (nchar(input$DEsetName) < 1) {
output$calcText <- renderText("Please name this comparison (in text box above).")
} else if (newRes %in% names(d$SCV)) {
output$calcText <- renderText("This comparison name has already been used.")
} else {
output$calcText <- renderText("")
withProgress({
# temp_warn <- options("warn")
# options(warn=-1)
temp <- rep("Unselected",ncol(getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])))
names(temp) <- colnames(getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2]))
temp[selectedSets$a] <- "Set A"
temp[selectedSets$b] <- "Set B"
d$SCV[[newRes]] <- sCVdata(Clusters=factor(temp,levels=c("Set A","Set B")),
params=Param(d$SCV[[1]]))
# ^^^ Gene stats per set --------------------------------------------------------
incProgress(amount=1/5,detail="Set gene stats")
# ClustGeneStats(d$SCV[[newRes]]) <- fx_calcCGS(nge=getExpr(inD,Param(sCVdL[[1]],"assayType")),
# cl=Clusters(d$SCV[[newRes]]),
# exponent=Param(d$SCV[[newRes]],
# "exponent"),
# pseudocount=Param(d$SCV[[newRes]],
# "pseudocount"))
ClustGeneStats(d$SCV[[newRes]]) <- CalcCGS(d$SCV[[newRes]],inD)
d$SCV[[newRes]] <- labelCellTypes(sCV=d$SCV[[newRes]],
cellMarkers=cellMarkers,
symbolMap=symbolMap)
# ^^^ deTissue - DE per cluster vs all other data -------------------------------
incProgress(amount=1/5,detail="Set vs All")
# deTes <- fx_calcESvsRest(nge=getExpr(inD,Param(sCVdL[[1]],"assayType")),
# cl=Clusters(d$SCV[[newRes]]),
# CGS=ClustGeneStats(d$SCV[[newRes]]),
# exponent=Param(d$SCV[[newRes]],
# "exponent"),
# pseudocount=Param(d$SCV[[newRes]],
# "pseudocount"),
# DRthresh=Param(d$SCV[[newRes]],
# "DRthresh"))
# incProgress(amount=1/6,detail="DE vs tissue Wilcoxon rank sum calculations")
# DEvsRest(d$SCV[[newRes]]) <- fx_calcDEvsRest(nge=getExpr(inD,Param(sCVdL[[1]],"assayType")),
# cl=Clusters(d$SCV[[newRes]]),
# deTes=deTes)
DEvsRest(d$SCV[[newRes]]) <- CalcDEvsRest(d$SCV[[newRes]],inD)
# ^^^ DEmarker - DE per cluster vs each other cluster ---------------------------
incProgress(amount=2/5,detail="Set A vs Set B")
# deMes <- fx_calcEScombn(cl=Clusters(d$SCV[[newRes]]),
# CGS=ClustGeneStats(d$SCV[[newRes]]),
# DRthresh=Param(d$SCV[[newRes]],
# "DRthresh"))
# DEcombn(d$SCV[[newRes]]) <- fx_calcDEcombn(nge=getExpr(inD,Param(sCVdL[[1]],"assayType")),
# cl=Clusters(d$SCV[[newRes]]),
# deMes=deMes)
DEcombn(d$SCV[[newRes]]) <- CalcDEcombn(d$SCV[[newRes]],inD)
incProgress(amount=1/5,detail="Done")
selectedSets$a <- selectedSets$b <- NULL
filtList$filts <- NULL
# options(warn=temp_warn$warn)
},message="Calculating:")
res(newRes) # Automatically update the view to show the calculated results.
}
})
# ^^ Save buttons for set comparison ----
observeEvent(input$updateForViz, {
withProgress({
comp_sCVd <- d$SCV[input$res]
ClustGeneStats(comp_sCVd[[input$res]]) <- sapply(ClustGeneStats(comp_sCVd[[input$res]]),
function(X) X[,c("DR","MDGE","MGE")],
simplify=F)
incProgress(.5)
save(comp_sCVd,file=paste0(dataPath,dataTitle,"_selDE_",
sub("Comp:","",input$res,fixed=T),".RData"))
},message=paste0(
"Saving ",dataTitle,"_selDE_",sub("Comp:","",input$res,fixed=T),".RData to ",dataPath))
})
observeEvent(input$updateForViz2, {
withProgress({
comp_sCVd <- d$SCV[input$res]
ClustGeneStats(comp_sCVd[[input$res]]) <- sapply(ClustGeneStats(comp_sCVd[[input$res]]),
function(X) X[,c("DR","MDGE","MGE")],
simplify=F)
incProgress(.5)
save(comp_sCVd,file=paste0(dataPath,dataTitle,"_selDE_",
sub("Comp:","",input$res,fixed=T),".RData"))
},message=paste0(
"Saving ",dataTitle,"_selDE_",sub("Comp:","",input$res,fixed=T),".RData to ",dataPath))
})
}
# shinyApp ----
shinyApp(ui,server,options=list(...))
}
BaderLab/scClustViz documentation built on Sept. 10, 2023, 11:51 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions runShiny
Documented in runShiny
#' Run the scClustViz Shiny app
#'
#' This command runs the Shiny interactive visualization from a saved data file.
#'
#' @param filePath A character vector giving the relative filepath to an RData
#' file containing two objects: the \code{\link{sCVdata}} object generated by
#' \code{\link{CalcAllSCV}}, and the input scRNAseq data object.
#' @param outPath Optional. If you'd like to save/load any analysis files
#' to/from a different directory than the input directory (for example, if
#' you're using data from a package), specify that directory here. Otherwise
#' any files generated by the Shiny app (ie. saving the selected cluster
#' solution, saving custom set DE testing results) will be saved/loaded in
#' \code{filePath}. If you'd like to prevent users from saving anything to
#' disk (ie when hosting a web service) set this to NA.
#' @param cellMarkers Optional. If you have canonical marker genes for expected
#' cell types, list them here (see example code below). Note that the gene
#' names must match rownames of your data (ie. use ensembl IDs if your gene
#' expression matrix rownames are ensembl IDs). The Shiny app will attempt to
#' label clusters in the tSNE projection by highest median gene expression.
#' See \code{\link{labelCellTypes}} for more information.
#' @param annotationDB Optional. An AnnotationDbi object for your data's species
#' (ie. \code{\link[org.Mm.eg.db]{org.Mm.eg.db}} /
#' \code{\link[org.Hs.eg.db]{org.Hs.eg.db}} for mouse / human respectively).
#' If present, gene names will be shown in gene-specific figures, official
#' gene symbols (instead of your rownames) will be displayed in figures, and
#' gene searches performed using both official gene symbols and your rownames.
#' If the gene IDs in your data aren't official gene symbols, using this
#' argument will make the visualization tool much more useful.
#' @param rownameKeytype Optional. A character vector indicating the
#' AnnotationDbi keytype (see
#' \code{\link[AnnotationDbi]{keytypes}(annotationDB)}) that represents your
#' rownames. If the annotationDB argument is present and this is missing, the
#' function will assume the rownames are official gene symbols. If less than
#' 80% of rownames map to official gene symbols, the function will try to
#' predict the appropriate keytype of the rownames (this takes a bit of time).
#' @param imageFileType Default="png". The file format for saved figures. One of
#' \code{"pdf"} (generated with \code{\link[grDevices]{cairo_pdf}}),
#' \code{"eps"} (generated with \code{\link[grDevices]{cairo_ps}}),
#' \code{"tiff"} (generated with \code{\link[grDevices]{tiff}}), or
#' \code{"png"} (generated with \code{\link[grDevices]{png}}). Note that \code{"pdf"}
#' and \code{"eps"} outputs require the cairo graphics library. Check to see if R can
#' find it on your computer by running \code{capabilities("cairo")}.
#' @param includeHeadHTML Default=NA. If you'd like an HTML script to be included
#' the webpage <head> section (such as the Google Analytics tracking script,
#' see https://shiny.rstudio.com/articles/google-analytics.html), pass the
#' path to the script HTML file here.
#' @param ... Named options that should be passed to the
#' \code{\link[shiny]{runApp}} call (these can be any of the following:
#' "port", "launch.browser", "host", "quiet", "display.mode" and "test.mode").
#'
#' @return The function causes the scClustViz Shiny GUI app to open in a
#' seperate window.
#'
#' @examples
#' \dontrun{
#' your_cluster_columns <- grepl("res[.0-9]+$",
#' names(getMD(your_scRNAseq_data_object)))
#' # ^ Finds the cluster columns of the metadata in a Seurat object.
#'
#' your_cluster_results <- getMD(your_scRNAseq_data_object)[,your_cluster_columns]
#'
#' sCVdata_list <- CalcAllSCV(inD=your_scRNAseq_data_object,
#' clusterDF=your_cluster_results,
#' exponent=exp(1),
#' pseudocount=1,
#' DRthresh=0.1,
#' DRforClust="pca",
#' testAll=F,
#' FDRthresh=0.05,
#' calcSil=T,
#' calcDEvsRest=T,
#' calcDEcombn=T)
#'
#' save(your_scRNAseq_data_object,sCVdata_list,
#' file="for_scClustViz.RData")
#'
#' # Lets assume this is data from an embryonic mouse cerebral cortex:
#' # (This is the function call wrapped by MouseCortex::viewMouseCortex("e13"))
#' runShiny(filePath="for_scClustViz.RData",
#' outPath="./",
#' # Save any further analysis performed in the app to the
#' # working directory rather than library directory.
#' annotationDB="org.Mm.eg.db",
#' # This is an optional argument, but will add annotations.
#' cellMarkers=list("Cortical precursors"=c("Mki67","Sox2","Pax6",
#' "Pcna","Nes","Cux1","Cux2"),
#' "Interneurons"=c("Gad1","Gad2","Npy","Sst","Lhx6",
#' "Tubb3","Rbfox3","Dcx"),
#' "Cajal-Retzius neurons"="Reln",
#' "Intermediate progenitors"="Eomes",
#' "Projection neurons"=c("Tbr1","Satb2","Fezf2",
#' "Bcl11b","Tle4","Nes",
#' "Cux1","Cux2","Tubb3",
#' "Rbfox3","Dcx")
#' )
#' # This is a list of canonical marker genes per expected cell type.
#' # The app uses this list to automatically annotate clusters.
#' )
#'
#' }
#'
#' @seealso \code{\link{sCVdata}} for the input data type, and
#' \code{\link{CalcAllSCV}} or \code{\link{CalcSCV}} to do the calculations
#' necessary for this function.
#'
#' @include shinyModules.R
#'
#' @export
#'
runShiny <- function(filePath,outPath,
cellMarkers=list(),
annotationDB,rownameKeytype,
imageFileType="png",
includeHeadHTML=NA,
...) {
if (is.na(includeHeadHTML)) {
includeHeadHTML <- system.file("blank.html",package="scClustViz")
}
# ^ Load data from file ------------------------------------------------------------------
while(T) {
if (exists(".lastFilePath") & exists(".lastFileCall")) {
if (.lastFilePath == filePath) {
if (exists(.lastFileCall[1]) & exists(.lastFileCall[2])) {
lfc <- .lastFileCall
warning(paste("Skipping file loading. Reading the following",
"previously-loaded data from R environment:",
.lastFileCall[1],.lastFileCall[2],sep="\n"))
break
} else {
rm(.lastFileCall,.lastFilePath,envir=.GlobalEnv)
}
} else {
rm(.lastFileCall,.lastFilePath,envir=.GlobalEnv)
}
} else {
.lastFilePath <<- filePath
.lastFileCall <<- lfc <- load(filePath,envir=.GlobalEnv)
break
}
}
# The above weird-ass loop (or weird ass-loop if you prefer) checks to see if
# the file has already been loaded (if this function has been run previously
# this session), otherwise loads the file.
names(lfc) <- sapply(seq_along(lfc),function(X) {
if (is(get(lfc[X]))[1] %in% findMethodSignatures(getExpr)) {
return("inD")
}
if (is(get(lfc[X]))[1] == "sCVdata") {
return("sCV")
}
if (is(get(lfc[X]))[1] == "list") {
if (is(get(lfc[X])[[1]]) == "sCVdata") {
return("sCVdL")
} else {
stop("Unexpected input object. Missing CalcAllSCV output object.")
}
} else {
stop("Unexpected input object. Missing single-cell data object.")
}
})
if (any(names(lfc) == "sCV")) {
temp_sCVdL <- list(clusters=get(lfc["sCV"]))
lfc["sCVdL"] <- "temp_sCVdL"
# lfc <- lfc[-which(names(lfc) == "sCV")]
}
temp_missing_files <- setdiff(c("inD","sCVdL"),names(lfc))
if (length(temp_missing_files) > 0) {
stop(paste("Unexpected input object. Missing",
switch(temp_missing_files,
inD="single-cell data object.",
sCVdL="CalcAllSCV output object.")))
}
inD <- get(lfc["inD"])
sCVdL <- get(lfc["sCVdL"])
# ^^ dataPath & dataTitle --------------------------------------------------------------
temp_dataPath <- strsplit(filePath,"/|\\\\")
dataPath <- sub(temp_dataPath[[1]][length(temp_dataPath[[1]])],"",filePath)
if (dataPath == "") { dataPath <- "./" }
dataTitle <- sub("\\.[^.]+$","",tail(temp_dataPath[[1]],1))
rm(temp_dataPath)
if (!missing(outPath)) {
if (!is.na(outPath)) {
if (!grepl("[/\\]$",outPath)) {
outPath <- paste0(outPath,"/")
}
}
}
# Seperates the file name (which becomes the dataTitle) from the path (which
# becomes dataPath). This is used when saving and loading various things in
# the app (default cluster solution, custom set DE results).
# ^^ Load saved comparisons (if any) ---------------------------------------------------
if (!missing(outPath)) { #Load from both dataPath and outPath if outPath exists.
if (!is.na(outPath)) {
for (selDEfile in grep(paste0("^",dataTitle,".+selDE.+RData$"),list.files(outPath),value=T)) {
temp <- load(paste0(outPath,selDEfile))
if (is.list(get(temp))) {
if (all(sapply(get(temp),function(X) "sCVdata" %in% is(X)))) {
sCVdL <- append(sCVdL,get(temp))
}else {
warning(paste(selDEfile,"is not a valid list of sCVdata object(s)."))
}
} else {
warning(paste(selDEfile,"is not a valid list of sCVdata object(s)."))
}
rm(list=temp)
}
}
}
for (selDEfile in grep(paste0("^",dataTitle,"_selDE.+RData$"),list.files(dataPath),value=T)) {
temp <- load(paste0(dataPath,selDEfile))
if (is.list(get(temp))) {
if (all(sapply(get(temp),function(X) "sCVdata" %in% is(X)))) {
sCVdL <- append(sCVdL,get(temp))
}else {
warning(paste(selDEfile,"is not a valid list of sCVdata object(s)."))
}
} else {
warning(paste(selDEfile,"is not a valid list of sCVdata object(s)."))
}
rm(list=temp)
}
#### MEMORY USAGE SHENANIGANS? ####
# Load in the custom DE results from the same directory as the input file and
# add them to the relevant lists. THIS MIGHT DOUBLE MEMORY USAGE since the
# objects are now being modified from the versions stored in the list objects
# stored in the global environment, which might mean assigning them to a
# separate address in memory. CHECK ON THIS!
# ^^ Load default cluster solution (if any) --------------------------------------------
savedRes <- NULL
if (file.exists(paste0(dataPath,dataTitle,"_savedRes.RData"))) {
load(paste0(dataPath,dataTitle,"_savedRes.RData"))
}
if (!missing(outPath)) {
if (!is.na(outPath)) {
if (file.exists(paste0(outPath,dataTitle,"_savedRes.RData"))) {
load(paste0(outPath,dataTitle,"_savedRes.RData"))
}
}
}
if (is.null(savedRes) & length(sCVdL) == 1) {
savedRes <- names(sCVdL)
}
# Load the default cluster solution from the user-provided filepath (outPath)
# preferentially, otherwise load from the same directory as the input file. If
# neither exist, set to NULL. If there's no default solution but there's only
# one cluster solution in the sCVdata list, just use it. This is actually
# accomplished by overwriting the initial NULL up to two times if they both
# exist, but since it's a single character string it's not appreciably slower.
# ^^ Generate blank preamble if none saved -------------------------------------
introPath <- paste0(dataPath,dataTitle,"_intro.md")
if (!missing(outPath)) {
if (!is.na(outPath)) {
if (file.exists(paste0(outPath,dataTitle,"_intro.md"))) {
introPath <- paste0(outPath,dataTitle,"_intro.md")
}
}
}
# Generate a section of preamble text in markdown that the user can edit.
if (!file.exists(introPath)) {
write(paste0(dataTitle,": You can add to this preamble by editting ",introPath),
file=introPath)
}
# Done loading, now set dataPath so that things saved go to the right place.
if (!missing(outPath)) {
if (!is.na(outPath)) {
dataPath <- outPath
}
} else {
outPath <- dataPath
}
if (!imageFileType %in% c("pdf","eps","png","tiff")) {
warning('imageFileType must be one of c("pdf","eps","png","tiff"). Setting to "pdf".')
imageFileType <- "pdf"
}
# ^ Helper calcs for Shiny -----------------------------------------------------
# ^^ Map rownames to gene symbol -------------------
symbolMap <- NULL
if (!missing(annotationDB)) {
if (is.character(annotationDB)) {
require(annotationDB,quietly=T,character.only=T)
annotationDB <- get(annotationDB)
}
if (missing(rownameKeytype)) {
rownameKeytype <- findKeyType(rownames(getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])),
annotationDB)
}
symbolMap <- map2symbol(getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2]),
annotationDB,
rownameKeytype)
}
# ^^ Cell type annotation from cellMarkers ----------
sCVdL <- sapply(sCVdL,
FUN=labelCellTypes,
cellMarkers=cellMarkers,
symbolMap=symbolMap,
simplify=F)
# UI -------------------------------------------------------------------------------------
ui <- fixedPage(
tags$head(includeHTML(includeHeadHTML)),
fixedRow(
titlePanel(paste("scClustViz -",dataTitle)),
includeMarkdown(introPath)
),
hr(),
# ^ Clustering Solution Selection ------------------------------------------------------
#### TEMPORARY WARNING ####
fixedRow(
p(HTML(paste(
"<b>Please note:</b>",
"scClustViz is currently suffering from a bug causing plots to <em>temporarily</em> fail to load.",
"The current work-around is to toggle an input to the plot - for interactive plots",
"such as the first figure below left, attempting to zoom in/out,",
"and for others, switching an input (such as swapping between PCA and tSNE/UMAP for",
"the cell embedding plot). We're sorry for the inconvenience, and are working to",
"find and squash the bug now.")),style="color:red")
),
fixedRow(
titlePanel("Clustering Solution Selection"),
p(paste(
"Here you can compare the results of clustering at different resolutions to",
"determine the appropriate clustering solution for your data. You can see the",
"cluster solutions represented as boxplots on the left, where each boxplot",
"represents the number of genes differentially expressed between each cluster",
"and its nearest neighbour, or marker genes per cluster. The cluster selected",
"in the pulldown menu is highlighted in red, and the silhouette plot for that",
"cluster is shown on the right. The plot can be zoomed by clicking and dragging",
"to select a region to view, and double-clicking to zoom to it. Double-click",
"again to revert view to default."
)),
p(paste(
"A silhouette plot is a horizontal barplot where each bar is a cell, grouped by",
"cluster. The width of each bar represents the difference between mean distance",
"to other cells within the cluster and mean distance to cells in the nearest",
"neighbouring cluster. Distance is Euclidean in reduced dimensional space.",
"Positive silhouettes indicate good cluster cohesion."
)),
p(HTML(paste(
"Once you've selected an appropriate cluster solution (we suggest picking one",
"where all nearest neighbouring clusters have differentially expressed genes",
"between them), click <b>View clusters at this resolution</b> to proceed. If you",
"want to save this cluster solution as the default for next time, click <b>Save",
"this resolution as default</b>. All figures can be downloaded by clicking",
"the buttons next to each figure."
))),
h1()
),
fixedRow(
column(6,
fixedRow(column(6,uiOutput("resSelect"),align="left"),
column(6,align="right",
actionButton("go","View clusters at this resolution",icon("play"),
style="color: #fff; background-color: #008000"),
uiOutput("saveButton")
)
),
fixedRow(
column(9,uiOutput("deType")),
column(3,uiOutput("FDRthresh1"),align="right")
),
plotOutput("clustSep",height="500px",
dblclick="clustSep_dblclick",
brush=brushOpts(id="clustSep_brush",resetOnNew=T)
)),
column(6,plotOutput("sil",height="670px"))
),
fixedRow(
column(6,downloadButton("clustSepSave",paste("Save as",toupper(imageFileType))),align="left"),
column(6,downloadButton("silSave",paste("Save as",toupper(imageFileType))),align="right")
),
hr(),
# ^ Dataset and Cluster Metadata Inspection --------------------------------------------
fixedRow(
titlePanel("Dataset and Cluster Metadata Inspection"),
p(paste(
"Here you can explore your dataset as a whole: cluster assignments for all",
"cells; metadata overlays for cell projections; and figures for comparing",
"both numeric and categorical metadata.")),
h1()
),
fixedRow(
column(8,
p(HTML(paste(
"The top two figures show cells projected into 2D space using one of the",
"dimensionality reductions calculated in your data object. For example,",
"tSNE and UMAP place cells in space such that proximity indicates transcriptional",
"similarity. PCA is a common input for clustering and cell embedding, and it's",
"important to ensure components don't strongly correlate with technical features.",
"On the left you can see cluster assignments and the nearest neighbours used in",
"the differential expression calculations. If cell type marker genes were",
"provided in RunVizScript.R, it will also show predicted cell type annotations.",
"On the right you can add a metadata overlay to the cell projection.",
"<b>You can select any cluster for further assessment by clicking on a cell",
"from that cluster in the left figure.</b>"
)))
),
column(4,uiOutput("MD_EmbType"),
fixedRow(
column(6,uiOutput("MD_EmbDimX")),
column(6,uiOutput("MD_EmbDimY"))
)
)
),
fixedRow(
column(6,
uiOutput("tsneLabels"),
checkboxInput("nnArrow",value=F,width="100%",
label="Show nearest neighbouring clusters by differential expression score.")
),
column(4,uiOutput("tsneMDcol")),
column(2,uiOutput("tsneMDlog"))
),
fixedRow(
column(6,plotOutput("tsne",height="580px",click="tsneClick")),
column(6,plotOutput("tsneMD",height="580px"))
),
fixedRow(
column(6,align="left",downloadButton("tsneSave",paste("Save as",toupper(imageFileType)))),
column(6,align="right",downloadButton("tsneMDSave",paste("Save as",toupper(imageFileType))))
),
hr(),
fixedRow(
p(paste(
"Below",
"you can view relationships in the metadata as a scatterplot or compare clusterwise",
"distributions of metadata as bar- or box-plots. If you select a cluster of interest",
"(by clicking on a cell in the top-left plot, or from the list two sections down)",
"it will be highlighted for comparison in these figures."
)),
h1(),
column(2,uiOutput("mdScatterX")),
column(2,uiOutput("mdScatterY")),
column(2,uiOutput("scatterLog")),
column(3,uiOutput("mdFactorData")),
column(3,uiOutput("mdFactorOpts"))
),
fixedRow(
column(6,plotOutput("mdScatter",height="560px")),
column(6,plotOutput("mdFactor",height="560px"))
),
fixedRow(
column(6,align="left",downloadButton("mdScatterSave",paste("Save as",toupper(imageFileType)))),
column(4,align="right",downloadButton("mdFactorSave",paste("Save as",toupper(imageFileType)))),
column(2,align="right",downloadButton("mdFactorTable","Download metadata per cluster"))
),
hr(),
# ^ Differentially Expressed Genes per Cluster -----------------------------------------
fixedRow(
titlePanel("Differentially Expressed Genes per Cluster"),
p(HTML(paste0(
"Here you can explore the significantly differentially expressed genes per ",
"cluster. '<b>DE vs Rest</b>' refers to positively differentially expressed genes ",
"when comparing a cluster to the rest of the cells as a whole. '<b>Marker genes</b>' ",
"refers to genes positively differentially expressed versus all other clusters ",
"in a series of pairwise tests. '<b>DE vs neighbour</b>' refers to genes positively ",
"differentially expressed versus the nearest neighbouring cluster, as measured ",
"by number of differentially expressed genes between clusters. In all cases, ",
"Wilcoxon rank-sum tests with false detection rate correction are used."
))),
p(paste(
"The dotplot is generated using the differentially expressed genes from the test",
"and number of genes selected below. A dotplot is a modified heatmap where each",
"dot encodes both detection rate and average gene expression in detected cells",
"for a gene in a cluster. Darker colour indicates higher mean normalized gene expression",
"from the cells in which the gene was detected, and larger dot diameter indicates",
"that the gene was detected in greater proportion of cells from the cluster.")),
p(HTML(paste(
"Gene expression statistics per cluster can be downloaded as tab-separated text files",
"by selecting the cluster and clicking <b>Download cluster gene stats</b>. These statistics",
"are: mean log-normalized gene expression per cluster (MGE), proportion of cells in the",
"cluster in which the gene was detected (DR), and mean log-normalized gene expression",
"from the cells in which the gene was detected (MDGE). Differentially expressed gene",
"expression test results can be downloaded as tab-separated text files by selecting the",
"test type (under 'Dotplot Genes') and cluster, and clicking <b>Download DE results</b>.",
"Genes used in the dotplot can be viewed in the gene expression plots below as well."
))),
h1()
),
fixedRow(
column(2,uiOutput("heatDEtype"),
numericInput("FDRthresh2",label="FDR",value=.05,max=1)),
column(6,uiOutput("DEgeneSlider")),
column(2,uiOutput("DEclustSelect")),
column(2,
downloadButton("CGSsave0","Download cluster gene stats"),
downloadButton("deGeneSave","Download DE results"),
downloadButton("heatmapSave",paste("Save as",toupper(imageFileType))))
),
fixedRow(plotOutput("dotplot",height="600px")),
hr(),
# ^ Gene Expression Distributions per Cluster ------------------------------------------
fixedRow(
titlePanel("Gene Expression Distributions per Cluster"),
p(paste("Here you can investigate the expression of individual genes per cluster and",
"across all clusters. The first plot shows mean expression of genes in a cluster",
"as a function of their detection rate and transcript count when detected. The",
"x-axis indicates the proportion of cells in the cluster in which each gene was",
"detected (transcript count > 0), while the y-axis shows the mean normalized",
"transcript count for each gene from the cells in the cluster in which that gene",
"was detected. You can select the cluster to view from the menu below, and genes",
"can be labelled in the figure based on the cell-type markers provided in",
"RunVizScipt.R, the differentially expressed genes from the selected cluster in",
"the above heatmap, or by searching for them in the box below the figure.")),
p(paste("Clicking on the first plot will populate the list of genes near the point clicked,",
"which can be found above the next figure. By selecting a gene from this list,",
"you can compare the expression of that gene across all clusters in the second figure.",
"This list can also be populated using the gene search feature. Plotting options",
"for the second figure include the option to overlay normalized transcript count",
"from each cell in the cluster over their respective boxplots ('Include scatterplot'),",
"and the inclusion of the percentile rank of that gene's expression per cluster as",
"small triangles on the plot using the right y-axis ('Include gene rank').")),
h1()
),
fixedRow(
column(3,uiOutput("genePlotClustSelect")),
column(9,uiOutput("cgLegend"))
),
fixedRow(align="right",
plotOutput("clusterGenes",height="600px",click="cgClick"),
downloadButton("clusterGenesSave",paste("Save as",toupper(imageFileType)))
),
fixedRow(
column(3,radioButtons("searchType",label="Search by:",
choices=c("Gene list (comma-separated)"="comma",
"Regular expression"="regex"))),
column(8,uiOutput("geneSearchBox")),
column(1,actionButton("GOIgo","Search",icon=icon("search")))
),tags$style(type='text/css', "button#GOIgo { margin-top: 25px; margin-left: -25px; }"),
# ^ Gene expression comparison ---------------------------------------------------------
fixedRow(
column(3,radioButtons("boxplotGene",inline=F,
label="Genes of interest (to populate list):",
choices=c("From click on gene in plot"="click",
"From gene search"="search"))),
column(4,uiOutput("cgSelect")),
column(5,checkboxGroupInput("bxpOpts",label="Figure options:",
selected=c("sct","dr"),inline=T,
choices=list("Include scatterplot"="sct",
"Include detection rate"="dr")))
),
fixedRow(plotOutput("geneTest",height="500px"),
downloadButton("geneTestSave",paste("Save as",toupper(imageFileType)))
),
hr(),
# ^ Distribution of genes of interest --------------------------------------------------
fixedRow(
titlePanel("Cell Distribution of Genes of Interest")
),
fixedRow(
column(6,
p(paste("Here you can overlay gene expression values for individual genes of interest",
"on the cell projection. Search for your gene using the search box below,",
"then select your gene(s) of interest from the dropdown 'Select genes' menu.",
"You have the option to include the cluster labels from the first cell projection",
"figure in these plots, and to colour the clusters themselves. There are two",
"copies of this figure for ease of comparison between genes of interest."))
),
column(2,uiOutput("GOI_EmbType")),
column(2,uiOutput("GOI_EmbDimX")),
column(2,uiOutput("GOI_EmbDimY"))
),
fixedRow(
column(2,radioButtons("searchType1",label="Search by:",
choices=c("Gene list"="comma",
"Regular expression"="regex"))),
column(3,uiOutput("geneSearchBox1")),
column(1,actionButton("GOI1go","Search",icon=icon("search"))),
column(2,radioButtons("searchType2",label="Search by:",
choices=c("Gene list"="comma",
"Regular expression"="regex"))),
column(3,uiOutput("geneSearchBox2")),
column(1,actionButton("GOI2go","Search",icon=icon("search")))
),tags$style(type='text/css', paste("button#GOI1go { margin-top: 25px; margin-left: -25px; }",
"button#GOI2go { margin-top: 25px; margin-left: -25px; }")),
fixedRow(
column(3,
radioButtons("plotClust1",inline=T,label="Plot:",selected="goi",
choices=list("Clusters"="clust","Gene expression overlay"="goi")),
checkboxInput("plotLabel1",label="Include cluster labels (style as above)",value=T)
),
column(3,uiOutput("GOI1select")),
column(3,
radioButtons("plotClust2",inline=T,label="Plot:",selected="goi",
choices=list("Clusters"="clust","Gene expression overlay"="goi")),
checkboxInput("plotLabel2",label="Include cluster labels (style as above)",value=T)
),
column(3,uiOutput("GOI2select"))
),
fixedRow(
column(6,plotOutput("goiPlot1",height="580px")),
column(6,plotOutput("goiPlot2",height="580px"))
),
fixedRow(
column(6,align="left",uiOutput("goiPlot1SaveButton")),
column(6,align="right",uiOutput("goiPlot2SaveButton"))
),
hr(),
# ^ Cluster comparison -----------------------------------------------------------------
fixedRow(
titlePanel("Cluster/Set Comparison of Gene Statistics"),
p(paste("Here you can explore the results of pairwise gene expression comparisons",
"between clusters.",
"Any clusters from the currently selected cluster solution can be compared,",
"and you can switch cluster resolutions from the menu here for convenience.",
"Gene effect sizes can be viewed in the context of statistical significance",
"(volcano plots), or directly in modified Bland-Altman plots (axes swapped",
"to match volcano plots).",
"Genes can be labelled by statistical significance, maximum difference,",
"or using the gene search feature above.")),
p(HTML(paste("Summary statistics of gene expression for either cluster can be downloaded",
"as tab-separated text files using the <b>Download cluster gene stats</b>",
"button under each cluster selection menu. These statistics are:",
"Mean log-normalized transcript count per cluster",
"(mean gene expression - MGE);",
"Proportion of cells in the cluster in which the gene was detected",
"(detection rate - DR);",
"and mean log-normalized transcript count from the cells in which",
"the gene was detected (mean detected gene expression - MDGE)."))),
p(HTML(paste("Differentially expressed gene expression test results for the comparison",
"between selected clusters can be downloaded as tab-separated text file",
"using the <b>Download DE results</b> button.",
"Effect size measures for difference in mean gene expression",
"(gene expression ratio - logGER) and difference in detection rate (dDR),",
"as well as p- and FDR values for tested genes are included in the results."))),
p(paste("Similar to the gene expression distribution scatterplot above, clicking on any",
"point in this plot will populate the 'Genes of interest' list above the boxplots",
"comparing gene expression across clusters.")),
h1()
),
fixedRow(
column(7,plotOutput("setScatter",height="640px",click="scatterClick")),
column(5,
fixedRow(
column(10,uiOutput("resSelect2")),
column(2,actionButton("go2","View",icon("play"),
style="color: #fff; background-color: #008000"))
),
fixedRow(column(12,uiOutput("saveButton2"))),
fixedRow(
column(6,uiOutput("setScatterA")),
column(6,uiOutput("setScatterB"))
),
fixedRow(
column(6,downloadButton("CGSsaveA","Download cluster gene stats")),
column(6,downloadButton("CGSsaveB","Download cluster gene stats"))
),
hr(),
fixedRow(
column(8,radioButtons("scatterInput",label="Plot to display:",
choices=c(
"Volcano plot of gene expression ratio"="logGER",
"Volcano plot of difference in detection rate"="dDR",
"Gene expression ratio vs difference in detection rate"="GERvDDR",
"Compare mean gene expression"="MGE",
"Compare detection rate"="DR",
"Compare mean detected gene expression"="MDGE"
),
selected="logGER")
),
column(4,
fixedRow(radioButtons("diffLabelType",label="Label genes by:",
choices=c("Most significant"="de",
"Most different"="diff",
"From gene search"="search")),
uiOutput("diffLabelChoice")
# checkboxGroupInput("scatterLabelAngle",label="Plot options:",
# choices=c("Flip label angle"="flip"))
)
)
),
fixedRow(column(12,uiOutput("diffLabelSelect"))),
fixedRow(
column(4,downloadButton("setScatterSave",paste("Save as",toupper(imageFileType)))),
column(4,downloadButton("setComparisonSave","Download DE results"))
)
)
),tags$style(type='text/css',paste("button#go2 { margin-top: 25px; margin-left: -25px; }",
"button#updateForViz2 { margin-top: -25px; }",
"button#setComparisonSave { margin-left: -25px; }")),
hr(),
# ^ Custom sets for DE -----------------------------------------------------------------
fixedRow(titlePanel("Manually Select Cells for DE Testing or Further Analysis"),
p(paste("Here you can select sets of cells to directly compare in the figures",
"above, or to generate a new data object for further analysis in R.",
"This can be done manually, or by setting filters on the metadata.",
"Click and drag to select cells manually, and use the buttons below to",
"add or remove the selected cells to/from a set of cells.",
"Filters can be set on metadata by selecting a metadata column from the",
"pulldown menu, and selecting factors / data ranges to include cells.",
"You can include more than one metadata filter, and they will be combined",
"using the logical AND (intersection of sets). You can see the selected",
"cells bolded in the plot. When your cell set(s) are ready, if subsetting",
"just save the subset as a new RData file to disk using the save button.",
"If building a comparison of cell sets for DE testing, name the comparison",
"and click the 'Calculate differential gene expression' button. Once the",
"calculation is done the comparison will be added to the cluster list",
"at the top of the page and the current cluster solution will be updated",
"to show this comparison. The comparison can be saved by clicking 'Save",
"this comparison to disk' next to either cluster solution menu.")),
uiOutput("NoSubsetWarning")
),
#### TESTING ####
# verbatimTextOutput("TEST"),
fixedRow(
column(8,plotOutput("tsneSelDE",brush="tsneSelDEbrush",hover="tsneSelDEhover",height="750px")),
column(4,
fixedRow(
uiOutput("DEorSubset")
),
fixedRow(
column(4,uiOutput("SelDE_EmbType")),
column(4,uiOutput("SelDE_EmbDimX")),
column(4,uiOutput("SelDE_EmbDimY"))
),
hr(),
fixedRow(
column(8,uiOutput("tsneSelDEcol")),
column(2,actionButton("plusFilt","Add",icon("plus"),
style="color: #fff; background-color: #008000")),
column(2,actionButton(
"minusFilt","Remove",icon("minus"),
style="color: #008000; background-color: #fff; border-color: #008000"
))
),
uiOutput("MDfilts"),
uiOutput("MDfiltsRemoveAll"),
hr(),
fixedRow(
column(
6,htmlOutput("textSetA"),
uiOutput("addCellsA"),
uiOutput("removeCellsA")
),
column(
6,htmlOutput("textSetB"),
uiOutput("addCellsB"),
uiOutput("removeCellsB")
)
),
span(textOutput("textOverlap"),style="color:red"),
hr(),
uiOutput("DEsetName"),
uiOutput("calcDE"),
uiOutput("calcText"),
hr(),
textOutput("cellsHovered")
)
),tags$style(type='text/css',paste("button#plusFilt { margin-top: 25px; margin-left: -25px; }",
"button#minusFilt { margin-top: 25px; margin-left: -25px; }")),
h1()
)
# Server -------------------------------------------------------------------------------
server <- function(input,output,session) {
session$onSessionEnded(function() {
message("RShiny scClustViz session closed, stopping runShiny function.")
stopApp()
})
# Stops Shiny process in R when Shiny UI session ends (browser window closes)
d <- reactiveValues(MD=getMD(inD)[!names(getMD(inD)) %in% names(sCVdL)],
SCV=sCVdL)
#### TESTING ####
# output$TEST <- renderPrint(currSel())
# ^ Clustering Solution Selection ------------------------------------------------------
numClust <- sapply(sCVdL[!grepl("^Comp:",names(sCVdL))],
function(X) length(levels(Clusters(X))))
clustList <- reactive({
temp <- names(d$SCV)
names(temp)[!grepl("^Comp:",names(d$SCV))] <-
paste0(temp[!grepl("^Comp:",names(d$SCV))],": ",numClust," clusters")
if (any(grepl("^Comp:",names(d$SCV)))) {
names(temp)[grepl("^Comp:",names(d$SCV))] <-
paste0("Comparison: ",sub("Comp:","",fixed=T,
x=temp[!temp %in% names(numClust)]))
}
return(temp)
})
output$deType <- renderUI({
temp_types <- list(
"# of positive DE genes per cluster to nearest cluster"="DEneighb",
"# of positive DE genes per cluster to all other clusters"="DEmarker"
# "Distance between clusters by gene detection rates"="DR",
# "Distance between clusters by mean gene expression"="MGE",
# "Distance between clusters by mean expression in PCA space"="PCA",
# "Distance between clusters by differential expression score"="scoreDE"
)
if (all(!sapply(d$SCV[!grepl("^Comp:",names(d$SCV))],
function(X) is.null(Silhouette(X))))) {
temp_types[["Silhouette widths"]] <- "silWidth"
}
selectInput(
"deType",label="Cluster separation metric:",
choices=temp_types,
width="100%")
})
# ^^ Resolution selection buttons ----------------------------------------------------
res <- reactiveVal(savedRes)
output$resSelect <- renderUI({
selectInput("res","Resolution:",choices=clustList(),selected=res())
})
output$saveButton <- renderUI({
if (!is.na(outPath)) {
if (grepl("^Comp",input$res)) {
actionButton("updateForViz","Save this comparison to disk",icon("save"))
} else {
actionButton("save","Save this resolution as default",icon("bookmark"))
}
}
})
observeEvent(input$go,{
res(input$res)
})
observeEvent(input$go2,{
res(input$res2)
})
observeEvent(input$save,{
savedRes <<- input$res
# <<- updates variable outside scope of function. In this case, that's the enclosing
# function (runShiny), where savedRes was set.
save(savedRes,file=paste0(dataPath,dataTitle,"_savedRes.RData"))
})
# ^^ Inter-cluster DE boxplots -------------------------------------------------------
clustSepRanges <- reactiveValues(x=NULL,y=NULL)
observeEvent(input$clustSep_dblclick, {
brush <- input$clustSep_brush
if (!is.null(brush)) {
clustSepRanges$x <- c(brush$xmin, brush$xmax)
clustSepRanges$y <- c(brush$ymin, brush$ymax)
} else {
clustSepRanges$x <- NULL
clustSepRanges$y <- NULL
}
})
output$clustSep <- renderPlot({
if (input$deType %in% c("DEneighb","DEmarker") &
!all(sapply(sCVdL,function(X) length(DEcombn(X)) > 0))) {
plot(x=NA,y=NA,xlim=0:1,ylim=0:1,xaxt="n",yaxt="n",xlab=NA,ylab=NA)
text(.5,.5,switch(
input$deType,
# scoreDE=paste(
# "Can't calculate distance between clusters by differential expression score",
# "Try running CalcDEvsCombn() for all sCVdata objects in cluster resolution list.",
# sep="\n"
# ),
DEneighb=paste(
"Can't calculate number of DE genes per cluster to nearest cluster",
"Try running CalcDEvsCombn() for all sCVdata objects in cluster resolution list.",
sep="\n"
),
DEmarker=paste(
"Can't calculate number of DE genes per cluster to all other clusters",
"Try running CalcDEvsCombn() for all sCVdata objects in cluster resolution list.",
sep="\n"
)
))
} else {
print(plot_clustSep(sCVdL=d$SCV[!grepl("^Comp:",names(d$SCV))],
DEtype=input$deType,
FDRthresh=input$FDRthresh1,
res=input$res,
Xlim=clustSepRanges$x,
Ylim=clustSepRanges$y))
}
})
output$clustSepSave <- downloadHandler(
filename=paste0(dataTitle,"_ClusterResolutionBoxplots.",imageFileType),
content=function(file) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=6,width=7,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=6,width=7,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=6,width=7,units="in",res=600),
"png"=grDevices::png(file,height=6,width=7,units="in",res=600))
print(plot_clustSep(sCVdL=d$SCV[!grepl("^Comp:",names(d$SCV))],
DEtype=input$deType,
FDRthresh=input$FDRthresh1,
res=input$res,
Xlim=clustSepRanges$x,
Ylim=clustSepRanges$y))
grDevices::dev.off()
}
)
# ^^ FDRthresh Selection -------
output$FDRthresh1 <- renderUI({
if (input$deType %in% c("DEneighb","DEmarker")) {
numericInput("FDRthresh1",label="FDR",
value=.05,max=1)
}
})
# ^^ Silhouette plot -----------------------------------------------------------------
output$sil <- renderPlot({
if (is.null(Silhouette(d$SCV[[input$res]]))) {
plot(x=NA,y=NA,xlim=0:1,ylim=0:1,xaxt="n",yaxt="n",xlab=NA,ylab=NA)
if (grepl("^Comp:",input$res)) {
text(.5,.5,"Silhouette plot is not calculated for set comparisons.")
} else {
text(.5,.5,paste("Silhouette plot was not computed.",
"If the 'cluster' package is installed,",
"try running CalcSilhouette() for the",
"sCVdata object at this cluster resolution.",sep="\n"))
}
} else {
if (require(cluster)) {
plot_sil(d$SCV[[input$res]])
if (length(res()) > 0) {
d$MD$SilhouetteWidth <- Silhouette(d$SCV[[res()]])[,"sil_width"]
}
} else {
plot(x=NA,y=NA,xlim=0:1,ylim=0:1,xaxt="n",yaxt="n",xlab=NA,ylab=NA)
text(.5,.5,"Silhouette plot requires 'cluster' package to be installed.")
}
}
})
output$silSave <- downloadHandler(
filename=paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),"_Silhouette.",imageFileType),
content=function(file) {
if (!is.null(Silhouette(d$SCV[[input$res]]))) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=6,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=6,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=6,units="in",res=600),
"png"=grDevices::png(file,height=7,width=6,units="in",res=600))
plot_sil(d$SCV[[input$res]])
grDevices::dev.off()
}
}
)
# ^ Dataset and Cluster Metadata Inspection --------------------------------------------
# ^^ MD embedding type selection ####
output$MD_EmbType <- renderUI({
temp_embs <- hasEmb(inD)
temp_embs <- temp_embs[
sapply(temp_embs,function(X) ncol(getEmb(inD,X))) >= 2 &
sapply(temp_embs,function(X) nrow(getEmb(inD,X))) == nrow(getMD(inD))
]
selectInput("MD_EmbType",label="Select cell embedding:",
choices=temp_embs,
selected=temp_embs[length(temp_embs)])
})
output$MD_EmbDimX <- renderUI({
selectInput("MD_EmbDimX",label="x-axis:",
choices=colnames(getEmb(inD,input$MD_EmbType)),
selected=colnames(getEmb(inD,input$MD_EmbType))[1])
})
output$MD_EmbDimY <- renderUI({
selectInput("MD_EmbDimY",label="y-axis:",
choices=colnames(getEmb(inD,input$MD_EmbType)),
selected=colnames(getEmb(inD,input$MD_EmbType))[2])
})
# ^^ Cell-type tSNE ####
output$tsneLabels <- renderUI({
if (length(res()) > 0) {
temp_choices <- list("Cluster annotations"="ClusterNames",
"Cluster annotations (label all)"="ClusterNamesAll",
"Cluster numbers"="Clusters")
if (all(unique(attr(Clusters(d$SCV[[res()]]),"ClusterNames")) == "")) {
temp_choices <- temp_choices[3]
} else if (grepl("^Comp:",res())) {
temp_choices <- temp_choices[-1]
names(temp_choices)[1] <- "Cluster annotations"
}
radioButtons("tsneLabels","Labels:",inline=T,choices=temp_choices)
}
})
output$tsne <- renderPlot({
if (length(res()) > 0) {
plot_tsne(cell_coord=getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
md=Clusters(d$SCV[[res()]]),
md_title=NULL,
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
lab_type=input$tsneLabels
),
sel_cells=selCells())
if (input$nnArrow) {
temp_nn <- DEdistNN(DEdist(d$SCV[[res()]]))
temp_labels <- apply(getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
2,function(X) tapply(X,Clusters(d$SCV[[res()]]),mean))
sapply(names(temp_nn),function(X)
arrows(lwd=2,col=alpha("black",0.5),length=0.1,
x0=temp_labels[X,1],y0=temp_labels[X,2],
x1=temp_labels[temp_nn[[X]],1],y1=temp_labels[temp_nn[[X]],2]))
}
}
})
output$tsneSave <- downloadHandler(
filename=paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),"_CellEmbedding.",imageFileType),
content=function(file) {
if (length(res()) > 0) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=7,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=7,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=7,units="in",res=600),
"png"=grDevices::png(file,height=7,width=7,units="in",res=600))
plot_tsne(cell_coord=getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
md=Clusters(d$SCV[[res()]]),
md_title=NULL,
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
lab_type=input$tsneLabels
),
sel_cells=selCells())
if (input$nnArrow) {
temp_nn <- DEdistNN(DEdist(d$SCV[[res()]]))
temp_labels <- apply(getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
2,function(X) tapply(X,Clusters(d$SCV[[res()]]),mean))
sapply(names(temp_nn),function(X)
arrows(lwd=2,col=alpha("black",0.5),length=0.1,
x0=temp_labels[X,1],y0=temp_labels[X,2],
x1=temp_labels[temp_nn[[X]],1],y1=temp_labels[temp_nn[[X]],2]))
}
grDevices::dev.off()
}
}
)
# ^^ Cluster selection ----------------------------------------
clusterSelect <- reactiveValues(cl=NULL)
observeEvent(input$tsneClick,{ clusterSelect$cl <- input$tsneClick })
cSelected <- reactive({
t <- nearPoints(
as.data.frame(getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)]),
coordinfo=clusterSelect$cl,
xvar=input$MD_EmbDimX,yvar=input$MD_EmbDimY,threshold=5)
t2 <- Clusters(d$SCV[[res()]])[rownames(t)[1]]
if (is.na(t2)) {
return("")
} else if (t2 == "Unselected") {
return("")
} else {
return(t2)
}
})
selClust <- reactive({
if (length(res()) < 1) {
return("")
} else if (input$genePlotClust != "") {
Clusters(d$SCV[[res()]])[which(Clusters(d$SCV[[res()]]) == input$genePlotClust)[1]]
} else {
return(input$genePlotClust)
}
})
selClustName <- reactive({
attr(Clusters(d$SCV[[res()]]),"ClusterNames")[selClust()]
})
selCells <- reactive({
if (selClust() == "") {
rep(F,length(Clusters(d$SCV[[res()]])))
} else {
names(Clusters(d$SCV[[res()]]))[Clusters(d$SCV[[res()]]) %in% selClust()]
}
})
# ^^ Metadata tSNE overlay -----------------------------------------------------------
output$tsneMDcol <- renderUI({
selectInput("tsneMDcol",label="Metadata:",width="100%",choices=colnames(d$MD),
selected=grep("phase",colnames(d$MD),value=T,ignore.case=T)[1])
})
output$tsneMDlog <- renderUI({
if (!(is.factor(d$MD[[input$tsneMDcol]]) |
is.character(d$MD[[input$tsneMDcol]]))) {
if (all(d$MD[[input$tsneMDcol]] > 0)) {
checkboxGroupInput("tsneMDlog",label="Colour scale",
choices=c("Log scale"="log"),width="100%")
}
}
})
output$tsneMD <- renderPlot({
if (length(res()) > 0) {
if (length(input$tsneMDlog) > 0) {
if (input$tsneMDlog == "log") { temp_log <- T }
} else { temp_log <- F }
plot_tsne(cell_coord=getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
md=d$MD[[input$tsneMDcol]],
md_title=input$tsneMDcol,
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=temp_log,
label=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
lab_type=input$tsneLabels
),
sel_cells=selCells())
}
})
output$tsneMDSave <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),
"_CellEmbedding_",gsub("^X|[_.]","",input$tsneMDcol),".",imageFileType)
},
content=function(file) {
if (length(res()) > 0) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=7,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=7,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=7,units="in",res=600),
"png"=grDevices::png(file,height=7,width=7,units="in",res=600))
if (length(input$tsneMDlog) > 0) {
if (input$tsneMDlog == "log") { temp_log <- T }
} else { temp_log <- F }
plot_tsne(cell_coord=getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
md=d$MD[[input$tsneMDcol]],
md_title=input$tsneMDcol,
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=temp_log,
label=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$MD_EmbType)[,c(input$MD_EmbDimX,input$MD_EmbDimY)],
lab_type=input$tsneLabels
),
sel_cells=selCells())
grDevices::dev.off()
}
}
)
# ^^ Metadata Scatterplot ------------------------------------------------------------
output$mdScatterX <- renderUI({
temp_search <- switch(is(inD),
seurat="UMI",
SingleCellExperiment="count",
"xxxxx")
selectInput(
"mdScatterX","X axis:",choices=colnames(d$MD),
selected=ifelse(any(grepl(temp_search,colnames(d$MD),ignore.case=T)),
yes=grep(temp_search,colnames(d$MD),value=T,ignore.case=T)[1],
no=colnames(d$MD)[1])
)
})
output$mdScatterY <- renderUI({
temp_search <- switch(is(inD),
seurat="gene",
SingleCellExperiment="feature",
"xxxxx")
selectInput(
"mdScatterY","Y axis:",choices=colnames(d$MD),
selected=ifelse(any(grepl(temp_search,colnames(d$MD),ignore.case=T)),
yes=grep(temp_search,colnames(d$MD),value=T,ignore.case=T)[1],
no=colnames(d$MD)[2])
)
})
output$scatterLog <- renderUI({
temp_choices <- c()
if (is.numeric(d$MD[,input$mdScatterX]) |
is.numeric(d$MD[,input$mdScatterY]) ) {
if (is.numeric(d$MD[,input$mdScatterX])) {
if (all(d$MD[,input$mdScatterX] > 0)) {
temp_choices <- append(temp_choices,c("Log x axis"="x"))
}
}
if (is.numeric(d$MD[,input$mdScatterY])) {
if (all(d$MD[,input$mdScatterY] > 0)) {
temp_choices <- append(temp_choices,c("Log y axis"="y"))
}
}
checkboxGroupInput("scatterLog",inline=F,label=NULL,
choices=temp_choices,selected=NULL)
}
})
output$mdScatter <- renderPlot({
if (length(res()) > 0) {
plot_mdCompare(MD=d$MD,
mdX=input$mdScatterX,
mdY=input$mdScatterY,
sel_cells=selCells(),
sel_clust=selClustName(),
md_log=input$scatterLog)
}
})
output$mdScatterSave <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),"_",
gsub("^X|[_.]","",input$mdScatterX),"_vs_",
gsub("^X|[_.]","",input$mdScatterY),"_CellScatterPlot.",imageFileType)
},
content=function(file) {
if (length(res()) > 0) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=7,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=7,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=7,units="in",res=600),
"png"=grDevices::png(file,height=7,width=7,units="in",res=600))
plot_mdCompare(MD=d$MD,
mdX=input$mdScatterX,
mdY=input$mdScatterY,
sel_cells=selCells(),
sel_clust=selClustName(),
md_log=input$scatterLog)
grDevices::dev.off()
}
}
)
# ^^ Metadata Factor Barplot ---------------------------------------------------------
output$mdFactorData <- renderUI({
selectInput("mdFactorData","Metadata:",choices=colnames(d$MD),
selected=grep("phase",colnames(d$MD),value=T,ignore.case=T)[1])
})
output$mdFactorOpts <- renderUI({
if (is.factor(d$MD[,input$mdFactorData]) | is.character(d$MD[,input$mdFactorData])) {
radioButtons("mdFactorOptsF","Factor counts per cluster:",inline=T,
choices=list("Absolute"="absolute","Relative"="relative"))
} else {
if (all(d$MD[,input$mdFactorData] > 0)) {
checkboxGroupInput("mdFactorOptsN",inline=T,label="Figure options",
choices=c("Log scale"="y"),selected=NULL)
}
}
})
output$mdFactor <- renderPlot({
if (length(res()) > 0) {
if (is.character(d$MD[[input$mdFactorData]]) |
is.factor(d$MD[[input$mdFactorData]])) {
temp_opts <- input$mdFactorOptsF
} else {
if (length(input$mdFactorOptsN) == 0) {
temp_opts <- ""
} else {
temp_opts <- input$mdFactorOptsN
}
}
plot_mdPerClust(MD=d$MD,
sel=input$mdFactorData,
cl=Clusters(d$SCV[[res()]]),
opt=temp_opts,
cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"))
}
})
output$mdFactorSave <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),"_",
gsub("^X|[_.]","",input$mdFactorData),"_PerCluster.",imageFileType)
},
content=function(file) {
if (length(res()) > 0) {
if (is.character(d$MD[[input$mdFactorData]]) |
is.factor(d$MD[[input$mdFactorData]])) {
temp_opts <- input$mdFactorOptsF
} else {
if (length(input$mdFactorOptsN) == 0) {
temp_opts <- ""
} else {
temp_opts <- input$mdFactorOptsN
}
}
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=7,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=7,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=7,units="in",res=600),
"png"=grDevices::png(file,height=7,width=7,units="in",res=600))
plot_mdPerClust(MD=d$MD,
sel=input$mdFactorData,
cl=Clusters(d$SCV[[res()]]),
opt=temp_opts,
cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"))
grDevices::dev.off()
}
}
)
output$mdFactorTable <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),"_",
gsub("^X|[_.]","",input$mdFactorData),"_PerCluster.txt")
},
content=function(file) {
if (is.factor(d$MD[[input$mdFactorData]]) |
is.character(d$MD[[input$mdFactorData]])) {
outTable <- do.call(rbind,
tapply(d$MD[[input$mdFactorData]],
Clusters(d$SCV[[res()]]),
table))
rownames(outTable) <- levels(Clusters(d$SCV[[res()]]))
} else {
outTable <- do.call(rbind,
tapply(d$MD[[input$mdFactorData]],
Clusters(d$SCV[[res()]]),
summary))
rownames(outTable) <- levels(Clusters(d$SCV[[res()]]))
}
write.table(outTable,file,quote=F,sep="\t",row.names=T,col.names=NA)
}
)
# ^ Differentially Expressed Genes per Cluster -----------------------------------------
# ^^ Dotplot of DE genes per cluster -------------------------
output$heatDEtype <- renderUI({
if (length(res()) > 0) {
if (grepl("^Comp:",res())) {
temp <- list("DE vs rest"="DEvsRest",
"Set A vs Set B"="DEmarker")
} else {
temp <- list("DE vs rest"="DEvsRest",
"Marker genes"="DEmarker",
"DE vs neighbour"="DEneighb")
}
radioButtons("dotplotDEtype","Dotplot Genes:",choices=temp,selected="DEmarker")
}
})
DEgenes <- reactive({
dotplotDEgenes(sCVd=d$SCV[[res()]],
DEtype=input$dotplotDEtype,
FDRthresh=input$FDRthresh2)
})
output$DEgeneSlider <- renderUI({
if (length(res()) > 0) {
if (input$dotplotDEtype == "DEvsRest") {
temp_label <- HTML(paste(
"Positive differential gene expression of cluster over tissue",
"# of genes per cluster to show",sep="<br/>"))
} else if (input$dotplotDEtype == "DEmarker") {
if (grepl("^Comp",res())) {
temp_label <- HTML(paste(
"Positive differential gene expression between sets",
"# of genes per set to show",sep="<br/>"))
} else {
temp_label <- HTML(paste(
"Positive differential gene expression between cluster and all other clusters",
"# of genes per cluster to show",sep="<br/>"))
}
} else if (input$dotplotDEtype == "DEneighb") {
temp_label <- HTML(paste(
"Positive differential gene expression between cluster and nearest neighbour",
"# of genes per cluster to show",sep="<br/>"))
}
sliderInput("DEgeneCount",min=1,
max=max(sapply(DEgenes()[names(DEgenes()) != "Unselected"],length)),
value=5,step=1,ticks=T,width="100%",label=temp_label)
}
})
output$DEclustSelect <- renderUI({
if (length(res()) > 0) {
selectInput("DEclustNum","Cluster # for gene list",
choices=levels(Clusters(d$SCV[[res()]]))[
levels(Clusters(d$SCV[[res()]])) != "Unselected"])
}
})
output$dotplot <- renderPlot({
if (length(res()) > 0) {
plot_deDotplot(sCVd=d$SCV[[res()]],
DEgenes=DEgenes(),
DEnum=input$DEgeneCount)
}
})
output$heatmapSave <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),
"_heatmap_",input$dotplotDEtype,
"_FDR",sub("^0","",sub(".","",input$FDRthresh2,fixed=T)),
".",imageFileType)
},
content=function(file) {
if (length(res()) > 0) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=11,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=11,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=11,units="in",res=600),
"png"=grDevices::png(file,height=7,width=11,units="in",res=600))
plot_deDotplot(sCVd=d$SCV[[res()]],
DEgenes=DEgenes(),
DEnum=input$DEgeneCount)
grDevices::dev.off()
}
}
)
output$CGSsave0 <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),
"_ClustGeneStats_",
gsub("^X|[_.]","",make.names(input$DEclustNum)),".txt")
},
content=function(file) {
outTable <- ClustGeneStats(d$SCV[[res()]])[[input$DEclustNum]][,c("MGE","DR","MDGE")]
write.table(outTable,file,quote=F,sep="\t",row.names=T,col.names=NA)
}
)
output$deGeneSave <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),"_",
input$dotplotDEtype,"_",
gsub("^X|[_.]","",make.names(input$DEclustNum)),".txt")
},
content=function(file) {
outTable <- switch(
EXPR=input$dotplotDEtype,
DEvsRest=DEvsRest(d$SCV[[res()]])[[input$DEclustNum]],
DEmarker=DEmarker(d$SCV[[res()]],input$FDRthresh2)[[input$DEclustNum]],
DEneighb=DEneighb(d$SCV[[res()]],input$FDRthresh2)[[input$DEclustNum]]
)
write.table(outTable,file,quote=F,sep="\t",row.names=T,col.names=NA)
}
)
# ^ Gene Expression Distributions per Cluster ------------------------------------------
# ^^ Gene search box -----------------------------------------------------------------
output$geneSearchBox <- renderUI({
switch(input$searchType,
comma=textInput("GOI",value="Actb",width="100%",
label=paste("Enter list of genes,",
"(comma/space-separated, case-insensitive)",
"and click Search")),
regex=textInput("GOI",value="^ACTB$",width="100%",
label="Search for genes by regular expression and click Search"))
})
GOI <- eventReactive(input$GOIgo,
geneSearch(txt=as.character(input$GOI),
st=input$searchType,
CGS=ClustGeneStats(d$SCV[[res()]])[[1]]),
ignoreNULL=F)
# ^^ Scatterplot of gene expression in cluster ------------------------------------------------------
output$genePlotClustSelect <- renderUI({
if (length(res()) > 0) {
temp_cl <- c("",levels(Clusters(d$SCV[[res()]])))
names(temp_cl) <- c("",paste(levels(Clusters(d$SCV[[res()]])),
attr(Clusters(d$SCV[[res()]]),"ClusterNames"),
sep=": "))
temp_cl <- temp_cl[temp_cl != "Unselected"]
selectInput("genePlotClust",label="Cluster:",
choices=temp_cl,selected=cSelected())
}
})
output$cgLegend <- renderUI({
if (length(attr(Clusters(d$SCV[[res()]]),"cellMarkers")) > 0) {
radioButtons("cgLegend",inline=T,label="Highlighted genes:",
choices=c("Cell-type markers"="markers",
"Top DE genes (from heatmap)"="heatmap",
"Gene symbols from search box below"="search"))
} else {
radioButtons("cgLegend",inline=T,label="Highlighted genes:",
choices=c("Top DE genes (from heatmap)"="heatmap",
"Gene symbols from search box below"="search"))
}
})
clickGenes <- reactiveVal()
observeEvent(input$cgClick,{
t <- nearPoints(ClustGeneStats(d$SCV[[res()]])[[selClust()]],
input$cgClick,xvar="DR",yvar="MDGE")
temp_out <- rownames(t)
names(temp_out) <- t$genes
clickGenes(temp_out)
})
observeEvent(input$scatterClick,{
tempDF <- compareClusts_DF(sCVd=d$SCV[[res()]],
clA=input$ssA,
clB=input$ssB,
dataType=input$scatterInput)
if (input$scatterInput %in% c("MGE","MDGE","DR")) {
t <- nearPoints(tempDF,input$scatterClick,
xvar="x_diff",yvar="y_mean")
} else if (input$scatterInput == "GERvDDR") {
t <- nearPoints(tempDF,input$scatterClick,
xvar="dDR",yvar="logGER")
} else {
tempDF$FDR <- -log10(tempDF$FDR)
t <- nearPoints(tempDF,input$scatterClick,
xvar=input$scatterInput,yvar="FDR")
}
temp_out <- rownames(t)
names(temp_out) <- t$genes
clickGenes(temp_out)
})
output$clusterGenes <- renderPlot({
if (length(res()) > 0) {
switch(input$cgLegend,
markers=plot_clusterGenes_markers(
sCVd=d$SCV[[res()]],
selClust=selClust(),
cellMarkers=attr(Clusters(d$SCV[[res()]]),"cellMarkers")
),
heatmap=plot_clusterGenes_DEgenes(
sCVd=d$SCV[[res()]],
selClust=selClust(),
DEgenes=DEgenes(),
DEnum=input$DEgeneCount,
DEtype=input$dotplotDEtype
),
search=plot_clusterGenes_search(
sCVd=d$SCV[[res()]],
selClust=selClust(),
GOI=GOI()
),
{
plot(x=NA,y=NA,xlim=0:1,ylim=0:1,xaxt="n",yaxt="n",xlab=NA,ylab=NA)
text(.5,.5,"Whooops. input$cgLegend is making up words.")
})
}
}) #,res=96) # enlarge plot features in interactive session
output$clusterGenesSave <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),"_GeneExprCluster_",
gsub("^X|[_.]","",make.names(input$genePlotClust)),".",imageFileType)
},
content=function(file) {
if (length(res()) > 0) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=12,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=12,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=12,units="in",res=600),
"png"=grDevices::png(file,height=7,width=12,units="in",res=600))
switch(input$cgLegend,
markers=plot_clusterGenes_markers(
sCVd=d$SCV[[res()]],
selClust=selClust(),
cellMarkers=attr(Clusters(d$SCV[[res()]]),"cellMarkers")
),
heatmap=plot_clusterGenes_DEgenes(
sCVd=d$SCV[[res()]],
selClust=selClust(),
DEgenes=DEgenes(),
DEnum=input$DEgeneCount,
DEtype=input$dotplotDEtype
),
search=plot_clusterGenes_search(
sCVd=d$SCV[[res()]],
selClust=selClust(),
GOI=GOI()
),
{
plot(x=NA,y=NA,xlim=0:1,ylim=0:1,xaxt="n",yaxt="n",xlab=NA,ylab=NA)
text(.5,.5,"Whooops. input$cgLegend is making up words.")
})
grDevices::dev.off()
}
}
)
# ^ Gene expression comparison -------------------------------------------------------
# ^^ Gene selection by click/search --------------------------------------------------
output$cgSelect <- renderUI({
if (length(res()) > 0) {
temp_choices <- switch(input$boxplotGene,
click=clickGenes(),
search=GOI())
if (is.null(names(temp_choices))) {
temp_choices <- sort(temp_choices)
} else {
temp_choices <- temp_choices[order(names(temp_choices))]
}
selectInput("cgGene",choices=temp_choices,label="Select gene from list:")
}
})
geneNameBx <- reactive({
try(tempGN <- mapIds(annotationDB,keys=input$cgGene,keytype=rownameKeytype,
column="GENENAME",multiVals="first"),silent=T)
if (exists("tempGN")) { return(tempGN) } else { return(NULL) }
})
# ^^ Boxplots for gene expression comparison ------------------------------------------------------
output$geneTest <- renderPlot({
if (length(res()) > 0) {
plot_GEboxplot(nge=getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2]),
sCVd=d$SCV[[res()]],
gene=input$cgGene,
geneName=geneNameBx(),
opts=input$bxpOpts)
}
})
output$geneTestSave <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),
"_GeneExprBoxplot_",input$cgGene,".",imageFileType)
},
content=function(file) {
if (length(res()) > 0) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=12,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=12,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=12,units="in",res=600),
"png"=grDevices::png(file,height=7,width=12,units="in",res=600))
plot_GEboxplot(nge=getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2]),
sCVd=d$SCV[[res()]],
gene=input$cgGene,
geneName=geneNameBx(),
opts=input$bxpOpts)
grDevices::dev.off()
}
}
)
# ^ Distribution of genes of interest ------------------------------------------------
# ^^ GOI embedding type selection ####
output$GOI_EmbType <- renderUI({
temp_embs <- hasEmb(inD)
temp_embs <- temp_embs[
sapply(temp_embs,function(X) ncol(getEmb(inD,X))) >= 2 &
sapply(temp_embs,function(X) nrow(getEmb(inD,X))) == nrow(getMD(inD))
]
selectInput("GOI_EmbType",label="Select cell embedding:",
choices=temp_embs,
selected=temp_embs[length(temp_embs)])
})
output$GOI_EmbDimX <- renderUI({
selectInput("GOI_EmbDimX",label="x-axis:",
choices=colnames(getEmb(inD,input$GOI_EmbType)),
selected=colnames(getEmb(inD,input$GOI_EmbType))[1])
})
output$GOI_EmbDimY <- renderUI({
selectInput("GOI_EmbDimY",label="y-axis:",
choices=colnames(getEmb(inD,input$GOI_EmbType)),
selected=colnames(getEmb(inD,input$GOI_EmbType))[2])
})
# ^^ GOI Search boxes ####
output$geneSearchBox1 <- renderUI({
if (input$searchType1 == "comma") {
textInput("GOI1",value="Actb",width="100%",
label=paste("Enter list of genes"))
} else if (input$searchType1 == "regex") {
textInput("GOI1",value="^ACTB$",width="100%",
label="Enter regular expression")
}
})
output$geneSearchBox2 <- renderUI({
if (input$searchType2 == "comma") {
textInput("GOI2",value="Actb",width="100%",
label=paste("Search by list of genes"))
} else if (input$searchType2 == "regex") {
textInput("GOI2",value="^ACTB$",width="100%",
label="Search by regular expression")
}
})
GOI1 <- eventReactive(input$GOI1go,
geneSearch(txt=input$GOI1,
st=input$searchType1,
CGS=ClustGeneStats(d$SCV[[res()]])[[1]]))
GOI2 <- eventReactive(input$GOI2go,
geneSearch(txt=input$GOI2,
st=input$searchType2,
CGS=ClustGeneStats(d$SCV[[res()]])[[1]]))
output$GOI1select <- renderUI({
temp_choices <- GOI1()
if (is.null(names(temp_choices))) {
temp_choices <- sort(temp_choices)
} else {
temp_choices <- temp_choices[order(names(temp_choices))]
}
selectInput("goi1",label="Select genes:",choices=temp_choices)
})
output$GOI2select <- renderUI({
temp_choices <- GOI2()
if (is.null(names(temp_choices))) {
temp_choices <- sort(temp_choices)
} else {
temp_choices <- temp_choices[order(names(temp_choices))]
}
selectInput("goi2",label="Select genes:",choices=temp_choices)
})
geneNameGOI1 <- reactive({
try(tempGN <- mapIds(annotationDB,keys=input$goi1,keytype=rownameKeytype,
column="GENENAME",multiVals="first"),silent=T)
if (exists("tempGN")) {
return(paste(names(tempGN),tempGN,sep=": "))
} else {
return(input$goi1)
}
})
geneNameGOI2 <- reactive({
try(tempGN <- mapIds(annotationDB,keys=input$goi2,keytype=rownameKeytype,
column="GENENAME",multiVals="first"),silent=T)
if (exists("tempGN")) {
return(paste(names(tempGN),tempGN,sep=": "))
} else {
return(input$goi2)
}
})
# ^^ GOI plots ####
output$goiPlot1 <- renderPlot({
if (input$plotClust1 == "clust" & length(res()) > 0) {
plot_tsne(
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
md=Clusters(d$SCV[[res()]]),
md_title=NULL,
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=switch(
as.character(input$plotLabel1),
"TRUE"=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
lab_type=input$tsneLabels
),
"FALSE"=NULL
)
)
} else if (input$plotClust1 == "goi") {
if (is.null(input$goi1)) {
plot(x=NA,y=NA,xlim=0:1,ylim=0:1,xaxt="n",yaxt="n",xlab=NA,ylab=NA)
text(.5,.5,paste("To search for your gene(s) of interest,",
"type a list of genes or regex into the box above,",
"then select the gene from the drop-down list.",sep="\n"))
} else {
plot_tsne(
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
md=switch(any(is.na(c(Param(sCVdL[[1]],"exponent"),Param(sCVdL[[1]],"pseudocount")))) + 1,
getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])[input$goi1,],
log2(getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])[input$goi1,] + 1)),
md_title=geneNameGOI1(),
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=switch(
as.character(input$plotLabel1),
"TRUE"=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
lab_type=input$tsneLabels
),
"FALSE"=NULL
)
)
}
}
})
output$goiPlot2 <- renderPlot({
if (input$plotClust2 == "clust" & length(res()) > 0) {
plot_tsne(
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
md=Clusters(d$SCV[[res()]]),
md_title=NULL,
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=switch(
as.character(input$plotLabel2),
"TRUE"=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
lab_type=input$tsneLabels
),
"FALSE"=NULL
)
)
} else if (input$plotClust2 == "goi") {
if (is.null(input$goi2)) {
plot(x=NA,y=NA,xlim=0:1,ylim=0:1,xaxt="n",yaxt="n",xlab=NA,ylab=NA)
text(.5,.5,paste("To search for your gene(s) of interest,",
"type a list of genes or regex into the box above,",
"then select the gene from the drop-down list.",sep="\n"))
} else {
plot_tsne(
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
md=switch(any(is.na(c(Param(sCVdL[[1]],"exponent"),Param(sCVdL[[1]],"pseudocount")))) + 1,
getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])[input$goi2,],
log2(getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])[input$goi2,] + 1)),
md_title=geneNameGOI2(),
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=switch(
as.character(input$plotLabel2),
"TRUE"=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
lab_type=input$tsneLabels
),
"FALSE"=NULL
)
)
}
}
})
output$goiPlot1SaveButton <- renderUI({
if (input$plotClust1 == "goi") {
if (!is.null(input$goi1)) {
downloadButton("goiPlot1Save",paste("Save as",toupper(imageFileType)))
}
}
})
output$goiPlot2SaveButton <- renderUI({
if (input$plotClust2 == "goi") {
if (!is.null(input$goi2)) {
downloadButton("goiPlot2Save",paste("Save as",toupper(imageFileType)))
}
}
})
output$goiPlot1Save <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),
"_GeneExprOverlay_",input$goi1,".",imageFileType)
},
content=function(file) {
if (input$plotClust2 == "goi" & !is.null(input$goi1)) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=7,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=7,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=7,units="in",res=600),
"png"=grDevices::png(file,height=7,width=7,units="in",res=600))
plot_tsne(
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
md=switch(any(is.na(c(Param(sCVdL[[1]],"exponent"),Param(sCVdL[[1]],"pseudocount")))) + 1,
getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])[input$goi1,],
log2(getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])[input$goi1,] + 1)),
md_title=geneNameGOI1(),
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=switch(
as.character(input$plotLabel1),
"TRUE"=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
lab_type=input$tsneLabels
),
"FALSE"=NULL
)
)
grDevices::dev.off()
}
}
)
output$goiPlot2Save <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),
"_GeneExprOverlay_",input$goi2,".",imageFileType)
},
content=function(file) {
if (input$plotClust2 == "goi" & !is.null(input$goi2)) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=7,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=7,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=7,units="in",res=600),
"png"=grDevices::png(file,height=7,width=7,units="in",res=600))
plot_tsne(
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
md=switch(any(is.na(c(Param(sCVdL[[1]],"exponent"),Param(sCVdL[[1]],"pseudocount")))) + 1,
getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])[input$goi2,],
log2(getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])[input$goi2,] + 1)),
md_title=geneNameGOI2(),
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=switch(
as.character(input$plotLabel2),
"TRUE"=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$GOI_EmbType)[,c(input$GOI_EmbDimX,input$GOI_EmbDimY)],
lab_type=input$tsneLabels
),
"FALSE"=NULL
)
)
grDevices::dev.off()
}
}
)
# ^ MA plot for cluster comparison ---------------------------------------------------------------
output$resSelect2 <- renderUI({
selectInput("res2","Resolution:",choices=clustList(),selected=res(),width="100%")
})
output$saveButton2 <- renderUI({
if (!is.na(outPath)) {
if (grepl("^Comp",input$res2)) {
actionButton("updateForViz2","Save this comparison to disk",icon("save"))
}
}
})
output$setScatterA <- renderUI({
if (length(res()) > 0) {
temp_cl <- c("",levels(Clusters(d$SCV[[res()]])))
names(temp_cl) <- c("",paste(levels(Clusters(d$SCV[[res()]])),
attr(Clusters(d$SCV[[res()]]),"ClusterNames"),
sep=": "))
temp_sel <- selClust()
if (grepl("^Comp:",res())) { temp_sel <- grep("Set A",temp_cl,value=T) }
selectInput("ssA",label="Cluster A (A-B comparison)",
choices=temp_cl,selected=temp_sel)
}
})
output$setScatterB <- renderUI({
if (length(res()) > 0) {
temp_cl <- c("",levels(Clusters(d$SCV[[res()]])))
names(temp_cl) <- c("",paste(levels(Clusters(d$SCV[[res()]])),
attr(Clusters(d$SCV[[res()]]),"ClusterNames"),
sep=": "))
temp_sel <- DEdistNN(DEdist(d$SCV[[res()]]))[selClust()]
if (grepl("^Comp:",res())) { temp_sel <- grep("Set B",temp_cl,value=T) }
selectInput("ssB",label="Cluster B (A-B comparison)",
choices=temp_cl,selected=temp_sel)
}
})
output$CGSsaveA <- downloadHandler(
filename=function() { paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),
"_ClustGeneStats_",input$ssA,".txt") },
content=function(file) {
outTable <- ClustGeneStats(d$SCV[[res()]])[[input$ssA]][,c("MGE","DR","MDGE")]
write.table(outTable,file,quote=F,sep="\t",row.names=T,col.names=NA)
}
)
output$CGSsaveB <- downloadHandler(
filename=function() { paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),
"_ClustGeneStats_",input$ssB,".txt") },
content=function(file) {
outTable <- ClustGeneStats(d$SCV[[res()]])[[input$ssB]][,c("MGE","DR","MDGE")]
write.table(outTable,file,quote=F,sep="\t",row.names=T,col.names=NA)
}
)
output$diffLabelChoice <- renderUI({
if (input$scatterInput == "GERvDDR" &input$diffLabelType == "diff") {
radioButtons("diffLabelChoice",label="Axis of difference:",
choices=c("Gene expression"="logGER",
"Detection rate"="dDR"))
}
})
output$diffLabelSelect <- renderUI({
if (input$diffLabelType == "diff") {
sliderInput("diffCount",min=1,max=100,value=5,step=1,width="100%",
label="Number of most different genes to label")
} else if (input$diffLabelType == "de") {
sliderInput("diffCount",min=1,max=100,value=5,step=1,width="100%",
label="Number of most significantly different genes to label")
}
})
output$setScatter <- renderPlot(
if (length(res()) > 0) {
plot_compareClusts(sCVd=d$SCV[[res()]],
clA=input$ssA,
clB=input$ssB,
dataType=input$scatterInput,
labType=input$diffLabelType,
labTypeDiff=input$diffLabelChoice,
labNum=input$diffCount,
labGenes=GOI())
}
)
output$setScatterSave <- downloadHandler(
filename=function() {
paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),"_",
input$scatterInput,"_",gsub("^X|[_.]","",make.names(input$ssA)),
"_vs_",gsub("^X|[_.]","",make.names(input$ssB)),".",imageFileType)
},
content=function(file) {
if (length(res()) > 0) {
switch(imageFileType,
"pdf"=grDevices::cairo_pdf(file,height=7,width=7,fallback_resolution=600),
"eps"=grDevices::cairo_ps(file,height=7,width=7,fallback_resolution=600),
"tiff"=grDevices::tiff(file,height=7,width=7,units="in",res=600),
"png"=grDevices::png(file,height=7,width=7,units="in",res=600))
plot_compareClusts(sCVd=d$SCV[[res()]],
clA=input$ssA,
clB=input$ssB,
dataType=input$scatterInput,
labType=input$diffLabelType,
labTypeDiff=input$diffLabelChoice,
labNum=input$diffCount,
labGenes=GOI())
grDevices::dev.off()
}
}
)
output$setComparisonSave <- downloadHandler(
filename=function() {
temp <- c(paste(input$ssA,input$ssB,sep="-"),paste(input$ssB,input$ssA,sep="-"))
tempName <- temp[temp %in% names(DEcombn(d$SCV[[res()]]))]
return(paste0(dataTitle,"_",gsub("^X|[_.]","",make.names(res())),
"_DEcombn_",tempName,".txt"))
},
content=function(file) {
temp <- c(paste(input$ssA,input$ssB,sep="-"),paste(input$ssB,input$ssA,sep="-"))
tempName <- temp[temp %in% names(DEcombn(d$SCV[[res()]]))]
return(write.table(DEcombn(d$SCV[[res()]])[[tempName]],
file,quote=F,sep="\t",row.names=T,col.names=NA))
}
)
# ^ Custom sets for DE ---------------------------------------------------------------
selectedSets <- reactiveValues(a=NULL,b=NULL)
# ^^ Interactive filters ---------------------------------------------------
output$tsneSelDEcol <- renderUI({
selectInput("tsneSelDEcol","Metadata overlay and cell filtering:",
choices=c(paste("Clusters:",res()),colnames(d$MD)))
})
output$DEorSubset <- renderUI({
if (is.na(outPath)) {
radioButtons("DEorSubset",inline=T,
label="Select cells for:",
choiceValues=c("DE","subset"),
choiceNames=c("DE testing","Subsetting (not available)"))
} else {
radioButtons("DEorSubset",inline=T,
label="Select cells for:",
choiceValues=c("DE","subset"),
choiceNames=c("DE testing","Subsetting data object"))
}
})
output$NoSubsetWarning <- renderUI({
if (is.na(outPath)) {
em("Manual subsetting is not available on shiny.baderlab.org")
}
})
output$addCellsA <- renderUI({
if (input$DEorSubset == "DE") {
actionButton("addCellsA","Set A: Add Cells",icon("plus"),
style="color: #fff; background-color: #a50026")
} else if (input$DEorSubset == "subset") {
actionButton("addCells2","Add Cells To Set",icon("plus"),
style="color: #fff; background-color: #a50026")
} else {
stop("DEorSubset radio button output broke")
}
})
output$addCellsB <- renderUI({
if (input$DEorSubset == "DE") {
actionButton("addCellsB","Set B: Add Cells",icon("plus"),
style="color: #fff; background-color: #313695")
} else if (input$DEorSubset == "subset") {
actionButton("removeCells2","Remove Cells From Set",icon("minus"),
style="color: #a50026; background-color: #fff; border-color: #a50026")
} else {
stop("DEorSubset radio button output broke")
}
})
output$removeCellsA <- renderUI({
if (input$DEorSubset == "DE") {
actionButton("removeCellsA","Set A: Remove Cells",icon("minus"),
style="color: #a50026; background-color: #fff; border-color: #a50026")
}
})
output$removeCellsB <- renderUI({
if (input$DEorSubset == "DE") {
actionButton("removeCellsB","Set B: Remove Cells",icon("minus"),
style="color: #313695; background-color: #fff; border-color: #313695")
}
})
output$DEsetName <- renderUI({
if (input$DEorSubset == "DE") {
textInput("DEsetName","Short name for this comparison:",
placeholder="A-z0-9_ only please")
}
})
output$calcDE <- renderUI({
if (input$DEorSubset == "DE") {
actionButton("calcDE","Calculate differential gene expression",icon("play"))
} else if (input$DEorSubset == "subset") {
if (!is.na(outPath)) {
downloadButton("DownloadSubset",
paste("Download",is(inD)[1],"object of selected cells"))
}
} else {
stop("DEorSubset radio button output broke")
}
})
output$DownloadSubset <- downloadHandler(
filename=function() { paste0(dataTitle,"_NameYourCellSubset.rds") },
content=function(file) {
temp <- subsetCells(inD,selectedSets$a)
if (is(temp) == is(inD)) {
saveRDS(temp,file=file)
} else {
stop("subsetCells failed to output data object")
}
}
)
output$calcText <- renderUI({
if (input$DEorSubset == "DE") {
span(textOutput("calcText"),style="color:red")
} else if (input$DEorSubset == "subset") {
HTML(
paste0("Compressing and saving RDS file will take time.<br/>",
"RDS files can be loaded into your R session with:<br/>",
"<code>my_subset <- readRDS('my_file.rds')</code>")
)
}
})
filtList <- reactiveValues(filts=NULL)
observeEvent(input$plusFilt,{
filtList$filts <- unique(c(filtList$filts,input$tsneSelDEcol))
})
observeEvent(input$minusFilt,{
filtList$filts <- filtList$filts[-which(filtList$filts == input$tsneSelDEcol)]
})
observeEvent(input$minusFiltALL,{ filtList$filts <- NULL })
filtValues <- reactive({
sapply(filtList$filts,function(MD) {
if (MD == paste("Clusters:",res())) {
temp_inputSlot <- "MDpicker_clusts"
} else {
temp_inputSlot <- paste0("MDpicker_",which(colnames(d$MD) == MD))
}
return(input[[temp_inputSlot]])
},simplify=F)
})
makeMDpicker <- reactive({
lapply(filtList$filts,function(MD) {
temp_val <- isolate(filtValues()[[MD]])
if (MD == "") {
} else if (MD == paste("Clusters:",res())) {
selectInput("MDpicker_clusts",label="Select cluster(s):",
choices=levels(Clusters(d$SCV[[res()]])),
multiple=T,selected=temp_val)
} else if (is.factor(d$MD[,MD]) | is.character(d$MD[,MD])) {
selectInput(paste0("MDpicker_",which(colnames(d$MD) == MD)),
label=paste0("Select cells by ",MD,":"),
choices=levels(as.factor(d$MD[,MD])),
multiple=T,selected=temp_val)
} else {
if (is.null(temp_val)) { temp_val <- range(d$MD[,MD]) }
sliderInput(paste0("MDpicker_",which(colnames(d$MD) == MD)),
label=paste0("Select cells by ",MD," range:"),
min=min(d$MD[,MD]),max=max(d$MD[,MD]),value=temp_val)
}
})
})
output$MDfilts <- renderUI({ makeMDpicker() })
output$MDfiltsRemoveAll <- renderUI({
if (length(filtList$filts) > 0) {
actionButton("minusFiltALL","Remove all filters",icon("minus"),
style="color: #008000; background-color: #fff; border-color: #008000")
}
})
# ^^ SelDE embedding type selection ####
output$SelDE_EmbType <- renderUI({
temp_embs <- hasEmb(inD)
temp_embs <- temp_embs[
sapply(temp_embs,function(X) ncol(getEmb(inD,X))) >= 2 &
sapply(temp_embs,function(X) nrow(getEmb(inD,X))) == nrow(getMD(inD))
]
selectInput("SelDE_EmbType",label="Embedding:",
choices=temp_embs,
selected=temp_embs[length(temp_embs)])
})
output$SelDE_EmbDimX <- renderUI({
selectInput("SelDE_EmbDimX",label="x-axis:",
choices=colnames(getEmb(inD,input$SelDE_EmbType)),
selected=colnames(getEmb(inD,input$SelDE_EmbType))[1])
})
output$SelDE_EmbDimY <- renderUI({
selectInput("SelDE_EmbDimY",label="y-axis:",
choices=colnames(getEmb(inD,input$SelDE_EmbType)),
selected=colnames(getEmb(inD,input$SelDE_EmbType))[2])
})
# ^^ Plot selDE tSNE -------------------------------------------------------
output$tsneSelDE <- renderPlot({
if (length(res()) == 0) {
plot(x=NA,y=NA,xlim=0:1,ylim=0:1,xaxt="n",yaxt="n",xlab=NA,ylab=NA)
text(.5,.5,paste("Select a clustering resolution in the first plot",
"by clicking 'View clusters at this resolution'",
"before using this tool.",sep="\n"))
} else {
if (input$tsneSelDEcol == paste("Clusters:",res())) {
plot_tsne(
cell_coord=getEmb(inD,input$SelDE_EmbType)[,c(input$SelDE_EmbDimX,input$SelDE_EmbDimY)],
md=Clusters(d$SCV[[res()]]),
md_title=NULL,
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=tsne_labels(
sCVd=d$SCV[[res()]],
cell_coord=getEmb(inD,input$SelDE_EmbType)[,c(input$SelDE_EmbDimX,input$SelDE_EmbDimY)],
lab_type="Clusters"
),
sel_cells=currSel(),
sel_cells_A=selectedSets$a,
sel_cells_B=selectedSets$b
)
} else {
plot_tsne(
cell_coord=getEmb(inD,input$SelDE_EmbType)[,c(input$SelDE_EmbDimX,input$SelDE_EmbDimY)],
md=d$MD[[input$tsneSelDEcol]],
md_title=input$tsneSelDEcol,
md_cols=attr(Clusters(d$SCV[[res()]]),"ClusterColours"),
md_log=F,
label=NULL,
sel_cells=currSel(),
sel_cells_A=selectedSets$a,
sel_cells_B=selectedSets$b
)
}
}
})
# ^^ Cell selection from filters and/or brush ------------------------------
currSel <- reactive({
temp_points <- rownames(brushedPoints(
as.data.frame(getEmb(inD,input$SelDE_EmbType)[,c(input$SelDE_EmbDimX,input$SelDE_EmbDimY)]),
input$tsneSelDEbrush,
xvar=input$SelDE_EmbDimX,yvar=input$SelDE_EmbDimY
))
temp_picker <- sapply(names(filtValues()),function(X) {
if (length(filtValues()[[X]]) < 1) {
rep(T,nrow(d$MD))
} else {
if (X == paste("Clusters:",res())) {
Clusters(d$SCV[[res()]]) %in% filtValues()[[X]]
} else if (is.factor(d$MD[,X]) | is.character(d$MD[,X])) {
d$MD[,X] %in% filtValues()[[X]]
} else {
d$MD[,X] >= filtValues()[[X]][1] & d$MD[,X] <= filtValues()[[X]][2]
}
}
},simplify=F)
temp_picker <- as.logical(Reduce("*",temp_picker))
if (length(temp_points) > 0 & length(temp_picker) > 0) {
return(rownames(d$MD)[rownames(d$MD) %in% temp_points & temp_picker])
} else if (length(temp_picker) > 0 & !all(temp_picker)) {
return(rownames(d$MD)[temp_picker])
} else if (length(temp_points) > 0) {
return(temp_points)
} else { return(character()) }
})
output$cellsHovered <- renderText(
paste("Hovering over cell(s):",
paste(rownames(nearPoints(
as.data.frame(getEmb(inD,input$SelDE_EmbType)[,c(input$SelDE_EmbDimX,input$SelDE_EmbDimY)]),
input$tsneSelDEhover,
xvar=input$SelDE_EmbDimX,yvar=input$SelDE_EmbDimY
)),collapse=", "))
)
observeEvent(input$addCellsA,{
selectedSets$a <- unique(c(selectedSets$a,currSel()))
})
observeEvent(input$removeCellsA,{
selectedSets$a <- selectedSets$a[!selectedSets$a %in% currSel()]
})
observeEvent(input$addCells2,{
selectedSets$a <- unique(c(selectedSets$a,currSel()))
})
observeEvent(input$removeCells2,{
selectedSets$a <- selectedSets$a[!selectedSets$a %in% currSel()]
})
observeEvent(input$addCellsB,{
selectedSets$b <- unique(c(selectedSets$b,currSel()))
})
observeEvent(input$removeCellsB,{
selectedSets$b <- selectedSets$b[!selectedSets$b %in% currSel()]
})
observeEvent({ input$DEorSubset == "subset" },{ selectedSets$b <- NULL })
output$textSetA <- renderText(
if (input$DEorSubset == "DE") {
paste(length(selectedSets$a),"cells in Set A.")
} else if (input$DEorSubset == "subset") {
paste(length(selectedSets$a),"cells in selected set.")
} else {
stop("DEorSubset radio button output broke")
}
)
output$textSetB <- renderText(
if (input$DEorSubset == "DE") {
paste(length(selectedSets$b),"cells in Set B.")
} else if (input$DEorSubset == "subset") {
" "
} else {
stop("DEorSubset radio button output broke")
}
)
output$textOverlap <- renderText(
if (input$DEorSubset == "DE") {
if (length(intersect(selectedSets$a,selectedSets$b)) > 0) {
paste(length(intersect(selectedSets$a,selectedSets$b)),"cells in both sets.",
"Cells must be assigned to a single set prior to calculation.")
}
}
)
# ^^ Do the DE calcs -------------------------------------------------------
observeEvent(input$calcDE,{
newRes <- paste0("Comp:",gsub("[^A-Za-z0-9_]","",input$DEsetName))
if (length(intersect(selectedSets$a,selectedSets$b)) > 0) {
output$calcText <- renderText("Sets can't overlap (please assign cells to only one set).")
} else if (any(sapply(list(selectedSets$a,selectedSets$b),length) < 3)) {
output$calcText <- renderText("Each set must contain at least 3 cells.")
} else if (nchar(input$DEsetName) < 1) {
output$calcText <- renderText("Please name this comparison (in text box above).")
} else if (newRes %in% names(d$SCV)) {
output$calcText <- renderText("This comparison name has already been used.")
} else {
output$calcText <- renderText("")
withProgress({
# temp_warn <- options("warn")
# options(warn=-1)
temp <- rep("Unselected",ncol(getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2])))
names(temp) <- colnames(getExpr(inD,
Param(sCVdL[[1]],"assayType")[1],
Param(sCVdL[[1]],"assayType")[2]))
temp[selectedSets$a] <- "Set A"
temp[selectedSets$b] <- "Set B"
d$SCV[[newRes]] <- sCVdata(Clusters=factor(temp,levels=c("Set A","Set B")),
params=Param(d$SCV[[1]]))
# ^^^ Gene stats per set --------------------------------------------------------
incProgress(amount=1/5,detail="Set gene stats")
# ClustGeneStats(d$SCV[[newRes]]) <- fx_calcCGS(nge=getExpr(inD,Param(sCVdL[[1]],"assayType")),
# cl=Clusters(d$SCV[[newRes]]),
# exponent=Param(d$SCV[[newRes]],
# "exponent"),
# pseudocount=Param(d$SCV[[newRes]],
# "pseudocount"))
ClustGeneStats(d$SCV[[newRes]]) <- CalcCGS(d$SCV[[newRes]],inD)
d$SCV[[newRes]] <- labelCellTypes(sCV=d$SCV[[newRes]],
cellMarkers=cellMarkers,
symbolMap=symbolMap)
# ^^^ deTissue - DE per cluster vs all other data -------------------------------
incProgress(amount=1/5,detail="Set vs All")
# deTes <- fx_calcESvsRest(nge=getExpr(inD,Param(sCVdL[[1]],"assayType")),
# cl=Clusters(d$SCV[[newRes]]),
# CGS=ClustGeneStats(d$SCV[[newRes]]),
# exponent=Param(d$SCV[[newRes]],
# "exponent"),
# pseudocount=Param(d$SCV[[newRes]],
# "pseudocount"),
# DRthresh=Param(d$SCV[[newRes]],
# "DRthresh"))
# incProgress(amount=1/6,detail="DE vs tissue Wilcoxon rank sum calculations")
# DEvsRest(d$SCV[[newRes]]) <- fx_calcDEvsRest(nge=getExpr(inD,Param(sCVdL[[1]],"assayType")),
# cl=Clusters(d$SCV[[newRes]]),
# deTes=deTes)
DEvsRest(d$SCV[[newRes]]) <- CalcDEvsRest(d$SCV[[newRes]],inD)
# ^^^ DEmarker - DE per cluster vs each other cluster ---------------------------
incProgress(amount=2/5,detail="Set A vs Set B")
# deMes <- fx_calcEScombn(cl=Clusters(d$SCV[[newRes]]),
# CGS=ClustGeneStats(d$SCV[[newRes]]),
# DRthresh=Param(d$SCV[[newRes]],
# "DRthresh"))
# DEcombn(d$SCV[[newRes]]) <- fx_calcDEcombn(nge=getExpr(inD,Param(sCVdL[[1]],"assayType")),
# cl=Clusters(d$SCV[[newRes]]),
# deMes=deMes)
DEcombn(d$SCV[[newRes]]) <- CalcDEcombn(d$SCV[[newRes]],inD)
incProgress(amount=1/5,detail="Done")
selectedSets$a <- selectedSets$b <- NULL
filtList$filts <- NULL
# options(warn=temp_warn$warn)
},message="Calculating:")
res(newRes) # Automatically update the view to show the calculated results.
}
})
# ^^ Save buttons for set comparison ----
observeEvent(input$updateForViz, {
withProgress({
comp_sCVd <- d$SCV[input$res]
ClustGeneStats(comp_sCVd[[input$res]]) <- sapply(ClustGeneStats(comp_sCVd[[input$res]]),
function(X) X[,c("DR","MDGE","MGE")],
simplify=F)
incProgress(.5)
save(comp_sCVd,file=paste0(dataPath,dataTitle,"_selDE_",
sub("Comp:","",input$res,fixed=T),".RData"))
},message=paste0(
"Saving ",dataTitle,"_selDE_",sub("Comp:","",input$res,fixed=T),".RData to ",dataPath))
})
observeEvent(input$updateForViz2, {
withProgress({
comp_sCVd <- d$SCV[input$res]
ClustGeneStats(comp_sCVd[[input$res]]) <- sapply(ClustGeneStats(comp_sCVd[[input$res]]),
function(X) X[,c("DR","MDGE","MGE")],
simplify=F)
incProgress(.5)
save(comp_sCVd,file=paste0(dataPath,dataTitle,"_selDE_",
sub("Comp:","",input$res,fixed=T),".RData"))
},message=paste0(
"Saving ",dataTitle,"_selDE_",sub("Comp:","",input$res,fixed=T),".RData to ",dataPath))
})
}
# shinyApp ----
shinyApp(ui,server,options=list(...))
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.