diff --git a/DESCRIPTION b/DESCRIPTION
index 7d3a864..6974c81 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -13,6 +13,7 @@ Depends:
data.table (>= 1.12.2),
Matrix (>= 1.2-17),
hdf5r (>= 1.2.0),
+ R.utils (>= 2.8.0),
ggplot2 (>= 3.3.0),
grid ,
gridExtra (>= 2.3.0),
diff --git a/NAMESPACE b/NAMESPACE
index 39efd12..39649ca 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -4,6 +4,7 @@ export(addMeta)
export(checkConfig)
export(createConfig)
export(delMeta)
+export(getExampleData)
export(makeShinyApp)
export(makeShinyCodes)
export(makeShinyCodesMulti)
diff --git a/R/createConfig.R b/R/createConfig.R
index d241c1b..ed25476 100644
--- a/R/createConfig.R
+++ b/R/createConfig.R
@@ -27,7 +27,7 @@
#' scConf = createConfig(obj)
#'
#' @export
-createConfig <- function(obj, meta.to.include = NA, legendCols = 3){
+createConfig <- function(obj, meta.to.include = NA, legendCols = 4){
# Extract corresponding metadata
if(class(obj)[1] == "Seurat"){
objMeta = obj@meta.data
diff --git a/R/getExampleData.R b/R/getExampleData.R
new file mode 100644
index 0000000..d689f09
--- /dev/null
+++ b/R/getExampleData.R
@@ -0,0 +1,45 @@
+#' Download example Seurat objects
+#'
+#' Download example Seurat objects required for ShinyCell tutorial.
+#'
+#' @param type can be either "single" or "multi" which downloads one or two
+#' Seurat objects respectively for the Quick Start/Detailed Tutorial or
+#' Multi-dataset Tutorial respectively
+#'
+#' @return downloaded Seurat object
+#'
+#' @author John F. Ouyang
+#'
+#' @import data.table
+#'
+#' @examples
+#' getExampleData()
+#'
+#' @export
+getExampleData <- function(type = c("single", "multi")){
+ # Setup and checks
+ files = c("http://files.ddnetbio.com/hrpiFiles/readySeu_rset.rds",
+ "http://files.ddnetbio.com/hrpiFiles/readySeu_d21i.rds")
+ names(files) = c("./readySeu_rset.rds", "./readySeu_d21i.rds")
+ if(type[1] == "single"){
+ files = files[1]
+ } else if(type[1] != "multi"){
+ stop("argument has to be either 'single' or 'multi'!")
+ }
+
+ # Download files
+ for(i in seq_along(files)){
+ if(!file.exists(names(files)[i])) {
+ res <- tryCatch(download.file(files[i],
+ destfile = names(files)[i],
+ method = "auto"),
+ error = function(e) 1)
+ if(res == 1){
+ stop(paste0("Following file cannot be downloaded: ", names(files)[i]))
+ }
+ }
+ }
+ # return(scConf)
+}
+
+
diff --git a/R/makeShinyApp.R b/R/makeShinyApp.R
index 091bd16..847fbd5 100644
--- a/R/makeShinyApp.R
+++ b/R/makeShinyApp.R
@@ -11,14 +11,13 @@
#' objects (v3+) or the "logcounts" assay for SingleCellExperiment objects
#' @param gex.slot slot in single-cell assay to plot. This is only used
#' for Seurat objects (v3+). Default is to use the "data" slot
-#' @param gene.mapping specify a mapping to convert gene identifiers. A
-#' named vector must be supplied where \code{names(gene.mapping)} correspond
+#' @param gene.mapping specifies whether to convert Ensembl gene IDs (e.g.
+#' ENSG000xxx / ENSMUSG000xxx) into more "user-friendly" gene symbols. Set
+#' this to \code{TRUE} if you are using Ensembl gene IDs. Default is
+#' \code{FALSE} which is not to perform any conversion. Alternatively, users
+#' can supply a named vector where \code{names(gene.mapping)} correspond
#' to the actual gene identifiers in the gene expression matrix whereas
-#' \code{gene.mapping} correspond to new identifiers to map to. Partial
-#' mapping is allowed where the mapping is only provided for some gene
-#' identifiers, the remaining gene identifiers will remain unchanged and a
-#' warning message will be presented. Default is \code{NA} which is not to
-#' perform any mapping
+#' \code{gene.mapping} correspond to new identifiers to map to
#' @param shiny.title title for shiny app
#' @param shiny.footnotes text for shiny app footnote. Can be used to insert
#' citations for the single-cell data
@@ -55,7 +54,7 @@
#' @export
makeShinyApp <- function(
obj, scConf, gex.assay = NA, gex.slot = c("data", "scale.data", "counts"),
- gene.mapping = NA,
+ gene.mapping = FALSE,
shiny.title = "scRNA-seq shiny app", shiny.footnotes = '""',
shiny.dir = "shinyApp/",
default.gene1 = NA, default.gene2 = NA, default.multigene = NA,
diff --git a/R/makeShinyCodes.R b/R/makeShinyCodes.R
index e377b62..ea0755b 100644
--- a/R/makeShinyCodes.R
+++ b/R/makeShinyCodes.R
@@ -25,26 +25,51 @@
#' @export
makeShinyCodes <- function(shiny.title, shiny.footnotes,
shiny.prefix, shiny.dir){
- ### Write code for server.R
- fname = paste0(shiny.dir, "/server.R")
- readr::write_file(wrLib(
- c("shiny","shinyhelper","data.table","Matrix","magrittr","ggplot2",
- "hdf5r","ggdendro","gridExtra")), path = fname)
- readr::write_file(wrSVload(shiny.prefix), append = TRUE, path = fname)
- readr::write_file(wrSVfix(), append = TRUE, path = fname)
- readr::write_file(wrSVmain(shiny.prefix), append = TRUE, path = fname)
- readr::write_file(wrSVend(), append = TRUE, path = fname)
-
+ if(packageVersion("readr") >= "1.4.0"){
+ ### Write code for server.R
+ fname = paste0(shiny.dir, "/server.R")
+ readr::write_file(wrLib(
+ c("shiny","shinyhelper","data.table","Matrix","magrittr","ggplot2",
+ "hdf5r","ggdendro","gridExtra")), file = fname)
+ readr::write_file(wrSVload(shiny.prefix), append = TRUE, file = fname)
+ readr::write_file(wrSVfix(), append = TRUE, file = fname)
+ readr::write_file(wrSVmain(shiny.prefix), append = TRUE, file = fname)
+ readr::write_file(wrSVend(), append = TRUE, file = fname)
+
+
+ ### Write code for ui.R
+ fname = paste0(shiny.dir, "/ui.R")
+ readr::write_file(wrLib(
+ c("shiny","shinyhelper","data.table","Matrix","magrittr")), file = fname)
+ readr::write_file(wrUIload(shiny.prefix), append = TRUE, file = fname)
+ readr::write_file(wrUIsingle(shiny.title), append = TRUE, file = fname)
+ readr::write_file(wrUImain(shiny.prefix), append = TRUE, file = fname)
+ readr::write_file(glue::glue(', \n'), append = TRUE, file = fname)
+ readr::write_file(wrUIend(shiny.footnotes), append = TRUE, file = fname)
+
+ } else {
+ ### Write code for server.R
+ fname = paste0(shiny.dir, "/server.R")
+ readr::write_file(wrLib(
+ c("shiny","shinyhelper","data.table","Matrix","magrittr","ggplot2",
+ "hdf5r","ggdendro","gridExtra")), path = fname)
+ readr::write_file(wrSVload(shiny.prefix), append = TRUE, path = fname)
+ readr::write_file(wrSVfix(), append = TRUE, path = fname)
+ readr::write_file(wrSVmain(shiny.prefix), append = TRUE, path = fname)
+ readr::write_file(wrSVend(), append = TRUE, path = fname)
+
+
+ ### Write code for ui.R
+ fname = paste0(shiny.dir, "/ui.R")
+ readr::write_file(wrLib(
+ c("shiny","shinyhelper","data.table","Matrix","magrittr")), path = fname)
+ readr::write_file(wrUIload(shiny.prefix), append = TRUE, path = fname)
+ readr::write_file(wrUIsingle(shiny.title), append = TRUE, path = fname)
+ readr::write_file(wrUImain(shiny.prefix), append = TRUE, path = fname)
+ readr::write_file(glue::glue(', \n'), append = TRUE, path = fname)
+ readr::write_file(wrUIend(shiny.footnotes), append = TRUE, path = fname)
+ }
- ### Write code for ui.R
- fname = paste0(shiny.dir, "/ui.R")
- readr::write_file(wrLib(
- c("shiny","shinyhelper","data.table","Matrix","magrittr")), path = fname)
- readr::write_file(wrUIload(shiny.prefix), append = TRUE, path = fname)
- readr::write_file(wrUIsingle(shiny.title), append = TRUE, path = fname)
- readr::write_file(wrUImain(shiny.prefix), append = TRUE, path = fname)
- readr::write_file(glue::glue(', \n'), append = TRUE, path = fname)
- readr::write_file(wrUIend(shiny.footnotes), append = TRUE, path = fname)
}
diff --git a/R/makeShinyCodesMulti.R b/R/makeShinyCodesMulti.R
index 7d74f9b..80460d0 100644
--- a/R/makeShinyCodesMulti.R
+++ b/R/makeShinyCodesMulti.R
@@ -35,37 +35,73 @@ makeShinyCodesMulti <- function(shiny.title, shiny.footnotes,
stop("length of shiny.prefix and shiny.headers does not match!")
}
- ### Write code for server.R
- fname = paste0(shiny.dir, "/server.R")
- readr::write_file(wrLib(
- c("shiny","shinyhelper","data.table","Matrix","magrittr","ggplot2",
- "hdf5r","ggdendro","gridExtra")), path = fname)
- for(i in shiny.prefix){
- readr::write_file(wrSVload(i), append = TRUE, path = fname)
+ if(packageVersion("readr") >= "1.4.0"){
+ ### Write code for server.R
+ fname = paste0(shiny.dir, "/server.R")
+ readr::write_file(wrLib(
+ c("shiny","shinyhelper","data.table","Matrix","magrittr","ggplot2",
+ "hdf5r","ggdendro","gridExtra")), file = fname)
+ for(i in shiny.prefix){
+ readr::write_file(wrSVload(i), append = TRUE, file = fname)
+ }
+ readr::write_file(wrSVfix(), append = TRUE, file = fname)
+ for(i in shiny.prefix){
+ readr::write_file(wrSVmain(i), append = TRUE, file = fname)
+ }
+ readr::write_file(wrSVend(), append = TRUE, file = fname)
+
+
+ ### Write code for ui.R
+ fname = paste0(shiny.dir, "/ui.R")
+ readr::write_file(wrLib(
+ c("shiny","shinyhelper","data.table","Matrix","magrittr")), file = fname)
+ for(i in shiny.prefix){
+ readr::write_file(wrUIload(i), append = TRUE, file = fname)
+ }
+ readr::write_file(wrUIsingle(shiny.title), append = TRUE, file = fname)
+ for(i in seq_along(shiny.prefix)){
+ hhh = shiny.headers[i]
+ readr::write_file(glue::glue('navbarMenu("{hhh}",'),
+ append = TRUE, file = fname)
+ readr::write_file(wrUImain(shiny.prefix[i]), append = TRUE, file = fname)
+ readr::write_file(glue::glue('), \n\n\n'), append = TRUE, file = fname)
+ }
+ readr::write_file(wrUIend(shiny.footnotes), append = TRUE, file = fname)
+
+ } else {
+ ### Write code for server.R
+ fname = paste0(shiny.dir, "/server.R")
+ readr::write_file(wrLib(
+ c("shiny","shinyhelper","data.table","Matrix","magrittr","ggplot2",
+ "hdf5r","ggdendro","gridExtra")), path = fname)
+ for(i in shiny.prefix){
+ readr::write_file(wrSVload(i), append = TRUE, path = fname)
+ }
+ readr::write_file(wrSVfix(), append = TRUE, path = fname)
+ for(i in shiny.prefix){
+ readr::write_file(wrSVmain(i), append = TRUE, path = fname)
+ }
+ readr::write_file(wrSVend(), append = TRUE, path = fname)
+
+
+ ### Write code for ui.R
+ fname = paste0(shiny.dir, "/ui.R")
+ readr::write_file(wrLib(
+ c("shiny","shinyhelper","data.table","Matrix","magrittr")), path = fname)
+ for(i in shiny.prefix){
+ readr::write_file(wrUIload(i), append = TRUE, path = fname)
+ }
+ readr::write_file(wrUIsingle(shiny.title), append = TRUE, path = fname)
+ for(i in seq_along(shiny.prefix)){
+ hhh = shiny.headers[i]
+ readr::write_file(glue::glue('navbarMenu("{hhh}",'),
+ append = TRUE, path = fname)
+ readr::write_file(wrUImain(shiny.prefix[i]), append = TRUE, path = fname)
+ readr::write_file(glue::glue('), \n\n\n'), append = TRUE, path = fname)
+ }
+ readr::write_file(wrUIend(shiny.footnotes), append = TRUE, path = fname)
}
- readr::write_file(wrSVfix(), append = TRUE, path = fname)
- for(i in shiny.prefix){
- readr::write_file(wrSVmain(i), append = TRUE, path = fname)
- }
- readr::write_file(wrSVend(), append = TRUE, path = fname)
-
- ### Write code for ui.R
- fname = paste0(shiny.dir, "/ui.R")
- readr::write_file(wrLib(
- c("shiny","shinyhelper","data.table","Matrix","magrittr")), path = fname)
- for(i in shiny.prefix){
- readr::write_file(wrUIload(i), append = TRUE, path = fname)
- }
- readr::write_file(wrUIsingle(shiny.title), append = TRUE, path = fname)
- for(i in seq_along(shiny.prefix)){
- hhh = shiny.headers[i]
- readr::write_file(glue::glue('navbarMenu("{hhh}",'),
- append = TRUE, path = fname)
- readr::write_file(wrUImain(shiny.prefix[i]), append = TRUE, path = fname)
- readr::write_file(glue::glue('), \n\n\n'), append = TRUE, path = fname)
- }
- readr::write_file(wrUIend(shiny.footnotes), append = TRUE, path = fname)
}
diff --git a/R/makeShinyFiles.R b/R/makeShinyFiles.R
index 3e1c5b1..4060872 100644
--- a/R/makeShinyFiles.R
+++ b/R/makeShinyFiles.R
@@ -18,14 +18,13 @@
#' objects (v3+) or the "logcounts" assay for SingleCellExperiment objects
#' @param gex.slot slot in single-cell assay to plot. This is only used
#' for Seurat objects (v3+). Default is to use the "data" slot
-#' @param gene.mapping specify a mapping to convert gene identifiers. A
-#' named vector must be supplied where \code{names(gene.mapping)} correspond
+#' @param gene.mapping specifies whether to convert Ensembl gene IDs (e.g.
+#' ENSG000xxx / ENSMUSG000xxx) into more "user-friendly" gene symbols. Set
+#' this to \code{TRUE} if you are using Ensembl gene IDs. Default is
+#' \code{FALSE} which is not to perform any conversion. Alternatively, users
+#' can supply a named vector where \code{names(gene.mapping)} correspond
#' to the actual gene identifiers in the gene expression matrix whereas
-#' \code{gene.mapping} correspond to new identifiers to map to. Partial
-#' mapping is allowed where the mapping is only provided for some gene
-#' identifiers, the remaining gene identifiers will remain unchanged and a
-#' warning message will be presented. Default is \code{NA} which is not to
-#' perform any mapping
+#' \code{gene.mapping} correspond to new identifiers to map to
#' @param shiny.prefix specify file prefix
#' @param shiny.dir specify directory to create the shiny app in
#' @param default.gene1 specify primary default gene to show
@@ -51,60 +50,108 @@
#' @export
makeShinyFiles <- function(
obj, scConf, gex.assay = NA, gex.slot = c("data", "scale.data", "counts"),
- gene.mapping = NA, shiny.prefix, shiny.dir = "shinyApp/",
+ gene.mapping = FALSE, shiny.prefix = "sc1", shiny.dir = "shinyApp/",
default.gene1 = NA, default.gene2 = NA, default.multigene = NA,
default.dimred = c("UMAP_1", "UMAP_2")){
### Preprocessing and checks
# Generate defaults for gex.assay / gex.slot
if(class(obj)[1] == "Seurat"){
if(is.na(gex.assay[1])){gex.assay = "RNA"}
- gex.matrix = slot(obj@assays[[gex.assay[1]]], gex.slot[1])
+ gex.matdim = dim(slot(obj@assays[[gex.assay[1]]], gex.slot[1]))
+ gex.rownm = rownames(slot(obj@assays[[gex.assay[1]]], gex.slot[1]))
+ gex.colnm = colnames(slot(obj@assays[[gex.assay[1]]], gex.slot[1]))
+ defGenes = obj@assays[[gex.assay[1]]]@var.features[1:10]
+ if(is.na(defGenes[1])){
+ warning(paste0("Variable genes not found! Did you use specify the ",
+ "wrong assay or wrong seurat object?"))
+ defGenes = gex.rownm[1:10]
+ }
sc1meta = data.table(sampleID = rownames(obj@meta.data), obj@meta.data)
} else if (class(obj)[1] == "SingleCellExperiment"){
if(is.na(gex.assay[1])){gex.assay = "logcounts"}
- gex.matrix = assay(obj, gex.assay[1])
+ gex.matdim = dim(SingleCellExperiment::assay(obj, gex.assay[1]))
+ gex.rownm = rownames(SingleCellExperiment::assay(obj, gex.assay[1]))
+ gex.colnm = colnames(SingleCellExperiment::assay(obj, gex.assay[1]))
+ defGenes = gex.rownm[1:10]
sc1meta = data.table(sampleID = rownames(obj@colData), obj@colData)
} else {
stop("Only Seurat or SingleCellExperiment objects are accepted!")
}
- gex.ident = rownames(gex.matrix)
- # Perform gene.mapping if provided
- if(!is.na(gene.mapping[1])){
- # Check if gene.mapping is partial or not
- if(!all(gex.ident %in% names(gene.mapping))){
- warning("Mapping for some gene identifiers are not provided!")
- tmp1 = gex.ident[gex.ident %in% names(gene.mapping)]
+ # Perform gene.mapping if specified (also map defGenes)
+ if(gene.mapping[1] == TRUE){
+ if(sum(grepl("^ENSG000", gex.rownm)) >= sum(grepl("^ENSG000", gex.rownm))){
+ tmp1 = fread(system.file("extdata", "geneMapHS.txt.gz",
+ package = "ShinyCell"))
+ } else {
+ tmp1 = fread(system.file("extdata", "geneMapMM.txt.gz",
+ package = "ShinyCell"))
+ }
+ gene.mapping = tmp1$geneName
+ names(gene.mapping) = tmp1$geneID
+ }
+ # Check if gene.mapping is partial or not
+ if(gene.mapping[1] == FALSE){
+ gene.mapping = gex.rownm
+ names(gene.mapping) = gex.rownm # Basically no mapping
+ } else {
+ if(!all(gex.rownm %in% names(gene.mapping))){
+ # warning("Mapping for some gene identifiers are not provided!")
+ tmp1 = gex.rownm[gex.rownm %in% names(gene.mapping)]
tmp1 = gene.mapping[tmp1]
- tmp2 = gex.ident[!gex.ident %in% names(gene.mapping)]
+ tmp2 = gex.rownm[!gex.rownm %in% names(gene.mapping)]
names(tmp2) = tmp2
gene.mapping = c(tmp1, tmp2)
}
- gene.mapping = gene.mapping[gex.ident]
- names(gene.mapping) = NULL
- rownames(gex.matrix) = gene.mapping
- } else {
- gene.mapping = rownames(gex.matrix)
+ gene.mapping = gene.mapping[gex.rownm]
}
+ defGenes = gene.mapping[defGenes]
- # Check that default.gene1 / default.gene2 / default.multigene exist
- if(!default.gene1[1] %in% gene.mapping){
- stop("default.gene1 does not exist in gene expression!")
+ # Check default.gene1 / default.gene2 / default.multigene
+ default.gene1 = default.gene1[1]
+ default.gene2 = default.gene2[1]
+ if(is.na(default.gene1)){default.gene1 = defGenes[1]}
+ if(is.na(default.gene2)){default.gene2 = defGenes[2]}
+ if(is.na(default.multigene[1])){default.multigene = defGenes}
+ if(default.gene1 %in% gene.mapping){
+ default.gene1 = default.gene1
+ } else if(default.gene1 %in% names(gene.mapping)){
+ default.gene1 = gene.mapping[default.gene1]
+ } else {
+ warning("default.gene1 doesn't exist in gene expression, using defaults...")
+ default.gene1 = defGenes[1]
}
- if(!default.gene2[1] %in% gene.mapping){
- stop("default.gene2 does not exist in gene expression!")
+ if(default.gene2 %in% gene.mapping){
+ default.gene2 = default.gene2
+ } else if(default.gene2 %in% names(gene.mapping)){
+ default.gene2 = gene.mapping[default.gene2]
+ } else {
+ warning("default.gene2 doesn't exist in gene expression, using defaults...")
+ default.gene2 = defGenes[2]
}
- if(!all(default.multigene %in% gene.mapping)){
- stop("default.multigene does not exist in gene expression!")
+ if(all(default.multigene %in% gene.mapping)){
+ default.multigene = default.multigene
+ } else if(all(default.multigene %in% names(gene.mapping))){
+ default.multigene = gene.mapping[default.multigene]
+ } else {
+ warning(paste0("default.multigene doesn't exist in gene expression, ",
+ "using defaults..."))
+ default.multigene = defGenes
}
-
-
+
### Actual object generation
# Make XXXmeta.rds and XXXconf.rds (updated with dimred info)
sc1conf = scConf
sc1conf$dimred = FALSE
sc1meta = sc1meta[, c("sampleID", as.character(sc1conf$ID)), with = FALSE]
+ # Factor metadata again
+ for(i in as.character(sc1conf[!is.na(fID)]$ID)){
+ sc1meta[[i]] = factor(sc1meta[[i]],
+ levels = strsplit(sc1conf[ID == i]$fID, "\\|")[[1]])
+ levels(sc1meta[[i]]) = strsplit(sc1conf[ID == i]$fUI, "\\|")[[1]]
+ sc1conf[ID == i]$fID = sc1conf[ID == i]$fUI
+ }
# Extract dimred and append to both XXXmeta.rds and XXXconf.rds...
if(class(obj)[1] == "Seurat"){
for(iDR in names(obj@reductions)){
@@ -148,14 +195,35 @@ makeShinyFiles <- function(
sc1gexpr.grp <- sc1gexpr$create_group("grp")
sc1gexpr.grp.data <- sc1gexpr.grp$create_dataset(
"data", dtype = h5types$H5T_NATIVE_FLOAT,
- space = H5S$new("simple", dims = dim(gex.matrix), maxdims = dim(gex.matrix)),
- chunk_dims = c(1,dim(gex.matrix)[2]))
- sc1gexpr.grp.data[, ] <- as.matrix(gex.matrix[, sc1meta$sampleID])
+ space = H5S$new("simple", dims = gex.matdim, maxdims = gex.matdim),
+ chunk_dims = c(1,gex.matdim[2]))
+ if(class(obj)[1] == "Seurat"){
+ for(i in 1:floor((gex.matdim[1]-10)/500)){
+ sc1gexpr.grp.data[((i-1)*500+1):(i*500), ] <- as.matrix(
+ slot(obj@assays[[gex.assay[1]]], gex.slot[1])[((i-1)*500+1):(i*500),])
+ }
+ sc1gexpr.grp.data[(i*500+1):gex.matdim[1], ] <- as.matrix(
+ slot(obj@assays[[gex.assay[1]]], gex.slot[1])[(i*500+1):gex.matdim[1],])
+ } else {
+ for(i in 1:floor((gex.matdim[1]-10)/500)){
+ sc1gexpr.grp.data[((i-1)*500+1):(i*500), ] <- as.matrix(
+ SingleCellExperiment::assay(obj, gex.assay[1])[((i-1)*500+1):(i*500),])
+ }
+ sc1gexpr.grp.data[(i*500+1):gex.matdim[1], ] <- as.matrix(
+ SingleCellExperiment::assay(obj, gex.assay[1])[(i*500+1):gex.matdim[1],])
+ }
+ # sc1gexpr.grp.data[, ] <- as.matrix(gex.matrix[,])
sc1gexpr$close_all()
+ if(!all.equal(sc1meta$sampleID, gex.colnm)){
+ sc1meta$sampleID = factor(sc1meta$sampleID, levels = gex.colnm)
+ sc1meta = sc1meta[order(sampleID)]
+ sc1meta$sampleID = as.character(sc1meta$sampleID)
+ }
# Make XXXgenes.rds
- sc1gene = seq(dim(gex.matrix)[1])
- names(sc1gene) = rownames(gex.matrix)
+ sc1gene = seq(gex.matdim[1])
+ names(gene.mapping) = NULL
+ names(sc1gene) = gene.mapping
# Make XXXdef.rds (list of defaults)
if(all(default.dimred %in% sc1conf[dimred == TRUE]$ID)){
@@ -178,13 +246,13 @@ makeShinyFiles <- function(
}
# Note that we stored the display name here
sc1def = list()
- sc1def$meta1 = scConf[default == 1]$UI # Use display name
- sc1def$meta2 = scConf[default == 2]$UI # Use display name
- sc1def$gene1 = default.gene1[1] # Actual == Display name
- sc1def$gene2 = default.gene2[1] # Actual == Display name
+ sc1def$meta1 = sc1conf[default == 1]$UI # Use display name
+ sc1def$meta2 = sc1conf[default == 2]$UI # Use display name
+ sc1def$gene1 = default.gene1 # Actual == Display name
+ sc1def$gene2 = default.gene2 # Actual == Display name
sc1def$genes = default.multigene # Actual == Display name
sc1def$dimred = default.dimred # Use display name
- scConf = scConf[, -"default", with = FALSE]
+ sc1conf = sc1conf[, -c("fUI", "default"), with = FALSE]
diff --git a/R/showLegend.R b/R/showLegend.R
index ed09a38..3bdeaea 100644
--- a/R/showLegend.R
+++ b/R/showLegend.R
@@ -26,7 +26,7 @@
#' grid.draw(leg)
#'
#' @export
-showLegend <- function(scConf, fontSize = 18){
+showLegend <- function(scConf, fontSize = 14){
# Start making config data.table
scLegend = list()
@@ -35,7 +35,8 @@ showLegend <- function(scConf, fontSize = 18){
# Ensure categorical
ggData = data.table(X = 1, Y = 1,
col = strsplit(scConf[ID == iMeta]$fID, "\\|")[[1]])
- ggOut = ggplot(ggData, aes(X, Y, color = col)) + geom_point(size = 5) +
+ ggOut = ggplot(ggData, aes(X, Y, color = col)) +
+ geom_point(size = fontSize / 5) +
scale_color_manual(scConf[ID == iMeta]$UI,
values = strsplit(scConf[ID == iMeta]$fCL, "\\|")[[1]],
labels = strsplit(scConf[ID == iMeta]$fUI, "\\|")[[1]]) +
@@ -52,7 +53,8 @@ showLegend <- function(scConf, fontSize = 18){
# Make legend for continuous
ggData = data.table(X = 1, Y = 1, col = 1:100)
- ggOut = ggplot(ggData, aes(X, Y, color = col)) + geom_point(size = 5) +
+ ggOut = ggplot(ggData, aes(X, Y, color = col)) +
+ geom_point(size = fontSize / 5) +
scale_color_gradientn(paste0(scConf[is.na(fID)]$UI, collapse = "\n"),
colours = c("grey85", brewer.pal(9, "OrRd")),
breaks = c(1,100), labels = c("low","high")) +
diff --git a/R/writer.R b/R/writer.R
index 1622074..8145aec 100644
--- a/R/writer.R
+++ b/R/writer.R
@@ -95,19 +95,15 @@ wrSVfix <- function() {
' }} else if(inpord == "Min-1st"){{ \n',
' ggData = ggData[order(-val)] \n',
' }} \n',
+ ' rat = (max(ggData$X) - min(ggData$X)) / (max(ggData$Y) - min(ggData$Y)) \n',
' \n',
' # Do factoring if required \n',
' if(!is.na(inpConf[UI == inp1]$fCL)){{ \n',
' ggCol = strsplit(inpConf[UI == inp1]$fCL, "\\\\|")[[1]] \n',
- ' if(is.na(inpConf[UI == inp1]$fUI)){{ \n',
- ' ggDes = strsplit(inpConf[UI == inp1]$fID, "\\\\|")[[1]] \n',
- ' }} else {{ \n',
- ' ggDes = strsplit(inpConf[UI == inp1]$fUI, "\\\\|")[[1]] \n',
- ' }} \n',
- ' names(ggCol) = levels(ggData$val); names(ggDes) = levels(ggData$val) \n',
+ ' names(ggCol) = levels(ggData$val) \n',
' ggLvl = levels(ggData$val)[levels(ggData$val) %in% unique(ggData$val)] \n',
' ggData$val = factor(ggData$val, levels = ggLvl) \n',
- ' ggCol = ggCol[ggLvl]; ggDes = ggDes[ggLvl] \n',
+ ' ggCol = ggCol[ggLvl] \n',
' }} \n',
' \n',
' # Actual ggplot \n',
@@ -118,12 +114,11 @@ wrSVfix <- function() {
' ggOut = ggOut + scale_color_gradientn("", colours = cList[[inpcol]]) + \n',
' guides(color = guide_colorbar(barwidth = 15)) \n',
' }} else {{ \n',
- ' ggOut = ggOut + scale_color_manual("", values = ggCol, labels = ggDes) + \n',
+ ' ggOut = ggOut + scale_color_manual("", values = ggCol) + \n',
' guides(color = guide_legend(override.aes = list(size = 5), \n',
' nrow = inpConf[UI == inp1]$fRow)) \n',
' }} \n',
' if(inpasp == "Square") {{ \n',
- ' rat = (max(ggData$X) - min(ggData$X)) / (max(ggData$Y) - min(ggData$Y)) \n',
' ggOut = ggOut + coord_fixed(ratio = rat) \n',
' }} else if(inpasp == "Fixed") {{ \n',
' ggOut = ggOut + coord_fixed() \n',
@@ -150,6 +145,7 @@ wrSVfix <- function() {
' }} else if(inpord == "Min-1st"){{ \n',
' ggData = ggData[order(-val)] \n',
' }} \n',
+ ' rat = (max(ggData$X) - min(ggData$X)) / (max(ggData$Y) - min(ggData$Y)) \n',
' \n',
' # Actual ggplot \n',
' ggOut = ggplot(ggData, aes(X, Y, color = val)) + \n',
@@ -158,7 +154,6 @@ wrSVfix <- function() {
' scale_color_gradientn(inp1, colours = cList[[inpcol]]) + \n',
' guides(color = guide_colorbar(barwidth = 15)) \n',
' if(inpasp == "Square") {{ \n',
- ' rat = (max(ggData$X) - min(ggData$X)) / (max(ggData$Y) - min(ggData$Y)) \n',
' ggOut = ggOut + coord_fixed(ratio = rat) \n',
' }} else if(inpasp == "Fixed") {{ \n',
' ggOut = ggOut + coord_fixed() \n',
@@ -166,6 +161,50 @@ wrSVfix <- function() {
' return(ggOut) \n',
'}} \n',
' \n',
+ 'scVioBox <- function(inpConf, inpMeta, inp1, inp2, inpH5, inpGene, \n',
+ ' inptyp, inppts, inpsiz, inpfsz){{ \n',
+ ' # Prepare ggData \n',
+ ' ggData = inpMeta[, c(inpConf[UI == inp1]$ID, inpConf[grp == TRUE]$ID), \n',
+ ' with = FALSE] \n',
+ ' colnames(ggData)[1] = c("X") \n',
+ ' \n',
+ ' # Load in either cell meta or gene expr\n',
+ ' if(inp2 %in% inpConf$UI){{ \n',
+ ' ggData$val = inpMeta[[inpConf[UI == inp2]$ID]] \n',
+ ' }} else {{ \n',
+ ' h5file <- H5File$new(inpH5, mode = "r") \n',
+ ' h5data <- h5file[["grp"]][["data"]] \n',
+ ' ggData$val = h5data$read(args = list(inpGene[inp2], quote(expr=))) \n',
+ ' ggData[val < 0]$val = 0 \n',
+ ' set.seed(42) \n',
+ ' tmpNoise = rnorm(length(ggData$val)) * diff(range(ggData$val)) / 1000 \n',
+ ' ggData$val = ggData$val + tmpNoise \n',
+ ' h5file$close_all() \n',
+ ' }} \n',
+ ' \n',
+ ' # Do factoring \n',
+ ' ggCol = strsplit(inpConf[UI == inp1]$fCL, "\\\\|")[[1]] \n',
+ ' names(ggCol) = levels(ggData$X) \n',
+ ' ggLvl = levels(ggData$X)[levels(ggData$X) %in% unique(ggData$X)] \n',
+ ' ggData$X = factor(ggData$X, levels = ggLvl) \n',
+ ' ggCol = ggCol[ggLvl] \n',
+ ' \n',
+ ' # Actual ggplot \n',
+ ' if(inptyp == "violin"){{ \n',
+ ' ggOut = ggplot(ggData, aes(X, val, fill = X)) + geom_violin(scale = "width") \n',
+ ' }} else {{ \n',
+ ' ggOut = ggplot(ggData, aes(X, val, fill = X)) + geom_boxplot() \n',
+ ' }} \n',
+ ' if(inppts){{ \n',
+ ' ggOut = ggOut + geom_jitter(size = inpsiz, shape = 16) \n',
+ ' }} \n',
+ ' ggOut = ggOut + xlab(inp1) + ylab(inp2) + \n',
+ ' sctheme(base_size = sList[inpfsz], Xang = 45, XjusH = 1) + \n',
+ ' scale_fill_manual("", values = ggCol) +\n',
+ ' theme(legend.position = "none")\n',
+ ' return(ggOut) \n',
+ '}} \n',
+ ' \n',
'# Get gene list \n',
'scGeneList <- function(inp, inpGene){{ \n',
' geneList = data.table(gene = unique(trimws(strsplit(inp, ",|;|\n")[[1]])), \n',
@@ -181,8 +220,8 @@ wrSVfix <- function() {
' # Identify genes that are in our dataset \n',
' geneList = scGeneList(inp, inpGene) \n',
' geneList = geneList[present == TRUE] \n',
- ' validate(need(nrow(geneList) <= 50, "More than 50 genes to plot! Please reduce the gene list!")) \n',
- ' validate(need(nrow(geneList) > 1, "Please input at least 2 genes to plot!")) \n',
+ ' shiny::validate(need(nrow(geneList) <= 50, "More than 50 genes to plot! Please reduce the gene list!")) \n',
+ ' shiny::validate(need(nrow(geneList) > 1, "Please input at least 2 genes to plot!")) \n',
' \n',
' # Prepare ggData \n',
' h5file <- H5File$new(inpH5, mode = "r") \n',
@@ -325,12 +364,15 @@ wrSVfix <- function() {
#' @export wrSVmain
#'
wrSVmain <- function(prefix) {
- glue::glue(' updateSelectizeInput(session, "{prefix}a1inp2", choices = sort(names({prefix}gene)), \n',
+ glue::glue(' updateSelectizeInput(session, "{prefix}a1inp2", choices = sort(names({prefix}gene)), \n',
' selected = {prefix}def$gene1, server = TRUE) \n',
' updateSelectizeInput(session, "{prefix}a3inp1", choices = sort(names({prefix}gene)), \n',
' selected = {prefix}def$gene1, server = TRUE) \n',
' updateSelectizeInput(session, "{prefix}a3inp2", choices = sort(names({prefix}gene)), \n',
' selected = {prefix}def$gene2, server = TRUE) \n',
+ ' updateSelectizeInput(session, "{prefix}b1inp2", \n',
+ ' choices = c({prefix}conf[is.na(fID)]$UI,sort(names({prefix}gene))), \n',
+ ' selected = {prefix}conf[is.na(fID)]$UI[1], server = TRUE) \n',
' \n',
' \n',
' ### Plots for tab a1 \n',
@@ -346,7 +388,7 @@ wrSVmain <- function(prefix) {
' filename = function() {{ paste0("{prefix}",input${prefix}a1drX,"_",input${prefix}a1drY,"_", \n',
' input${prefix}a1inp1,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
- ' file, device = "pdf", height = 6, width = 6, useDingbats = FALSE, \n',
+ ' file, device = "pdf", height = input${prefix}a1oup1.h, width = input${prefix}a1oup1.w, useDingbats = FALSE, \n',
' plot = scDRcell({prefix}conf, {prefix}meta, input${prefix}a1drX, input${prefix}a1drY, input${prefix}a1inp1, \n',
' input${prefix}a1siz1, input${prefix}a1col1, input${prefix}a1ord1, \n',
' input${prefix}a1fsz, input${prefix}a1asp, input${prefix}a1txt) ) \n',
@@ -355,7 +397,7 @@ wrSVmain <- function(prefix) {
' filename = function() {{ paste0("{prefix}",input${prefix}a1drX,"_",input${prefix}a1drY,"_", \n',
' input${prefix}a1inp1,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
- ' file, device = "png", height = 6, width = 6, \n',
+ ' file, device = "png", height = input${prefix}a1oup1.h, width = input${prefix}a1oup1.w, \n',
' plot = scDRcell({prefix}conf, {prefix}meta, input${prefix}a1drX, input${prefix}a1drY, input${prefix}a1inp1, \n',
' input${prefix}a1siz1, input${prefix}a1col1, input${prefix}a1ord1, \n',
' input${prefix}a1fsz, input${prefix}a1asp, input${prefix}a1txt) ) \n',
@@ -374,7 +416,7 @@ wrSVmain <- function(prefix) {
' filename = function() {{ paste0("{prefix}",input${prefix}a1drX,"_",input${prefix}a1drY,"_", \n',
' input${prefix}a1inp2,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
- ' file, device = "pdf", height = 6, width = 6, useDingbats = FALSE, \n',
+ ' file, device = "pdf", height = input${prefix}a1oup2.h, width = input${prefix}a1oup2.w, useDingbats = FALSE, \n',
' plot = scDRgene({prefix}conf, {prefix}meta, input${prefix}a1drX, input${prefix}a1drY, input${prefix}a1inp2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a1siz2, input${prefix}a1col2, input${prefix}a1ord2, \n',
@@ -384,7 +426,7 @@ wrSVmain <- function(prefix) {
' filename = function() {{ paste0("{prefix}",input${prefix}a1drX,"_",input${prefix}a1drY,"_", \n',
' input${prefix}a1inp2,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
- ' file, device = "png", height = 6, width = 6, \n',
+ ' file, device = "png", height = input${prefix}a1oup2.h, width = input${prefix}a1oup2.w, \n',
' plot = scDRgene({prefix}conf, {prefix}meta, input${prefix}a1drX, input${prefix}a1drY, input${prefix}a1inp2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a1siz2, input${prefix}a1col2, input${prefix}a1ord2, \n',
@@ -405,7 +447,7 @@ wrSVmain <- function(prefix) {
' filename = function() {{ paste0("{prefix}",input${prefix}a2drX,"_",input${prefix}a2drY,"_", \n',
' input${prefix}a2inp1,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
- ' file, device = "pdf", height = 6, width = 6, useDingbats = FALSE, \n',
+ ' file, device = "pdf", height = input${prefix}a2oup1.h, width = input${prefix}a2oup1.w, useDingbats = FALSE, \n',
' plot = scDRcell({prefix}conf, {prefix}meta, input${prefix}a2drX, input${prefix}a2drY, input${prefix}a2inp1, \n',
' input${prefix}a2siz1, input${prefix}a2col1, input${prefix}a2ord1, \n',
' input${prefix}a2fsz, input${prefix}a2asp, input${prefix}a2txt) ) \n',
@@ -414,7 +456,7 @@ wrSVmain <- function(prefix) {
' filename = function() {{ paste0("{prefix}",input${prefix}a2drX,"_",input${prefix}a2drY,"_", \n',
' input${prefix}a2inp1,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
- ' file, device = "png", height = 6, width = 6, \n',
+ ' file, device = "png", height = input${prefix}a2oup1.h, width = input${prefix}a2oup1.w, \n',
' plot = scDRcell({prefix}conf, {prefix}meta, input${prefix}a2drX, input${prefix}a2drY, input${prefix}a2inp1, \n',
' input${prefix}a2siz1, input${prefix}a2col1, input${prefix}a2ord1, \n',
' input${prefix}a2fsz, input${prefix}a2asp, input${prefix}a2txt) ) \n',
@@ -432,7 +474,7 @@ wrSVmain <- function(prefix) {
' filename = function() {{ paste0("{prefix}",input${prefix}a2drX,"_",input${prefix}a2drY,"_", \n',
' input${prefix}a2inp2,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
- ' file, device = "pdf", height = 6, width = 6, useDingbats = FALSE, \n',
+ ' file, device = "pdf", height = input${prefix}a2oup2.h, width = input${prefix}a2oup2.w, useDingbats = FALSE, \n',
' plot = scDRcell({prefix}conf, {prefix}meta, input${prefix}a2drX, input${prefix}a2drY, input${prefix}a2inp2, \n',
' input${prefix}a2siz2, input${prefix}a2col2, input${prefix}a2ord2, \n',
' input${prefix}a2fsz, input${prefix}a2asp, input${prefix}a2txt) ) \n',
@@ -441,7 +483,7 @@ wrSVmain <- function(prefix) {
' filename = function() {{ paste0("{prefix}",input${prefix}a2drX,"_",input${prefix}a2drY,"_", \n',
' input${prefix}a2inp2,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
- ' file, device = "png", height = 6, width = 6, \n',
+ ' file, device = "png", height = input${prefix}a2oup2.h, width = input${prefix}a2oup2.w, \n',
' plot = scDRcell({prefix}conf, {prefix}meta, input${prefix}a2drX, input${prefix}a2drY, input${prefix}a2inp2, \n',
' input${prefix}a2siz2, input${prefix}a2col2, input${prefix}a2ord2, \n',
' input${prefix}a2fsz, input${prefix}a2asp, input${prefix}a2txt) ) \n',
@@ -462,7 +504,7 @@ wrSVmain <- function(prefix) {
' filename = function() {{ paste0("{prefix}",input${prefix}a3drX,"_",input${prefix}a3drY,"_", \n',
' input${prefix}a3inp1,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
- ' file, device = "pdf", height = 6, width = 6, useDingbats = FALSE, \n',
+ ' file, device = "pdf", height = input${prefix}a3oup1.h, width = input${prefix}a3oup1.w, useDingbats = FALSE, \n',
' plot = scDRgene({prefix}conf, {prefix}meta, input${prefix}a3drX, input${prefix}a3drY, input${prefix}a3inp1, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a3siz1, input${prefix}a3col1, input${prefix}a3ord1, \n',
@@ -472,7 +514,7 @@ wrSVmain <- function(prefix) {
' filename = function() {{ paste0("{prefix}",input${prefix}a3drX,"_",input${prefix}a3drY,"_", \n',
' input${prefix}a3inp1,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
- ' file, device = "png", height = 6, width = 6, \n',
+ ' file, device = "png", height = input${prefix}a3oup1.h, width = input${prefix}a3oup1.w, \n',
' plot = scDRgene({prefix}conf, {prefix}meta, input${prefix}a3drX, input${prefix}a3drY, input${prefix}a3inp1, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a3siz1, input${prefix}a3col1, input${prefix}a3ord1, \n',
@@ -492,7 +534,7 @@ wrSVmain <- function(prefix) {
' filename = function() {{ paste0("{prefix}",input${prefix}a3drX,"_",input${prefix}a3drY,"_", \n',
' input${prefix}a3inp2,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
- ' file, device = "pdf", height = 6, width = 6, useDingbats = FALSE, \n',
+ ' file, device = "pdf", height = input${prefix}a3oup2.h, width = input${prefix}a3oup2.w, useDingbats = FALSE, \n',
' plot = scDRgene({prefix}conf, {prefix}meta, input${prefix}a3drX, input${prefix}a3drY, input${prefix}a3inp2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a3siz2, input${prefix}a3col2, input${prefix}a3ord2, \n',
@@ -502,7 +544,7 @@ wrSVmain <- function(prefix) {
' filename = function() {{ paste0("{prefix}",input${prefix}a3drX,"_",input${prefix}a3drY,"_", \n',
' input${prefix}a3inp2,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
- ' file, device = "png", height = 6, width = 6, \n',
+ ' file, device = "png", height = input${prefix}a3oup2.h, width = input${prefix}a3oup2.w, \n',
' plot = scDRgene({prefix}conf, {prefix}meta, input${prefix}a3drX, input${prefix}a3drY, input${prefix}a3inp2, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
' input${prefix}a3siz2, input${prefix}a3col2, input${prefix}a3ord2, \n',
@@ -511,8 +553,37 @@ wrSVmain <- function(prefix) {
' \n',
' \n',
' ### Plots for tab b1 \n',
- ' output${prefix}b1oupTxt <- renderUI({{ \n',
- ' geneList = scGeneList(input${prefix}b1inp, {prefix}gene) \n',
+ ' output${prefix}b1oup <- renderPlot({{ \n',
+ ' scVioBox({prefix}conf, {prefix}meta, input${prefix}b1inp1, input${prefix}b1inp2, \n',
+ ' "{prefix}gexpr.h5", {prefix}gene, input${prefix}b1typ, input${prefix}b1pts, \n',
+ ' input${prefix}b1siz, input${prefix}b1fsz) \n',
+ ' }}) \n',
+ ' output${prefix}b1oup.ui <- renderUI({{ \n',
+ ' plotOutput("{prefix}b1oup", height = pList[input${prefix}b1psz]) \n',
+ ' }}) \n',
+ ' output${prefix}b1oup.pdf <- downloadHandler( \n',
+ ' filename = function() {{ paste0("{prefix}",input${prefix}b1typ,"_",input${prefix}b1inp1,"_", \n',
+ ' input${prefix}b1inp2,".pdf") }}, \n',
+ ' content = function(file) {{ ggsave( \n',
+ ' file, device = "pdf", height = input${prefix}b1oup.h, width = input${prefix}b1oup.w, useDingbats = FALSE, \n',
+ ' plot = scVioBox({prefix}conf, {prefix}meta, input${prefix}b1inp1, input${prefix}b1inp2, \n',
+ ' "{prefix}gexpr.h5", {prefix}gene, input${prefix}b1typ, input${prefix}b1pts, \n',
+ ' input${prefix}b1siz, input${prefix}b1fsz) ) \n',
+ ' }}) \n',
+ ' output${prefix}b1oup.png <- downloadHandler( \n',
+ ' filename = function() {{ paste0("{prefix}",input${prefix}b1typ,"_",input${prefix}b1inp1,"_", \n',
+ ' input${prefix}b1inp2,".png") }}, \n',
+ ' content = function(file) {{ ggsave( \n',
+ ' file, device = "png", height = input${prefix}b1oup.h, width = input${prefix}b1oup.w, \n',
+ ' plot = scVioBox({prefix}conf, {prefix}meta, input${prefix}b1inp1, input${prefix}b1inp2, \n',
+ ' "{prefix}gexpr.h5", {prefix}gene, input${prefix}b1typ, input${prefix}b1pts, \n',
+ ' input${prefix}b1siz, input${prefix}b1fsz) ) \n',
+ ' }}) \n',
+ ' \n',
+ ' \n',
+ ' ### Plots for tab c1 \n',
+ ' output${prefix}c1oupTxt <- renderUI({{ \n',
+ ' geneList = scGeneList(input${prefix}c1inp, {prefix}gene) \n',
' if(nrow(geneList) > 50){{ \n',
' HTML("More than 50 input genes! Please reduce the gene list!") \n',
' }} else {{ \n',
@@ -525,32 +596,32 @@ wrSVmain <- function(prefix) {
' HTML(oup) \n',
' }} \n',
' }}) \n',
- ' output${prefix}b1oup <- renderPlot({{ \n',
- ' scBubbHeat({prefix}conf, {prefix}meta, input${prefix}b1inp, input${prefix}b1grp, input${prefix}b1plt, \n',
+ ' output${prefix}c1oup <- renderPlot({{ \n',
+ ' scBubbHeat({prefix}conf, {prefix}meta, input${prefix}c1inp, input${prefix}c1grp, input${prefix}c1plt, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
- ' input${prefix}b1scl, input${prefix}b1row, input${prefix}b1col, \n',
- ' input${prefix}b1cols, input${prefix}b1fsz) \n',
+ ' input${prefix}c1scl, input${prefix}c1row, input${prefix}c1col, \n',
+ ' input${prefix}c1cols, input${prefix}c1fsz) \n',
' }}) \n',
- ' output${prefix}b1oup.ui <- renderUI({{ \n',
- ' plotOutput("{prefix}b1oup", height = pList2[input${prefix}b1psz]) \n',
+ ' output${prefix}c1oup.ui <- renderUI({{ \n',
+ ' plotOutput("{prefix}c1oup", height = pList2[input${prefix}c1psz]) \n',
' }}) \n',
- ' output${prefix}b1oup.pdf <- downloadHandler( \n',
- ' filename = function() {{ paste0("{prefix}",input${prefix}b1plt,"_",input${prefix}b1grp,".pdf") }}, \n',
+ ' output${prefix}c1oup.pdf <- downloadHandler( \n',
+ ' filename = function() {{ paste0("{prefix}",input${prefix}c1plt,"_",input${prefix}c1grp,".pdf") }}, \n',
' content = function(file) {{ ggsave( \n',
- ' file, device = "pdf", height = 10, width = 10, \n',
- ' plot = scBubbHeat({prefix}conf, {prefix}meta, input${prefix}b1inp, input${prefix}b1grp, input${prefix}b1plt, \n',
+ ' file, device = "pdf", height = input${prefix}c1oup.h, width = input${prefix}c1oup.w, \n',
+ ' plot = scBubbHeat({prefix}conf, {prefix}meta, input${prefix}c1inp, input${prefix}c1grp, input${prefix}c1plt, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
- ' input${prefix}b1scl, input${prefix}b1row, input${prefix}b1col, \n',
- ' input${prefix}b1cols, input${prefix}b1fsz, save = TRUE) ) \n',
+ ' input${prefix}c1scl, input${prefix}c1row, input${prefix}c1col, \n',
+ ' input${prefix}c1cols, input${prefix}c1fsz, save = TRUE) ) \n',
' }}) \n',
- ' output${prefix}b1oup.png <- downloadHandler( \n',
- ' filename = function() {{ paste0("{prefix}",input${prefix}b1plt,"_",input${prefix}b1grp,".png") }}, \n',
+ ' output${prefix}c1oup.png <- downloadHandler( \n',
+ ' filename = function() {{ paste0("{prefix}",input${prefix}c1plt,"_",input${prefix}c1grp,".png") }}, \n',
' content = function(file) {{ ggsave( \n',
- ' file, device = "png", height = 10, width = 10, \n',
- ' plot = scBubbHeat({prefix}conf, {prefix}meta, input${prefix}b1inp, input${prefix}b1grp, input${prefix}b1plt, \n',
+ ' file, device = "png", height = input${prefix}c1oup.h, width = input${prefix}c1oup.w, \n',
+ ' plot = scBubbHeat({prefix}conf, {prefix}meta, input${prefix}c1inp, input${prefix}c1grp, input${prefix}c1plt, \n',
' "{prefix}gexpr.h5", {prefix}gene, \n',
- ' input${prefix}b1scl, input${prefix}b1row, input${prefix}b1col, \n',
- ' input${prefix}b1cols, input${prefix}b1fsz, save = TRUE) ) \n',
+ ' input${prefix}c1scl, input${prefix}c1row, input${prefix}c1col, \n',
+ ' input${prefix}c1cols, input${prefix}c1fsz, save = TRUE) ) \n',
' }}) \n',
' \n',
' \n',
@@ -663,7 +734,7 @@ wrUImain <- function(prefix) {
' column( \n',
' 6, selectInput("{prefix}a1inp1", "Cell information:", \n',
' choices = {prefix}conf$UI, \n',
- ' selected = {prefix}conf[default == 1]$UI) %>% \n',
+ ' selected = {prefix}def$meta1) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell information to colour cells by", \n',
' content = c("Select cell information to colour cells", \n',
@@ -689,7 +760,13 @@ wrUImain <- function(prefix) {
' ), \n',
' fluidRow(column(12, uiOutput("{prefix}a1oup1.ui"))), \n',
' downloadButton("{prefix}a1oup1.pdf", "Download PDF"), \n',
- ' downloadButton("{prefix}a1oup1.png", "Download PNG") \n',
+ ' downloadButton("{prefix}a1oup1.png", "Download PNG"), br(), \n',
+ ' div(style="display:inline-block", \n',
+ ' numericInput("{prefix}a1oup1.h", "PDF / PNG height:", width = "138px", \n',
+ ' min = 4, max = 20, value = 6, step = 0.5)), \n',
+ ' div(style="display:inline-block", \n',
+ ' numericInput("{prefix}a1oup1.w", "PDF / PNG width:", width = "138px", \n',
+ ' min = 4, max = 20, value = 8, step = 0.5)) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, h4("Gene expression"), \n',
@@ -720,7 +797,13 @@ wrUImain <- function(prefix) {
' ) , \n',
' fluidRow(column(12, uiOutput("{prefix}a1oup2.ui"))), \n',
' downloadButton("{prefix}a1oup2.pdf", "Download PDF"), \n',
- ' downloadButton("{prefix}a1oup2.png", "Download PNG") \n',
+ ' downloadButton("{prefix}a1oup2.png", "Download PNG"), br(), \n',
+ ' div(style="display:inline-block", \n',
+ ' numericInput("{prefix}a1oup2.h", "PDF / PNG height:", width = "138px", \n',
+ ' min = 4, max = 20, value = 6, step = 0.5)), \n',
+ ' div(style="display:inline-block", \n',
+ ' numericInput("{prefix}a1oup2.w", "PDF / PNG width:", width = "138px", \n',
+ ' min = 4, max = 20, value = 8, step = 0.5)) \n',
' ) # End of column (6 space) \n',
' ) # End of fluidRow (4 space) \n',
' ), # End of tab (2 space) \n',
@@ -773,7 +856,7 @@ wrUImain <- function(prefix) {
' column( \n',
' 6, selectInput("{prefix}a2inp1", "Cell information:", \n',
' choices = {prefix}conf$UI, \n',
- ' selected = {prefix}conf[default == 1]$UI) %>% \n',
+ ' selected = {prefix}def$meta1) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell information to colour cells by", \n',
' content = c("Select cell information to colour cells", \n',
@@ -800,7 +883,13 @@ wrUImain <- function(prefix) {
' ), \n',
' fluidRow(column(12, uiOutput("{prefix}a2oup1.ui"))), \n',
' downloadButton("{prefix}a2oup1.pdf", "Download PDF"), \n',
- ' downloadButton("{prefix}a2oup1.png", "Download PNG") \n',
+ ' downloadButton("{prefix}a2oup1.png", "Download PNG"), br(), \n',
+ ' div(style="display:inline-block", \n',
+ ' numericInput("{prefix}a2oup1.h", "PDF / PNG height:", width = "138px", \n',
+ ' min = 4, max = 20, value = 6, step = 0.5)), \n',
+ ' div(style="display:inline-block", \n',
+ ' numericInput("{prefix}a2oup1.w", "PDF / PNG width:", width = "138px", \n',
+ ' min = 4, max = 20, value = 8, step = 0.5)) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, h4("Cell information 2"), \n',
@@ -808,7 +897,7 @@ wrUImain <- function(prefix) {
' column( \n',
' 6, selectInput("{prefix}a2inp2", "Cell information:", \n',
' choices = {prefix}conf$UI, \n',
- ' selected = {prefix}conf[default == 2]$UI) %>% \n',
+ ' selected = {prefix}def$meta2) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell information to colour cells by", \n',
' content = c("Select cell information to colour cells", \n',
@@ -835,7 +924,13 @@ wrUImain <- function(prefix) {
' ), \n',
' fluidRow(column(12, uiOutput("{prefix}a2oup2.ui"))), \n',
' downloadButton("{prefix}a2oup2.pdf", "Download PDF"), \n',
- ' downloadButton("{prefix}a2oup2.png", "Download PNG") \n',
+ ' downloadButton("{prefix}a2oup2.png", "Download PNG"), br(), \n',
+ ' div(style="display:inline-block", \n',
+ ' numericInput("{prefix}a2oup2.h", "PDF / PNG height:", width = "138px", \n',
+ ' min = 4, max = 20, value = 6, step = 0.5)), \n',
+ ' div(style="display:inline-block", \n',
+ ' numericInput("{prefix}a2oup2.w", "PDF / PNG width:", width = "138px", \n',
+ ' min = 4, max = 20, value = 8, step = 0.5)) \n',
' ) # End of column (6 space) \n',
' ) # End of fluidRow (4 space) \n',
' ), # End of tab (2 space) \n',
@@ -912,7 +1007,13 @@ wrUImain <- function(prefix) {
' ), \n',
' fluidRow(column(12, uiOutput("{prefix}a3oup1.ui"))), \n',
' downloadButton("{prefix}a3oup1.pdf", "Download PDF"), \n',
- ' downloadButton("{prefix}a3oup1.png", "Download PNG") \n',
+ ' downloadButton("{prefix}a3oup1.png", "Download PNG"), br(), \n',
+ ' div(style="display:inline-block", \n',
+ ' numericInput("{prefix}a3oup1.h", "PDF / PNG height:", width = "138px", \n',
+ ' min = 4, max = 20, value = 6, step = 0.5)), \n',
+ ' div(style="display:inline-block", \n',
+ ' numericInput("{prefix}a3oup1.w", "PDF / PNG width:", width = "138px", \n',
+ ' min = 4, max = 20, value = 8, step = 0.5)) \n',
' ), # End of column (6 space) \n',
' column( \n',
' 6, h4("Gene expression 2"), \n',
@@ -944,12 +1045,71 @@ wrUImain <- function(prefix) {
' ), \n',
' fluidRow(column(12, uiOutput("{prefix}a3oup2.ui"))), \n',
' downloadButton("{prefix}a3oup2.pdf", "Download PDF"), \n',
- ' downloadButton("{prefix}a3oup2.png", "Download PNG") \n',
+ ' downloadButton("{prefix}a3oup2.png", "Download PNG"), br(), \n',
+ ' div(style="display:inline-block", \n',
+ ' numericInput("{prefix}a3oup2.h", "PDF / PNG height:", width = "138px", \n',
+ ' min = 4, max = 20, value = 6, step = 0.5)), \n',
+ ' div(style="display:inline-block", \n',
+ ' numericInput("{prefix}a3oup2.w", "PDF / PNG width:", width = "138px", \n',
+ ' min = 4, max = 20, value = 8, step = 0.5)) \n',
' ) # End of column (6 space) \n',
' ) # End of fluidRow (4 space) \n',
' ), # End of tab (2 space) \n',
' \n',
- ' ### Tab1.b1: Multiple gene expr \n',
+ ' ### Tab1.b1: violinplot / boxplot \n',
+ ' tabPanel( \n',
+ ' HTML("Violinplot / Boxplot"), \n',
+ ' h4("Cell information / gene expression violin plot / box plot"), \n',
+ ' "In this tab, users can visualise the gene expression or continuous cell information ", \n',
+ ' "(e.g. Number of UMIs / module score) across groups of cells (e.g. libary / clusters).", \n',
+ ' br(),br(), \n',
+ ' fluidRow( \n',
+ ' column( \n',
+ ' 3, style="border-right: 2px solid black", \n',
+ ' selectInput("{prefix}b1inp1", "Cell information (X-axis):", \n',
+ ' choices = {prefix}conf[grp == TRUE]$UI, \n',
+ ' selected = {prefix}conf[grp == TRUE]$UI[1]) %>% \n',
+ ' helper(type = "inline", size = "m", fade = TRUE, \n',
+ ' title = "Cell information to group cells by", \n',
+ ' content = c("Select categorical cell information to group cells by", \n',
+ ' "- Single cells are grouped by this categorical covariate", \n',
+ ' "- Plotted as the X-axis of the violin plot / box plot")), \n',
+ ' selectInput("{prefix}b1inp2", "Cell Info / Gene name (Y-axis):", choices=NULL) %>% \n',
+ ' helper(type = "inline", size = "m", fade = TRUE, \n',
+ ' title = "Cell Info / Gene to plot", \n',
+ ' content = c("Select cell info / gene to plot on Y-axis", \n',
+ ' "- Can be continuous cell information (e.g. nUMIs / scores)", \n',
+ ' "- Can also be gene expression")), \n',
+ ' radioButtons("{prefix}b1typ", "Plot type:", \n',
+ ' choices = c("violin", "boxplot"), \n',
+ ' selected = "violin", inline = TRUE), \n',
+ ' checkboxInput("{prefix}b1pts", "Show data points", value = FALSE), \n',
+ ' actionButton("{prefix}b1tog", "Toggle graphics controls"), \n',
+ ' conditionalPanel( \n',
+ ' condition = "input.{prefix}b1tog % 2 == 1", \n',
+ ' sliderInput("{prefix}b1siz", "Data point size:", \n',
+ ' min = 0, max = 3, value = 1, step = 0.25), \n',
+ ' radioButtons("{prefix}b1psz", "Plot size:", \n',
+ ' choices = c("Small", "Medium", "Large"), \n',
+ ' selected = "Medium", inline = TRUE), \n',
+ ' radioButtons("{prefix}b1fsz", "Font size:", \n',
+ ' choices = c("Small", "Medium", "Large"), \n',
+ ' selected = "Medium", inline = TRUE)) \n',
+ ' ), # End of column (6 space) \n',
+ ' column(9, uiOutput("{prefix}b1oup.ui"), \n',
+ ' downloadButton("{prefix}b1oup.pdf", "Download PDF"), \n',
+ ' downloadButton("{prefix}b1oup.png", "Download PNG"), br(), \n',
+ ' div(style="display:inline-block", \n',
+ ' numericInput("{prefix}b1oup.h", "PDF / PNG height:", width = "138px", \n',
+ ' min = 4, max = 20, value = 8, step = 0.5)), \n',
+ ' div(style="display:inline-block", \n',
+ ' numericInput("{prefix}b1oup.w", "PDF / PNG width:", width = "138px", \n',
+ ' min = 4, max = 20, value = 10, step = 0.5)) \n',
+ ' ) # End of column (6 space) \n',
+ ' ) # End of fluidRow (4 space) \n',
+ ' ), # End of tab (2 space) \n',
+ ' \n',
+ ' ### Tab1.c1: Multiple gene expr \n',
' tabPanel( \n',
' HTML("Bubbleplot / Heatmap"), \n',
' h4("Gene expression bubbleplot / heatmap"), \n',
@@ -960,7 +1120,7 @@ wrUImain <- function(prefix) {
' fluidRow( \n',
' column( \n',
' 3, style="border-right: 2px solid black", \n',
- ' textAreaInput("{prefix}b1inp", HTML("List of gene names
\n',
+ ' textAreaInput("{prefix}c1inp", HTML("List of gene names
\n',
' (Max 50 genes, separated
\n',
' by , or ; or newline):"), \n',
' height = "200px", \n',
@@ -970,40 +1130,45 @@ wrUImain <- function(prefix) {
' content = c("Input genes to plot", \n',
' "- Maximum 50 genes (due to ploting space limitations)", \n',
' "- Genes should be separated by comma, semicolon or newline")), \n',
- ' selectInput("{prefix}b1grp", "Group by:", \n',
+ ' selectInput("{prefix}c1grp", "Group by:", \n',
' choices = {prefix}conf[grp == TRUE]$UI, \n',
- ' selected = {prefix}conf[grp == TRUE & default > 0]$UI[1]) %>% \n',
+ ' selected = {prefix}conf[grp == TRUE]$UI[1]) %>% \n',
' helper(type = "inline", size = "m", fade = TRUE, \n',
' title = "Cell information to group cells by", \n',
' content = c("Select categorical cell information to group cells by", \n',
' "- Single cells are grouped by this categorical covariate", \n',
' "- Plotted as the X-axis of the bubbleplot / heatmap")), \n',
- ' radioButtons("{prefix}b1plt", "Plot type:", \n',
+ ' radioButtons("{prefix}c1plt", "Plot type:", \n',
' choices = c("Bubbleplot", "Heatmap"), \n',
' selected = "Bubbleplot", inline = TRUE), \n',
- ' checkboxInput("{prefix}b1scl", "Scale gene expression", value = TRUE), \n',
- ' checkboxInput("{prefix}b1row", "Cluster rows (genes)", value = TRUE), \n',
- ' checkboxInput("{prefix}b1col", "Cluster columns (samples)", value = FALSE), \n',
+ ' checkboxInput("{prefix}c1scl", "Scale gene expression", value = TRUE), \n',
+ ' checkboxInput("{prefix}c1row", "Cluster rows (genes)", value = TRUE), \n',
+ ' checkboxInput("{prefix}c1col", "Cluster columns (samples)", value = FALSE), \n',
' br(), \n',
- ' actionButton("{prefix}b1tog", "Toggle graphics controls"), \n',
+ ' actionButton("{prefix}c1tog", "Toggle graphics controls"), \n',
' conditionalPanel( \n',
- ' condition = "input.{prefix}b1tog % 2 == 1", \n',
- ' radioButtons("{prefix}b1cols", "Colour scheme:", \n',
+ ' condition = "input.{prefix}c1tog % 2 == 1", \n',
+ ' radioButtons("{prefix}c1cols", "Colour scheme:", \n',
' choices = c("White-Red", "Blue-Yellow-Red", \n',
' "Yellow-Green-Purple"), \n',
' selected = "Blue-Yellow-Red"), \n',
- ' radioButtons("{prefix}b1psz", "Plot size:", \n',
+ ' radioButtons("{prefix}c1psz", "Plot size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE), \n',
- ' radioButtons("{prefix}b1fsz", "Font size:", \n',
+ ' radioButtons("{prefix}c1fsz", "Font size:", \n',
' choices = c("Small", "Medium", "Large"), \n',
' selected = "Medium", inline = TRUE)) \n',
' ), # End of column (6 space) \n',
- ' column( \n',
- ' 9, h4(htmlOutput("{prefix}b1oupTxt")), \n',
- ' uiOutput("{prefix}b1oup.ui"), \n',
- ' downloadButton("{prefix}b1oup.pdf", "Download PDF"), \n',
- ' downloadButton("{prefix}b1oup.png", "Download PNG") \n',
+ ' column(9, h4(htmlOutput("{prefix}c1oupTxt")), \n',
+ ' uiOutput("{prefix}c1oup.ui"), \n',
+ ' downloadButton("{prefix}c1oup.pdf", "Download PDF"), \n',
+ ' downloadButton("{prefix}c1oup.png", "Download PNG"), br(), \n',
+ ' div(style="display:inline-block", \n',
+ ' numericInput("{prefix}c1oup.h", "PDF / PNG height:", width = "138px", \n',
+ ' min = 4, max = 20, value = 10, step = 0.5)), \n',
+ ' div(style="display:inline-block", \n',
+ ' numericInput("{prefix}c1oup.w", "PDF / PNG width:", width = "138px", \n',
+ ' min = 4, max = 20, value = 10, step = 0.5)) \n',
' ) # End of column (6 space) \n',
' ) # End of fluidRow (4 space) \n',
' ) # End of tab (2 space) \n',
@@ -1022,6 +1187,8 @@ wrUIend <- function(footnote) {
' \n',
'br(), \n',
'p({footnote}), \n',
+ 'p(em("This webpage was made using "), a("ShinyCell", \n',
+ ' href = "https://github.com/SGDDNB/ShinyCell",target="_blank")), \n',
'br(),br(),br(),br(),br() \n',
'))) \n',
' \n',
diff --git a/README.md b/README.md
index 4533a98..a207472 100644
--- a/README.md
+++ b/README.md
@@ -1,8 +1,10 @@
# ShinyCell package
`ShinyCell` is a R package that allows users to create interactive Shiny-based
web applications to visualise single-cell data via (i) visualising cell
-information and/or gene expression on reduced dimensions e.g. UMAP and (ii)
-visualising the expression of multiple genes using bubbleplots / heatmap.
+information and/or gene expression on reduced dimensions e.g. UMAP, (ii)
+visualising the distribution of continuous cell information e.g. nUMI / module
+scores using violin plots / box plots and (iii) visualising the expression of
+multiple genes using bubbleplots / heatmap.
The package supports Seurat objects (v3.0 and above) and SingleCellExperiment
objects. It is easy to use and customise settings e.g. label names and colour
@@ -23,7 +25,26 @@ palettes. This readme is broken down into the following sections:
# Installation
-`ShinyCell` can be installed from GitHub as follows:
+First, users can run the following code to check if the packages required by
+`ShinyCell` exist and install them if required:
+``` r
+reqPkg = c("data.table", "Matrix", "hdf5r", "ggplot2", "gridExtra",
+ "glue", "readr", "RColorBrewer", "R.utils", "Seurat")
+newPkg = reqPkg[!(reqPkg %in% installed.packages()[,"Package"])]
+if(length(newPkg)){install.packages(newPkg)}
+```
+
+Furthermore, on the system where the Shiny app will be deployed, users can run
+the following code to check if the packages required by the Shiny app exist
+and install them if required:
+``` r
+reqPkg = c("shiny", "shinyhelper", "data.table", "Matrix", "hdf5r",
+ "ggplot2", "gridExtra", "magrittr", "ggdendro")
+newPkg = reqPkg[!(reqPkg %in% installed.packages()[,"Package"])]
+if(length(newPkg)){install.packages(newPkg)}
+```
+
+`ShinyCell` can then be installed from GitHub as follows:
``` r
devtools::install_github("SGDDNB/ShinyCell")
```
@@ -49,13 +70,11 @@ A shiny app can then be quickly generated using the following code:
library(Seurat)
library(ShinyCell)
+getExampleData() # Download example dataset (~200 MB)
seu = readRDS("readySeu_rset.rds")
scConf = createConfig(seu)
-makeShinyApp(seu, scConf, shiny.title = "RSeT reprogramming scRNA-seq",
- default.gene1 = "ENSG00000111704", default.gene2 = "ENSG00000142182",
- default.multigene = c("ENSG00000166825","ENSG00000111704","ENSG00000043355",
- "ENSG00000146938","ENSG00000142182","ENSG00000203909",
- "ENSG00000003989","ENSG00000107485","ENSG00000171345"))
+makeShinyApp(seu, scConf, gene.mapping = TRUE,
+ shiny.title = "ShinyCell Quick Start")
```
The generated shiny app can then be found in the `shinyApp/` folder (which is
@@ -63,14 +82,16 @@ the default output folder). To run the app locally, use RStudio to open either
`server.R` or `ui.R` in the shiny app folder and click on "Run App" in the top
right corner. The shiny app can also be deployed online via online platforms
e.g. [shinyapps.io](https://www.shinyapps.io/) or be hosted via Shiny Server.
-The shiny app should look like this:
+The shiny app contains five tabs (highlighted in blue box), looking like this:
-
+
The first three tabs allows users to visualise single cells on reduced
dimensions, either showing both cell information and gene expression (first
tab), showing two cell information side-by-side (second tab) or showing two
gene expressions side-by-side (third tab). The fourth tab allows users to
+visualise the distribution of continuous cell information e.g. nUMI / module
+scores using a violin plot or box plot and the fifth tab allows users to
visualise the expression of multiple genes using a bubbleplot or heatmap.
@@ -100,6 +121,7 @@ library(Seurat)
library(ShinyCell)
# Create ShinyCell config
+getExampleData() # Download example dataset (~200 MB)
seu <- readRDS("readySeu_rset.rds")
scConf = createConfig(seu)
```
@@ -116,7 +138,7 @@ first, followed by continuous metadata which are shown collectively.
showLegend(scConf)
```
-
+
It is possible to modify `scConf` directly but this might be prone to error.
Thus, we provided numerous convenience functions to modify `scConf` and
@@ -152,7 +174,7 @@ scConf = modLabels(scConf, meta.to.mod = "library",
showLegend(scConf)
```
-
+
Apart from `showLegend()`, users can also run `showOrder()` to display the
order in which metadata will appear in the dropdown menu when selecting which
@@ -166,7 +188,7 @@ column indicates which metadata are the primary and secondary default.
showOrder(scConf)
```
-
+
Here, we introduce a few more functions that might be useful in modifying the
Shiny app. Users can add metadata back via `addMeta()`. The newly added
@@ -187,30 +209,18 @@ scConf = modDefault(scConf, "library", "identity")
showOrder(scConf)
```
-
+
After modifying `scConf` to one's satisfaction, we are almost ready to build
the Shiny app. Prior to building the Shiny app, users can run `checkConfig()`
to check if the `scConf` is ready. This is especially useful if users have
-manually modified the `scConf`. Next, we prepare a named character vector
-`geneMap` that contains mapping of Ensembl IDs to gene symbols. Specifically,
-the vector contains the gene symbols while `names(geneMap)` contain the
-Ensembl IDs. This is because the Seurat object uses Ensembl IDs and we would
-like to convert them to more "user-friendly" gene symbols in the Shiny app. If
-users do not need to change the gene names, this step can be ignored. Note
-that the authors of this Seurat object have included the gene mapping in the
-object. In a more usual setting, users need to generate the mapping themselves
-from e.g. biomaRt. Finally, users can also add a footnote to the Shiny app and
-one potential use is to include the reference for the dataset. Here, we
+manually modified the `scConf`. Users can also add a footnote to the Shiny app
+and one potential use is to include the reference for the dataset. Here, we
provide an example of including the citation as the Shiny app footnote.
``` r
# Build shiny app
checkConfig(scConf, seu)
-geneMap = seu@misc$convert$id2name
-# > head(geneMap)
-# ENSG00000000003 ENSG00000000419 ENSG00000000457 ENSG00000000460 ENSG00000000971
-# "TSPAN6" "DPM1" "SCYL3" "C1orf112" "CFH"
footnote = paste0(
'strong("Reference: "), "Liu X., Ouyang J.F., Rossello F.J. et al. ",',
'em("Nature "), strong("586,"), "101-107 (2020) ",',
@@ -221,14 +231,25 @@ footnote = paste0(
```
Now, we can build the shiny app! A few more things need to be specified here.
-`default.gene1` and `default.gene2` corresponds to the primary and secondary
-default gene when plotting gene expression on reduced dimensions while
-`default.multigene` contains the default set of genes when plotting
-bubbleplots or heatmaps.
+In this example, the Seurat object uses Ensembl IDs and we would like to
+convert them to more user-friendly gene symbols in the Shiny app. `ShinyCell`
+can do this conversion (for human and mouse datasets) conveniently by
+specifying `gene.mapping = TRUE`. If your dataset is already in gene symbols,
+you can leave out this argument to not perform the conversion. Furthermore,
+`ShinyCell` uses the "RNA" assay and "data" slot in Seurat objects as the gene
+expression data. If you have performed any data integration and would like to
+use the integrated data instead, please specify `gex.assay = "integrated`.
+Also, default genes to plot can be specified where `default.gene1` and
+`default.gene2` corresponds to the default genes when plotting gene expression
+on reduced dimensions while `default.multigene` contains the default set of
+multiple genes when plotting bubbleplots or heatmaps. If unspecified,
+`ShinyCell` will automatically select some genes present in the dataset as
+default genes.
``` r
-makeShinyApp(seu, scConf, gene.mapping = geneMap,
- shiny.title = "RSeT reprogramming scRNA-seq",
+makeShinyApp(seu, scConf, gene.mapping = TRUE,
+ gex.assay = "RNA", gex.slot = "data",
+ shiny.title = "ShinyCell Tutorial",
shiny.dir = "shinyApp/", shiny.footnotes = footnote,
default.gene1 = "NANOG", default.gene2 = "DNMT3L",
default.multigene = c("ANPEP","NANOG","ZIC2","NLGN4X","DNMT3L",
@@ -240,13 +261,13 @@ required for the Shiny app and (ii) the code files, namely `server.R` and
`ui.R`. The generated files can be found in the `shinyApp/` folder. To run the
app locally, use RStudio to open either `server.R` or `ui.R` in the shiny app
folder and click on "Run App" in the top right corner. The shiny app can also
-be deployed online via online platforms e.g.
-[shinyapps.io](https://www.shinyapps.io/) or be hosted via Shiny Server. The
-shiny app look like this, containing four tabs. The primary default cell
-information and gene expression are plotted on UMAP in the first tab while
-the primary & secondary cell information / gene expression are plotted on UMAP
-in the second / third tab respectively. Bubbleplot or heatmap can be generated
-in the fourth tab.
+be deployed via online platforms e.g. [shinyapps.io](https://www.shinyapps.io/)
+or hosted via Shiny Server. The shiny app look like this, containing five tabs.
+Cell information and gene expression are plotted on UMAP in the first tab while
+two different cell information / gene expression are plotted on UMAP in the
+second / third tab respectively. Violin plot or box plot of cell information or
+gene expression distribution can be found in the fourth tab. Lastly, a
+bubbleplot or heatmap can be generated in the fifth tab.
With the Shiny app, users can interactively explore their single-cell data,
varying the cell information / gene expression to plot. Furthermore, these
@@ -254,10 +275,11 @@ plots can be exported into PDF / PNG for presentations / publications. Users
can also click on the "Toggle graphics controls" or "Toggle plot controls" to
fine-tune certain aspects of the plots e.g. point size.
-
-
-
-
+
+
+
+
+
@@ -277,6 +299,7 @@ After downloading the data, we will begin by loading the required libraries.
``` r
library(Seurat)
library(ShinyCell)
+getExampleData("multi") # Download multiple example datasets (~400 MB)
```
To create a multi-dataset Shiny app, we need to configure the settings for
@@ -287,9 +310,9 @@ display names of metadata and modifying the colour palettes. For a more
detailed explanation on how to customise the shiny app, refer to the
[Detailed Tutorial](#detailed-tutorial). We then run `makeShinyFiles()` to
generate the files related to the first dataset. Notice that we specified
-`shiny.prefix = "sc1"` and this prefix is used to distinguish that the
-files contain data related to the first dataset. The remaining arguments are
-the same as explained in the [Detailed Tutorial](#detailed-tutorial).
+`shiny.prefix = "sc1"` and this prefix is used to identify that the files
+contain single-cell data related to the first dataset. The remaining arguments
+are the same as explained in the [Detailed Tutorial](#detailed-tutorial).
``` r
seu <- readRDS("readySeu_rset.rds")
@@ -300,9 +323,8 @@ scConf1 = modMetaName(scConf1, meta.to.mod = c("nUMI", "nGene", "pctMT", "pctHK"
"% MT genes", "% HK genes"))
scConf1 = modColours(scConf1, meta.to.mod = "library",
new.colours= c("black", "darkorange", "blue", "pink2"))
-geneMap = seu@misc$convert$id2name
makeShinyFiles(seu, scConf1, gex.assay = "RNA", gex.slot = "data",
- gene.mapping = geneMap, shiny.prefix = "sc1",
+ gene.mapping = TRUE, shiny.prefix = "sc1",
shiny.dir = "shinyAppMulti/",
default.gene1 = "NANOG", default.gene2 = "DNMT3L",
default.multigene = c("ANPEP","NANOG","ZIC2","NLGN4X","DNMT3L",
@@ -323,9 +345,8 @@ scConf2 = modMetaName(scConf2, meta.to.mod = c("nUMI", "nGene", "pctMT", "pctHK"
"% MT genes", "% HK genes"))
scConf2 = modColours(scConf2, meta.to.mod = "library",
new.colours= c("black", "blue", "purple"))
-geneMap = seu@misc$convert$id2name
makeShinyFiles(seu, scConf2, gex.assay = "RNA", gex.slot = "data",
- gene.mapping = geneMap, shiny.prefix = "sc2",
+ gene.mapping = TRUE, shiny.prefix = "sc2",
shiny.dir = "shinyAppMulti/",
default.gene1 = "GATA3", default.gene2 = "DNMT3L",
default.multigene = c("ANPEP","NANOG","ZIC2","NLGN4X","DNMT3L",
@@ -349,7 +370,7 @@ footnote = paste0(
'target="_blank"), style = "font-size: 125%;"'
)
makeShinyCodesMulti(
- shiny.title = "Reprogramming scRNA-seq", shiny.footnotes = footnote,
+ shiny.title = "Multi-dataset Tutorial", shiny.footnotes = footnote,
shiny.prefix = c("sc1", "sc2"),
shiny.headers = c("RSeT reprogramming", "Day 21 intermediates"),
shiny.dir = "shinyAppMulti/")
@@ -358,32 +379,47 @@ makeShinyCodesMulti(
Now, we have both the data and code for the Shiny app and we can run the Shiny
app. Each dataset can be found in their corresponding tabs and clicking on the
tab creates a dropdown to change the type of plot to display on the Shiny app.
-This tutorial can be easily expanded to include three, four or even more
-datasets. Users have to create the corresponding data files for each dataset
-and finally generate the code for the Shiny app.
+This tutorial can be easily expanded to include three or more datasets. Users
+simply have to create the corresponding data files for each dataset and finally
+generate the code for the Shiny app.
-
+
# Frequently Asked Questions
+- Q: How much memory / storage space does `ShinyCell` and the Shiny app consume?
+ - A: The Shiny app itself consumes very little memory and is meant to be a
+ heavy-duty app where multiple users can access the app simultaneously.
+ Unlike typical R objects, the entire gene expression matrix is stored
+ on disk and *not on memory* via the hdf5 file system. Also, the hdf5
+ file system offers superior file compression and takes up less storage
+ space than native R file formats such as rds / Rdata files.
+ - A: It should be noted that a large amount of memory is required when
+ *building* the Shiny app. This is because the whole Seurat / SCE object
+ has to be loaded onto memory and additional memory is required to
+ generate the required files. From experience, a typical laptop with 8GB
+ RAM can handle datasets around 30k cells while 16GB RAM machines can
+ handle around 60k-70k cells.
+
- Q: I have generated additional dimension reductions (e.g. force-directed
layout / MDS / monocle2 etc.) and would like to include them into the Shiny
app. How do I do that?
- - A: ShinyCell automatically retrieves dimension reduction information from
+ - A: `ShinyCell` automatically retrieves dimension reduction information from
the Seurat or SCE object. Thus, the additional dimension reductions
- have to be added into the Seurat or SCE object before running ShinyCell.
- - For Seurat objects, users can refer "Storing a custom dimensional reduction calculation" in https://satijalab.org/seurat/v3.0/dim_reduction_vignette.html
+ have to be added into the Seurat or SCE object before running `ShinyCell`.
+ - For Seurat objects, users can refer "Storing a custom dimensional reduction
+ calculation" in https://satijalab.org/seurat/v3.0/dim_reduction_vignette.html
- For SCE objects, users can refer to https://bioconductor.org/packages/devel/bioc/vignettes/SingleCellExperiment/inst/doc/intro.html#3_Adding_low-dimensional_representations
- Q: I have both RNA and integrated data in my Seurat object. How do I specify
which gene expression assay to plot in the Shiny app?
- A: Only one gene expression assay can be visualised per dataset. To
- specify the assay, use the `gex.assay` argument in the `makeShinyApp()`
- or `makeShinyFiles()` functions. If users want to visualise both gene
- expression, they can treat each assay as an individual dataset and
- include multiple datasets into a single shiny app, following the
- [Multi-dataset Tutorial](#multi-dataset-tutorial)
+ specify the assay, use the `gex.assay = "integrated` argument in the
+ `makeShinyApp()` or `makeShinyFiles()` functions. If users want to
+ visualise both gene expression, they have to treat each assay as an
+ individual dataset and include multiple datasets into a single shiny
+ app, following the [Multi-dataset Tutorial](#multi-dataset-tutorial)
diff --git a/images/detailed-leg1.png b/images/detailed-leg1.png
index 66b4334..15f7c6a 100644
Binary files a/images/detailed-leg1.png and b/images/detailed-leg1.png differ
diff --git a/images/detailed-leg2.png b/images/detailed-leg2.png
index f22e5be..8dd2744 100644
Binary files a/images/detailed-leg2.png and b/images/detailed-leg2.png differ
diff --git a/images/detailed-shiny1.png b/images/detailed-shiny1.png
index 0cd7453..23e3c17 100644
Binary files a/images/detailed-shiny1.png and b/images/detailed-shiny1.png differ
diff --git a/images/detailed-shiny2.png b/images/detailed-shiny2.png
index 7064214..91d8d3b 100644
Binary files a/images/detailed-shiny2.png and b/images/detailed-shiny2.png differ
diff --git a/images/detailed-shiny3.png b/images/detailed-shiny3.png
index e346193..d893700 100644
Binary files a/images/detailed-shiny3.png and b/images/detailed-shiny3.png differ
diff --git a/images/detailed-shiny4.png b/images/detailed-shiny4.png
index 272c020..629406d 100644
Binary files a/images/detailed-shiny4.png and b/images/detailed-shiny4.png differ
diff --git a/images/detailed-shiny5.png b/images/detailed-shiny5.png
new file mode 100644
index 0000000..70fa39c
Binary files /dev/null and b/images/detailed-shiny5.png differ
diff --git a/images/multi-shiny.png b/images/multi-shiny.png
index ab92739..ee75c8d 100644
Binary files a/images/multi-shiny.png and b/images/multi-shiny.png differ
diff --git a/images/quick-shiny.png b/images/quick-shiny.png
index b644969..ade9c3d 100644
Binary files a/images/quick-shiny.png and b/images/quick-shiny.png differ
diff --git a/inst/extdata/geneMapHS.txt.gz b/inst/extdata/geneMapHS.txt.gz
new file mode 100644
index 0000000..a57b5ed
Binary files /dev/null and b/inst/extdata/geneMapHS.txt.gz differ
diff --git a/inst/extdata/geneMapMM.txt.gz b/inst/extdata/geneMapMM.txt.gz
new file mode 100644
index 0000000..9e7d752
Binary files /dev/null and b/inst/extdata/geneMapMM.txt.gz differ
diff --git a/man/createConfig.Rd b/man/createConfig.Rd
index d54b05c..d29d070 100644
--- a/man/createConfig.Rd
+++ b/man/createConfig.Rd
@@ -4,7 +4,7 @@
\alias{createConfig}
\title{Create a shinycell config data.table}
\usage{
-createConfig(obj, meta.to.include = NA, legendCols = 3)
+createConfig(obj, meta.to.include = NA, legendCols = 4)
}
\arguments{
\item{obj}{input single-cell data object. Both Seurat objects (v3+) and
diff --git a/man/getExampleData.Rd b/man/getExampleData.Rd
new file mode 100644
index 0000000..5eec512
--- /dev/null
+++ b/man/getExampleData.Rd
@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/getExampleData.R
+\name{getExampleData}
+\alias{getExampleData}
+\title{Download example Seurat objects}
+\usage{
+getExampleData(type = c("single", "multi"))
+}
+\arguments{
+\item{type}{can be either "single" or "multi" which downloads one or two
+Seurat objects respectively for the Quick Start/Detailed Tutorial or
+Multi-dataset Tutorial respectively}
+}
+\value{
+downloaded Seurat object
+}
+\description{
+Download example Seurat objects required for ShinyCell tutorial.
+}
+\examples{
+getExampleData()
+
+}
+\author{
+John F. Ouyang
+}
diff --git a/man/makeShinyApp.Rd b/man/makeShinyApp.Rd
index abf2804..de46787 100644
--- a/man/makeShinyApp.Rd
+++ b/man/makeShinyApp.Rd
@@ -9,7 +9,7 @@ makeShinyApp(
scConf,
gex.assay = NA,
gex.slot = c("data", "scale.data", "counts"),
- gene.mapping = NA,
+ gene.mapping = FALSE,
shiny.title = "scRNA-seq shiny app",
shiny.footnotes = "\\"\\"",
shiny.dir = "shinyApp/",
@@ -32,14 +32,13 @@ objects (v3+) or the "logcounts" assay for SingleCellExperiment objects}
\item{gex.slot}{slot in single-cell assay to plot. This is only used
for Seurat objects (v3+). Default is to use the "data" slot}
-\item{gene.mapping}{specify a mapping to convert gene identifiers. A
-named vector must be supplied where \code{names(gene.mapping)} correspond
+\item{gene.mapping}{specifies whether to convert Ensembl gene IDs (e.g.
+ENSG000xxx / ENSMUSG000xxx) into more "user-friendly" gene symbols. Set
+this to \code{TRUE} if you are using Ensembl gene IDs. Default is
+\code{FALSE} which is not to perform any conversion. Alternatively, users
+can supply a named vector where \code{names(gene.mapping)} correspond
to the actual gene identifiers in the gene expression matrix whereas
-\code{gene.mapping} correspond to new identifiers to map to. Partial
-mapping is allowed where the mapping is only provided for some gene
-identifiers, the remaining gene identifiers will remain unchanged and a
-warning message will be presented. Default is \code{NA} which is not to
-perform any mapping}
+\code{gene.mapping} correspond to new identifiers to map to}
\item{shiny.title}{title for shiny app}
diff --git a/man/makeShinyFiles.Rd b/man/makeShinyFiles.Rd
index cc8196b..1913447 100644
--- a/man/makeShinyFiles.Rd
+++ b/man/makeShinyFiles.Rd
@@ -9,8 +9,8 @@ makeShinyFiles(
scConf,
gex.assay = NA,
gex.slot = c("data", "scale.data", "counts"),
- gene.mapping = NA,
- shiny.prefix,
+ gene.mapping = FALSE,
+ shiny.prefix = "sc1",
shiny.dir = "shinyApp/",
default.gene1 = NA,
default.gene2 = NA,
@@ -31,14 +31,13 @@ objects (v3+) or the "logcounts" assay for SingleCellExperiment objects}
\item{gex.slot}{slot in single-cell assay to plot. This is only used
for Seurat objects (v3+). Default is to use the "data" slot}
-\item{gene.mapping}{specify a mapping to convert gene identifiers. A
-named vector must be supplied where \code{names(gene.mapping)} correspond
+\item{gene.mapping}{specifies whether to convert Ensembl gene IDs (e.g.
+ENSG000xxx / ENSMUSG000xxx) into more "user-friendly" gene symbols. Set
+this to \code{TRUE} if you are using Ensembl gene IDs. Default is
+\code{FALSE} which is not to perform any conversion. Alternatively, users
+can supply a named vector where \code{names(gene.mapping)} correspond
to the actual gene identifiers in the gene expression matrix whereas
-\code{gene.mapping} correspond to new identifiers to map to. Partial
-mapping is allowed where the mapping is only provided for some gene
-identifiers, the remaining gene identifiers will remain unchanged and a
-warning message will be presented. Default is \code{NA} which is not to
-perform any mapping}
+\code{gene.mapping} correspond to new identifiers to map to}
\item{shiny.prefix}{specify file prefix}
diff --git a/man/showLegend.Rd b/man/showLegend.Rd
index 00fa29b..6894c0e 100644
--- a/man/showLegend.Rd
+++ b/man/showLegend.Rd
@@ -4,7 +4,7 @@
\alias{showLegend}
\title{Shows the legends for single-cell metadata}
\usage{
-showLegend(scConf, fontSize = 18)
+showLegend(scConf, fontSize = 14)
}
\arguments{
\item{scConf}{shinycell config data.table}