@@ -10,7 +10,6 @@ export(computeZScore)

 export(convertGeneIDs)

 export(convertSCEToSeurat)

 export(convertSeuratToSCE)

-export(createSCE)

 export(distinctColors)

 export(enrichRSCE)

 export(exportSCEtoAnnData)

@@ -32,6 +31,7 @@ export(importCellRangerV2Sample)

 export(importCellRangerV3)

 export(importCellRangerV3Sample)

 export(importDropEst)

+export(importFromFiles)

 export(importOptimus)

 export(importSEQC)

 export(importSTARsolo)

@@ -14,21 +14,6 @@

 #'

 #' @return gsvaSCE(): A data.frame of pathway activity scores from GSVA.

 #' @export

-#' @examples

-#' utils::data(maits, package = "MAST")

-#' utils::data(c2BroadSets, package = "GSVAdata")

-#' maitslogtpm <- t(maits$expressionmat)

-#' genesToSubset <- rownames(maitslogtpm)[which(rownames(maitslogtpm) %in%

-#'                  GSEABase::geneIds(c2BroadSets[["KEGG_PROTEASOME"]]))]

-#' maitslogtpm <- maitslogtpm[rownames(maitslogtpm) %in% genesToSubset, ]

-#' maitsfeatures <- maits$fdat[rownames(maits$fdat) %in% genesToSubset, ]

-#' maitsSCE <- createSCE(assayFile = maitslogtpm, annotFile = maits$cdat,

-#'                       featureFile = maitsfeatures, assayName = "logtpm",

-#'                       inputDataFrames = TRUE, createLogCounts = FALSE)

-#' rowData(maitsSCE)$testbiomarker <- rep(1, nrow(maitsSCE))

-#' res <- gsvaSCE(inSCE = maitsSCE, useAssay = "logtpm",

-#'                pathwaySource = "Manual Input", pathwayNames = "testbiomarker",

-#'                parallel.sz = 1)

 gsvaSCE <- function(inSCE, useAssay = "logcounts", pathwaySource,

                     pathwayNames, ...){

   if (pathwaySource == "Manual Input"){

@@ -74,25 +59,6 @@ gsvaSCE <- function(inSCE, useAssay = "logcounts", pathwaySource,

 #' @return gsvaPlot(): The requested plot of the GSVA results.

 #'

 #' @export

-#'

-#' @examples

-#' #Create a small example to run

-#' utils::data(maits, package = "MAST")

-#' utils::data(c2BroadSets, package = "GSVAdata")

-#' maitslogtpm <- t(maits$expressionmat)

-#' genesToSubset <- rownames(maitslogtpm)[which(rownames(maitslogtpm) %in%

-#'                  GSEABase::geneIds(c2BroadSets[["KEGG_PROTEASOME"]]))]

-#' maitslogtpm <- maitslogtpm[rownames(maitslogtpm) %in% genesToSubset, ]

-#' maitsfeatures <- maits$fdat[rownames(maits$fdat) %in% genesToSubset, ]

-#' maitsSCE <- createSCE(assayFile = maitslogtpm, annotFile = maits$cdat,

-#'                       featureFile = maitsfeatures, assayName = "logtpm",

-#'                       inputDataFrames = TRUE, createLogCounts = FALSE)

-#' rowData(maitsSCE)$testbiomarker <- rep(1, nrow(maitsSCE))

-#' res <- gsvaSCE(inSCE = maitsSCE, useAssay = "logtpm",

-#'                pathwaySource = "Manual Input", pathwayNames = "testbiomarker",

-#'                parallel.sz = 1)

-#' gsvaPlot(inSCE = maitsSCE, gsvaData = res,

-#'          plotType = "Violin", condition = "condition")

 gsvaPlot <- function(inSCE, gsvaData, plotType, condition=NULL,

                      show_column_names = TRUE, show_row_names = TRUE,

                      text_size = 12){

@@ -219,7 +219,7 @@ alignSingleCellData <- function(inputfile1, inputfile2=NULL, indexPath,

   #createsceset from the count file, multiqcdata, and annotations if they exist

   # (validate the sample names are right)

-  scobject <- createSCE(assayFile = countframe,

+  scobject <- importFromFiles(assayFile = countframe,

                         annotFile = sampleAnnotations,

                         featureFile = featureAnnotations,

                         inputDataFrames = TRUE)

new file mode 100644

@@ -0,0 +1,83 @@

+#' Create a SingleCellExperiment object from files

+#'

+#' Creates a SingleCellExperiment object from a counts file in various formats.

+#' and a file of annotation information, .

+#'

+#' @param assayFile The path to a  file in .mtx, .txt, .csv, .tab, or .tsv format.

+#' @param annotFile The path to a text file that contains columns of annotation

+#' information for each sample in the assayFile. This file should have the same

+#' number of rows as there are columns in the assayFile. If multiple samples are

+#' represented in these files, this should be denoted by a column called \code{'sample'}

+#' within the \code{annotFile}.

+#' @param featureFile The path to a text file that contains columns of

+#' annotation information for each gene in the count matrix. This file should

+#' have the same genes in the same order as assayFile. This is optional.

+#' @param assayName The name of the assay that you are uploading. The default

+#' is "counts".

+#' @param inputDataFrames If TRUE, assayFile and annotFile are read as data

+#' frames instead of file paths. The default is FALSE.

+#' @param class Character. The class of the expression matrix stored in the SCE

+#'  object. Can be one of "Matrix" (as returned by

+#'  \link[Matrix]{readMM} function), or "matrix" (as returned by

+#'  \link[base]{matrix} function). Default "Matrix".

+#' @param delayedArray Boolean. Whether to read the expression matrix as

+#'  \link[DelayedArray]{DelayedArray} object or not. Default \code{TRUE}.

+#' @return a SingleCellExperiment object

+#' @export

+importFromFiles <- function(assayFile, annotFile = NULL, featureFile = NULL,

+                            assayName = "counts", inputDataFrames = FALSE,

+                            class = c("Matrix", "matrix"), delayedArray = FALSE){

+  

+  if (inputDataFrames){

+    countsin <- assayFile

+    annotin <- annotFile

+    featurein <- featureFile

+  } else{

+    countsin <- readSingleCellMatrix(assayFile, class = class, delayedArray = delayedArray)

+    if (!is.null(annotFile)){

+      annotin <- utils::read.table(annotFile, sep = "\t", header = TRUE,

+                                   row.names = 1)

+    }

+    if (!is.null(featureFile)){

+      featurein <- utils::read.table(featureFile, sep = "\t", header = TRUE,

+                                     row.names = 1)

+    }

+  }

+  if (is.null(annotFile)){

+    annotin <- data.frame(row.names = colnames(countsin))

+    annotin$Sample <- rownames(annotin)

+    annotin <- S4Vectors::DataFrame(annotin)

+  }

+  if (is.null(featureFile)){

+    featurein <- data.frame(Gene = rownames(countsin))

+    rownames(featurein) <- featurein$Gene

+    featurein <- S4Vectors::DataFrame(featurein)

+  }

+  if (nrow(annotin) != ncol(countsin)){

+    stop("Different number of samples in input matrix and annotations: annot: ",

+         nrow(annotin), ", counts: ", ncol(countsin))

+  }

+  if (nrow(featurein) != nrow(countsin)){

+    stop("Different number of samples in input matrix and feature annotation",

+         nrow(featurein), ", counts: ", nrow(countsin))

+  }

+  if (any(rownames(annotin) != colnames(countsin))){

+    stop("Sample names in input matrix and annotation do not match!\nExample: ",

+         rownames(annotin)[rownames(annotin) != colnames(countsin)][1], " vs. ",

+         colnames(countsin)[rownames(annotin) != colnames(countsin)][1])

+  }

+  if (any(rownames(featurein) != rownames(countsin))){

+    stop("Sample names in input matrix and feature annotation do not match!")

+  }

+  assaylist <- list()

+  assaylist[[assayName]] <- methods::as(countsin, "dgCMatrix")

+  newassay <- SingleCellExperiment::SingleCellExperiment(assays = assaylist,

+                                                         colData = annotin,

+                                                         rowData = featurein)

+  

+  if(is.null(newassay$sample)) {

+    newassay$sample <- "sample"

+  }

+  

+  return(newassay)

+}

@@ -2,8 +2,9 @@

 #'

 #' Creates a table of summary metrics from an input SCtkExperiment.

 #'

-#' @param inSCE Input SCtkExperiment object. 

-#' @param useAssay Indicate which assay to summarize. Default \code{"counts"}.

+#' @param inSCE Input SingleCellExperiment object. 

+#' @param useAssay Indicate which assay to summarize. If \code{NULL}, then the first

+#' assay in \code{inSCE} will be used. Default \code{NULL}.

 #' @param sampleVariableName Variable name in \code{colData} denoting which

 #' sample each cell belongs to. If \code{NULL}, all cells will be assumed

 #' to come from the same sample. Default \code{"sample"}.

@@ -16,7 +17,11 @@

 #' data("mouseBrainSubsetSCE")

 #' summarizeSCE(mouseBrainSubsetSCE, sample = NULL)

 #'

-summarizeSCE <- function(inSCE, useAssay="counts", sampleVariableName = NULL){

+summarizeSCE <- function(inSCE, useAssay = NULL, sampleVariableName = NULL){

+  

+  if(is.null(useAssay)) {

+    useAssay <- names(assays(inSCE))[1]

+  }

   if(is.null(sampleVariableName)) {

     sampleVariable <- rep("Sample", ncol(inSCE))

@@ -45,95 +50,6 @@ summarizeSCE <- function(inSCE, useAssay="counts", sampleVariableName = NULL){

   return(df)

 }

-#' Create a SCtkExperiment object

-#'

-#' From a file of counts and a file of annotation information, create a

-#' SCtkExperiment object.

-#'

-#' @param assayFile The path to a text file that contains a header row of sample

-#' names, and rows of raw counts per gene for those samples.

-#' @param annotFile The path to a text file that contains columns of annotation

-#' information for each sample in the assayFile. This file should have the same

-#' number of rows as there are columns in the assayFile.

-#' @param featureFile The path to a text file that contains columns of

-#' annotation information for each gene in the count matrix. This file should

-#' have the same genes in the same order as assayFile. This is optional.

-#' @param assayName The name of the assay that you are uploading. The default

-#' is "counts".

-#' @param inputDataFrames If TRUE, assayFile and annotFile are read as data

-#' frames instead of file paths. The default is FALSE.

-#' @param createLogCounts If TRUE, create a log2(counts+1) normalized assay

-#' and include it in the object. The default is TRUE

-#' @return a SCtkExperiment object

-#' @export

-#' @examples

-#' data("mouseBrainSubsetSCE")

-#' counts_mat <- assay(mouseBrainSubsetSCE, "counts")

-#' sample_annot <- colData(mouseBrainSubsetSCE)

-#' row_annot <- rowData(mouseBrainSubsetSCE)

-#' newSCE <- createSCE(assayFile = counts_mat, annotFile = sample_annot,

-#'                     featureFile = row_annot, assayName = "counts",

-#'                     inputDataFrames = TRUE, createLogCounts = TRUE)

-createSCE <- function(assayFile=NULL, annotFile=NULL, featureFile=NULL,

-                      assayName="counts", inputDataFrames=FALSE,

-                      createLogCounts=TRUE){

-  

-  if (is.null(assayFile)){

-    stop("You must supply a count file.")

-  }

-  if (inputDataFrames){

-    countsin <- assayFile

-    annotin <- annotFile

-    featurein <- featureFile

-  } else{

-    countsin <- utils::read.table(assayFile, sep = "\t", header = TRUE,

-                                  row.names = 1)

-    if (!is.null(annotFile)){

-      annotin <- utils::read.table(annotFile, sep = "\t", header = TRUE,

-                                   row.names = 1)

-    }

-    if (!is.null(featureFile)){

-      featurein <- utils::read.table(featureFile, sep = "\t", header = TRUE,

-                                     row.names = 1)

-    }

-  }

-  if (is.null(annotFile)){

-    annotin <- data.frame(row.names = colnames(countsin))

-    annotin$Sample <- rownames(annotin)

-    annotin <- S4Vectors::DataFrame(annotin)

-  }

-  if (is.null(featureFile)){

-    featurein <- data.frame(Gene = rownames(countsin))

-    rownames(featurein) <- featurein$Gene

-    featurein <- S4Vectors::DataFrame(featurein)

-  }

-  if (nrow(annotin) != ncol(countsin)){

-    stop("Different number of samples in input matrix and annotations: annot: ",

-         nrow(annotin), ", counts: ", ncol(countsin))

-  }

-  if (nrow(featurein) != nrow(countsin)){

-    stop("Different number of samples in input matrix and feature annotation",

-         nrow(featurein), ", counts: ", nrow(countsin))

-  }

-  if (any(rownames(annotin) != colnames(countsin))){

-    stop("Sample names in input matrix and annotation do not match!\nExample: ",

-         rownames(annotin)[rownames(annotin) != colnames(countsin)][1], " vs. ",

-         colnames(countsin)[rownames(annotin) != colnames(countsin)][1])

-  }

-  if (any(rownames(featurein) != rownames(countsin))){

-    stop("Sample names in input matrix and feature annotation do not match!")

-  }

-  assaylist <- list()

-  assaylist[[assayName]] <- as.matrix(countsin)

-  newassay <- SCtkExperiment(assays = assaylist,

-                             colData = annotin,

-                             rowData = featurein)

-  if (createLogCounts){

-    SummarizedExperiment::assay(newassay, paste0("log", assayName)) <-

-      log2(SummarizedExperiment::assay(newassay, assayName) + 1)

-  }

-  return(newassay)

-}

 #' Filter Genes and Samples from a Single Cell Object

 #'

@@ -71,10 +71,11 @@ seuratNormalizeData <- function(inSCE, useAssay, normAssayName = "seuratNormData

 #' @return sceObject scaled sce object

 #' @export

 seuratScaleData <- function(inSCE, useAssay, scaledAssayName = "seuratScaledData", model = "linear", scale = TRUE, center = TRUE, scaleMax = 10) {

-    seuratObject <- Seurat::ScaleData(convertSCEToSeurat(inSCE, useAssay), features = rownames(inSCE), model.use = model, do.scale = scale, do.center = center, scale.max = as.double(scaleMax), verbose = FALSE)

-    inSCE <- .updateAssaySCE(inSCE, seuratObject, scaledAssayName, "scale.data")

-    inSCE <- .addSeuratToMetaDataSCE(inSCE, seuratObject)

-    return(inSCE)

+  seuratObject <- convertSCEToSeurat(inSCE, useAssay)

+  seuratObject <- Seurat::ScaleData(seuratObject, features = rownames(seuratObject), model.use = model, do.scale = scale, do.center = center, scale.max = as.double(scaleMax), verbose = FALSE)

+  inSCE <- .updateAssaySCE(inSCE, seuratObject, scaledAssayName, "scale.data")

+  inSCE <- .addSeuratToMetaDataSCE(inSCE, seuratObject)

+  return(inSCE)

 }

 #' seuratFindHVG

@@ -332,7 +333,7 @@ seuratComputeHeatmap <- function(inSCE, useAssay, useReduction = c("pca", "ica")

   if(is.null(dims)) {

     dims <- ncol(seuratObject@reductions[[useReduction]])

   }

-  return(Seurat::DimHeatmap(seuratObject, dims = 1:dims, nfeatures = 30, reduction = useReduction, fast = fast, combine = combine, raster = raster))

+  return(Seurat::DimHeatmap(seuratObject, dims = 1:dims, nfeatures = nfeatures, reduction = useReduction, fast = fast, combine = combine, raster = raster))

 }

 #' seuratHeatmapPlot

@@ -755,55 +755,38 @@ shinyServer(function(input, output, session) {

   observeEvent(input$uploadData, {

     withBusyIndicatorServer("uploadData", {

       if (input$uploadChoice == "files"){

-        vals$original <- createSCE(assayFile = input$countsfile$datapath,

+        vals$original <- importFromFiles(assayFile = input$countsfile$datapath,

                                    annotFile = input$annotFile$datapath,

                                    featureFile = input$featureFile$datapath,

                                    assayName = input$inputAssayType)

       } else if (input$uploadChoice == "example"){

-        if (input$selectExampleData == "mouseBrainSubset"){

-          data(list = paste0(input$selectExampleData, "SCE"))

-          vals$original <- base::eval(parse(text = paste0(input$selectExampleData, "SCE")))

-        } else if (input$selectExampleData == "maits"){

-          data(maits, package = "MAST")

-          vals$original <- withConsoleRedirect(createSCE(assayFile = t(maits$expressionmat),

-                                                         annotFile = maits$cdat,

-                                                         featureFile = maits$fdat,

-                                                         assayName = "logtpm",

-                                                         inputDataFrames = TRUE,

-                                                         createLogCounts = FALSE))

-          rm(maits)

-        } else if (input$selectExampleData == "fluidigm_pollen_et_al") {

-          data(fluidigm, package = "scRNAseq")

-          tempsce <- as(fluidigm, "SingleCellExperiment")

-          vals$original <- as(tempsce, "SCtkExperiment")

-          rm(fluidigm, tempsce)

+        if (input$selectExampleData == "fluidigm_pollen_et_al") {

+          temp <- scRNAseq::ReprocessedFluidigmData()

+          temp$sample <- paste0(colData(temp)$Biological_Condition, "_", colData(temp)$Coverage_Type)

         } else if (input$selectExampleData == "th2_mahata_et_al") {

-          data(th2, package = "scRNAseq")

-          tempsce <- as(th2, "SingleCellExperiment")

-          vals$original <- as(tempsce, "SCtkExperiment")

-          rm(th2, tempsce)

+          temp <- scRNAseq::ReprocessedTh2Data()

+          temp$sample <- "sample"

         } else if (input$selectExampleData == "allen_tasic_et_al") {

-          data(allen, package = "scRNAseq")

-          tempsce <- as(allen, "SingleCellExperiment")

-          vals$original <- as(tempsce, "SCtkExperiment")

-          rm(allen, tempsce)

+          temp <- scRNAseq::ReprocessedAllenData()

+          temp$sample <- paste0(colData(temp)$driver_1_s, "_", colData(temp)$dissection_s)

         }

+        

+        # Convert to sparseMatrix

+        for(i in seq_along(names(assays(temp)))) {

+          assay(temp, i) <- .convertToMatrix(assay(temp, i))

+        }

+        

+        vals$original <- temp

+        rm(temp)

+        

       } else if (input$uploadChoice == "rds") {

         importedrds <- readRDS(input$rdsFile$datapath)

-        if (methods::is(importedrds, "SummarizedExperiment")) {

+        if (base::inherits(importedrds, "SummarizedExperiment")) {

           vals$original <- importedrds

-          seuratWorkflow$sce_rds_file <- input$rdsFile #for seurat workflow

-        } else {

-          vals$original <- NULL

-        }

-      } else if (input$uploadChoice == "rds_seurat") {

-        importedrds <- readRDS(input$rdsFileSeurat$datapath)

-        if (methods::is(importedrds, "Seurat")) {

+        } else if (base::inherits(importedrds, "Seurat")) {

           vals$original <- convertSeuratToSCE(importedrds)

-          seuratWorkflow$sce_rds_file <- importedrds #for seurat workflow

-        }

-        else {

-          vals$original <- NULL

+        } else {

+          showNotification("The '.rds' file should contain a 'SingleCellExperiment' or 'Seurat' object.", type = "error")

         }

       } else if (input$uploadChoice == "directory") {

         if (input$algoChoice == "cellRanger2") {

@@ -888,7 +871,6 @@ shinyServer(function(input, output, session) {

       }

       if (!is.null(vals$original)) {

-        # withConsoleRedirect({print(vals$original)})

         vals$counts <- vals$original

         updateColDataNames()

         updateNumSamples()

@@ -987,8 +969,7 @@ shinyServer(function(input, output, session) {

     } else {

       assaySelect <- input$filterAssaySelect

     }

-    singleCellTK::summarizeSCE(inSCE = vals$counts,

-                                 useAssay = "counts")

+    singleCellTK::summarizeSCE(inSCE = vals$counts)

   }, striped = TRUE, border = TRUE, align = "c", spacing = "l")

@@ -1238,7 +1219,11 @@ shinyServer(function(input, output, session) {

     req(vals$counts)

     withBusyIndicatorServer("normalizeAssay", {

         if (input$normalizeLibrarySelect == "seurat") {

-            vals$counts <- seuratNormalizeData(vals$counts, input$normalizeAssaySelect, seuratWorkflow$geneNamesSeurat, input$normalizeAssayMethodSelect, as.numeric(input$normalizationScaleFactor))

+            vals$counts <- seuratNormalizeData(inSCE = vals$counts,

+                                               useAssay = input$normalizeAssaySelect,

+                                               normAssayName = "seuratNormData",

+                                               normalizationMethod = input$normalizeAssayMethodSelect,

+                                               scaleFactor = as.numeric(input$normalizationScaleFactor))

             updateAssayInputs()

         }

         else if (input$normalizeLibrarySelect == "cpm") {

@@ -1464,46 +1449,48 @@ shinyServer(function(input, output, session) {

     }

     })

-  observe({

-    output$geneExpPlot <- renderPlot({

-    if (input$colorGeneBy == "Manual Input") {

-      if (is.null(input$colorGenes)){

-        ggplot2::ggplot() + ggplot2::theme_bw() +

-          ggplot2::theme(plot.background = ggplot2::element_rect(fill = "white")) +

-          ggplot2::theme(panel.border = ggplot2::element_rect(colour = "white"))

-      } else {

-        if (input$axisNames == TRUE) {

-          if (input$dimRedAxis1 == "" & input$dimRedAxis2 == "") {

-            shinyalert::shinyalert("Error", text = "Enter axis names", type = "error")

-          } else {

-            comp1 <- input$dimRedAxis1

-            comp2 <- input$dimRedAxis2

-          }

-        } else {

-          comp1 <- NULL

-          comp2 <- NULL

-        }

-        #shinyjs doesn't have any visibility functions so have used the following conditions

-        if (any(grepl("PC*", colnames(reducedDim(vals$counts, input$usingReducedDims))))){

-          vals$pcX <- input$pcX

-          vals$pcY <- input$pcY

-        } else {

-          vals$pcX <- NULL

-          vals$pcY <- NULL

-        }

-        vals$dimRedPlot_geneExp <- singleCellTK::plotBiomarker(inSCE = vals$counts,

-                                                               gene = input$colorGenes,

-                                                               binary = input$colorBinary,

-                                                               shape = input$shapeBy,

-                                                               useAssay = input$dimRedAssaySelect,

-                                                               reducedDimName = input$usingReducedDims,

-                                                               comp1 = comp1, comp2 = comp2,

-                                                               x = vals$pcX, y = vals$pcY)

-        vals$dimRedPlot_geneExp

-      }

-    }

-  })

-  })

+  # This code is commented out b/c it was causing a major lag whenever anything else was being

+  # updated. Maybe it needs to be changed to observeEvent? - Josh

+  # observe({

+  #   output$geneExpPlot <- renderPlot({

+  #   if (input$colorGeneBy == "Manual Input") {

+  #     if (is.null(input$colorGenes)){

+  #       ggplot2::ggplot() + ggplot2::theme_bw() +

+  #         ggplot2::theme(plot.background = ggplot2::element_rect(fill = "white")) +

+  #         ggplot2::theme(panel.border = ggplot2::element_rect(colour = "white"))

+  #     } else {

+  #       if (input$axisNames == TRUE) {

+  #         if (input$dimRedAxis1 == "" & input$dimRedAxis2 == "") {

+  #           shinyalert::shinyalert("Error", text = "Enter axis names", type = "error")

+  #         } else {

+  #           comp1 <- input$dimRedAxis1

+  #           comp2 <- input$dimRedAxis2

+  #         }

+  #       } else {

+  #         comp1 <- NULL

+  #         comp2 <- NULL

+  #       }

+  #       #shinyjs doesn't have any visibility functions so have used the following conditions

+  #       if (any(grepl("PC*", colnames(reducedDim(vals$counts, input$usingReducedDims))))){

+  #         vals$pcX <- input$pcX

+  #         vals$pcY <- input$pcY

+  #       } else {

+  #         vals$pcX <- NULL

+  #         vals$pcY <- NULL

+  #       }

+  #       vals$dimRedPlot_geneExp <- singleCellTK::plotBiomarker(inSCE = vals$counts,

+  #                                                              gene = input$colorGenes,

+  #                                                              binary = input$colorBinary,

+  #                                                              shape = input$shapeBy,

+  #                                                              useAssay = input$dimRedAssaySelect,

+  #                                                              reducedDimName = input$usingReducedDims,

+  #                                                              comp1 = comp1, comp2 = comp2,

+  #                                                              x = vals$pcX, y = vals$pcY)

+  #       vals$dimRedPlot_geneExp

+  #     }

+  #   }

+  # })

+  # })

   output$clusterPlot <- renderPlotly({

     req(vals$dimRedPlot)

@@ -2225,397 +2212,397 @@ shinyServer(function(input, output, session) {

   color_seqdiv <- rownames(color_table[which(color_table$category == "div"

     |color_table$category == "seq"),])

-  #-+-+-+-+-+-For Input Observe##############

-  observe({

-    # is there an error or not

-    if (is.null(vals$counts)) {

-      # shinyalert::shinyalert("Error!", "Upload data first.", type = "error")

-    } else {

-      #colorbrewer_list <- rownames(RColorBrewer::brewer.pal.info)

-      #color_table <- RColorBrewer::brewer.pal.info %>% data.frame()

-      #color_seqdiv <- rownames(color_table[which(color_table$category == "div"

-      #                                           |color_table$category == "seq"),])

-      #from sce

-      cell_list <- BiocGenerics::colnames(vals$counts)

-      gene_list <- BiocGenerics::rownames(vals$counts)

-      #from assays

-      method_list <- names(assays(vals$counts))

-      #from reduced

-      approach_list <- names(reducedDims(vals$counts))

-      #from colData

-      annotation_list <- names(colData(vals$counts))

-

-      updateSelectInput(session, "QuickAccess",

-        choices = c("",approach_list,"Custom"))

-      updateSelectInput(session, "ApproachSelect_Xaxis",

-        choices = c(approach_list))

-      updateSelectInput(session, "AdvancedMethodSelect_Xaxis",

-        choices = c(method_list))

-      updateSelectInput(session, "GeneSelect_Assays_Xaxis",

-        choices = c(gene_list))

-      updateSelectInput(session, "AnnotationSelect_Xaxis",

-        choices = c(annotation_list))

-      updateSelectInput(session, "ApproachSelect_Yaxis",

-        choices = c(approach_list))

-      updateSelectInput(session, "AdvancedMethodSelect_Yaxis",

-        choices = c(method_list))

-      updateSelectInput(session, "GeneSelect_Assays_Yaxis",

-        choices = c(gene_list))

-      updateSelectInput(session, "AnnotationSelect_Yaxis",

-        choices = c(annotation_list))

-      updateSelectInput(session, "ApproachSelect_Colorby",

-        choices = c(approach_list))

-      updateSelectInput(session, "AdvancedMethodSelect_Colorby",

-        choices = c(method_list))

-      updateSelectInput(session, "GeneSelect_Assays_Colorby",

-        choices = c(gene_list))

-      updateSelectInput(session, "AnnotationSelect_Colorby",

-        choices = c(annotation_list))

-      updateSelectizeInput(session, "adjustgroupby", label = NULL, choices = c("None", annotation_list))

-      updateSelectizeInput(session,"adjustbrewer", label = "Color Palettes:",

-        choices = c("RdYlBu",color_seqdiv))

-    }

-  })

-

-  #-+-+-+-+-+-For Advanced Input Observe##############

-  ###ApproachSelect to DimensionSelect X-Axis

-  observe({

-    if (!is.null(vals$counts)){

-      len <- length(SingleCellExperiment::reducedDims(vals$counts))

-      if (!is.null(input$ApproachSelect_Xaxis) & len > 0){

-        Df <- data.frame(SingleCellExperiment::reducedDim(vals$counts,input$ApproachSelect_Xaxis))

-        xs <- colnames(Df)

-        updateSelectInput(session, "ColumnSelect_Xaxis", choices = c(xs))

-        rm(Df)

-      }

-    }

-  })

-  ###ApproachSelect to DimensionSelect Y-Axis

-  observe({

-    if (!is.null(vals$counts)){

-      len <- length(SingleCellExperiment::reducedDims(vals$counts))

-      if (!is.null(input$ApproachSelect_Yaxis) & len > 0){

-        Df2 <- data.frame(SingleCellExperiment::reducedDim(vals$counts,input$ApproachSelect_Yaxis))

-        xs2 <- colnames(Df2)

-        xs2 <- sort(xs2, decreasing = TRUE)

-        updateSelectInput(session, "ColumnSelect_Yaxis", choices = c(xs2))

-        rm(Df2)

-      }

-    }

-  })

-  ###ApproachSelect to DimensionSelect Colorby

-  observe({

-    if (!is.null(vals$counts)){

-      len <- length(SingleCellExperiment::reducedDims(vals$counts))

-      if (!is.null(input$ApproachSelect_Colorby) & len > 0){

-        Df3 <- data.frame(SingleCellExperiment::reducedDim(vals$counts,input$ApproachSelect_Colorby))

-        xs3 <- colnames(Df3)

-        updateSelectInput(session, "ColumnSelect_Colorby", choices = c(xs3))

-        rm(Df3)

-      }

-    }

-  })

-

-  #-+-+-+-+-+-Observe Group by###################################################

-  ###Observe Radio Button Select Value Type

-  observe({

-    if (!is.null(vals$counts)){

-      if (input$adjustgroupby !=  'None'){

-        #Integer,level>25#

-        if(is.integer(colData(vals$counts)@listData[[input$adjustgroupby]])

-          & length(levels(as.factor(colData(vals$counts)@listData[[input$adjustgroupby]])))>25){

-          updateRadioButtons(session, "SelectValueType", "Categorical or Continuous",

-            choices = c("Categorical", "Continuous"),

-            selected = "Continuous")

-          shinyjs::delay(5,shinyjs::disable("SelectValueType"))

-          #Integer,level<25#

-        }else if(is.integer(colData(vals$counts)@listData[[input$adjustgroupby]])

-          & length(levels(as.factor(colData(vals$counts)@listData[[input$adjustgroupby]])))<=25){

-          updateRadioButtons(session, "SelectValueType", "Categorical or Continuous",

-            choices = c("Categorical", "Continuous"),

-            selected = "Categorical")

-          shinyjs::enable("SelectValueType")

-          #Numeric,noninteger#

-        }else if(is.numeric(colData(vals$counts)@listData[[input$adjustgroupby]])){

-          updateRadioButtons(session, "SelectValueType", "Categorical or Continuous",

-            choices = c("Categorical", "Continuous"),

-            selected = "Continuous")

-          shinyjs::delay(5,shinyjs::disable("SelectValueType"))

-          #Categorical#

-        }else{

-          updateRadioButtons(session, "SelectValueType", "Categorical or Continuous",

-            choices = c("Categorical", "Continuous"),

-            selected = "Categorical")

-          shinyjs::delay(5,shinyjs::disable("SelectValueType"))}

-      }

-    }

-  })#observe_end

-

-  ###Observe Check Box Check Binning & Text Input Number of Bins:

-

-  observe({

-    if (!is.null(vals$counts)){

-      if (input$adjustgroupby !=  'None'){

-        #Integer,level>25#

-        if(is.integer(colData(vals$counts)@listData[[input$adjustgroupby]])

-          &length(levels(as.factor(colData(vals$counts)@listData[[input$adjustgroupby]])))>25){

-          updateCheckboxInput(session,"checkbinning","Perform Binning", value = TRUE)

-          shinyjs::delay(5,shinyjs::disable("checkbinning"))

-          shinyjs::enable("adjustbinning")

-          #Integer,level<25,continuous

-        }else if(is.integer(colData(vals$counts)@listData[[input$adjustgroupby]])

-          &length(levels(as.factor(colData(vals$counts)@listData[[input$adjustgroupby]])))<=25

-          &input$SelectValueType == "Continuous"){

-          updateCheckboxInput(session,"checkbinning","Perform Binning", value = TRUE)

-          shinyjs::delay(5,shinyjs::disable("checkbinning"))

-          shinyjs::enable("adjustbinning")

-          #Integer,level<25,Categorical

-        }else if(is.integer(colData(vals$counts)@listData[[input$adjustgroupby]])

-          &length(levels(as.factor(colData(vals$counts)@listData[[input$adjustgroupby]])))<=25

-          &input$SelectValueType == "Categorical"){

-          updateCheckboxInput(session,"checkbinning","Perform Binning", value = FALSE)

-          shinyjs::delay(5,shinyjs::disable("checkbinning"))

-          shinyjs::disable("adjustbinning")

-          #Numeric,noninteger

-        }else if(is.numeric(colData(vals$counts)@listData[[input$adjustgroupby]])){

-          updateCheckboxInput(session,"checkbinning","Perform Binning", value = TRUE)

-          shinyjs::delay(5,shinyjs::disable("checkbinning"))

-          shinyjs::enable("adjustbinning")

-          #Categorical

-        }else{updateCheckboxInput(session,"checkbinning","Perform Binning", value = FALSE)

-          shinyjs::delay(5,shinyjs::disable("checkbinning"))

-          shinyjs::disable("adjustbinning")

-        }

-      }

-    }

-  })#observe_end

-

-  #-+-+-+-+-+-Observe Color bye###################################################

-  ###Observe Radio Button Select Value Type

-  observe({

-    if (!is.null(vals$counts)){

-      if (input$TypeSelect_Colorby != 'Pick a Color'){

-        ###If Cell Annotation###############################################################

-        if(input$TypeSelect_Colorby == 'Cell Annotation'){

-          ###If Cell Annotation numeric

-          if(!is.numeric(colData(vals$counts)@listData[[input$AnnotationSelect_Colorby]])){

-            updateRadioButtons(session, "SelectColorType", "Categorical or Continuous",

-              choices = c("Categorical", "Continuous"),

-              selected = "Categorical")

-            shinyjs::delay(5,shinyjs::disable("SelectColorType"))

-

-

-          }else if(is.integer(colData(vals$counts)@listData[[input$AnnotationSelect_Colorby]])

-            &length(levels(as.factor(colData(vals$counts)@listData[[input$AnnotationSelect_Colorby]])))<=25){

-            updateRadioButtons(session, "SelectColorType", "Categorical or Continuous",

-              choices = c("Categorical", "Continuous"),

-              selected = "Categorical")

-            shinyjs::enable("SelectColorType")

-

-          }else{updateRadioButtons(session, "SelectColorType", "Categorical or Continuous",

-            choices = c("Categorical", "Continuous"),

-            selected = "Continuous")

-            shinyjs::delay(5,shinyjs::disable("SelectColorType"))}

-

-          ###If ReducedData##########################################################

-        }else if(input$TypeSelect_Colorby == 'Reduced Dimensions'){

-          Dfcolor <- data.frame(reducedDims(vals$counts)@listData[[input$ApproachSelect_Colorby]])

-          if(input$ColumnSelect_Colorby %in% colnames(Dfcolor)){

-            Dfcolor <- Dfcolor[which(colnames(Dfcolor) == input$ColumnSelect_Colorby)]

-            ###If ReducedData numeric

-

-            if(!is.numeric(Dfcolor[,1])){

-              updateRadioButtons(session, "SelectColorType", "Categorical or Continuous",

-                choices = c("Categorical", "Continuous"),

-                selected = "Categorical")

-              shinyjs::delay(5,shinyjs::disable("SelectColorType"))

-

-

-            }else if(is.integer(Dfcolor[,1])

-              &length(levels(as.factor(Dfcolor[,1])))<=25){

-              updateRadioButtons(session, "SelectColorType", "Categorical or Continuous",

-                choices = c("Categorical", "Continuous"),

-                selected = "Categorical")

-              shinyjs::enable("SelectColorType")

-

-            }else{updateRadioButtons(session, "SelectColorType", "Categorical or Continuous",

-              choices = c("Categorical", "Continuous"),

-              selected = "Continuous")

-              shinyjs::delay(5,shinyjs::disable("SelectColorType"))}

-          }

-          ###If Expression Assays###########################################################

-        }else{Dfassay <- assay(vals$counts, input$AdvancedMethodSelect_Colorby)

-        if(input$GeneSelect_Assays_Colorby %in% rownames(Dfassay)){

-          Dfassay <- data.frame(Dfassay[which(rownames(Dfassay)== input$GeneSelect_Assays_Colorby),])

-

-          if(!is.numeric(Dfassay[,1])){

-            updateRadioButtons(session, "SelectColorType", "Categorical or Continuous",

-              choices = c("Categorical", "Continuous"),

-              selected = "Categorical")

-            shinyjs::delay(5,shinyjs::disable("SelectColorType"))

-

-

-          }else if(is.integer(Dfassay[,1])

-            &length(levels(as.factor(Dfassay[,1])))<=25){

-            updateRadioButtons(session, "SelectColorType", "Categorical or Continuous",

-              choices = c("Categorical", "Continuous"),

-              selected = "Categorical")

-            shinyjs::enable("SelectColorType")

-

-          }else{updateRadioButtons(session, "SelectColorType", "Categorical or Continuous",

-            choices = c("Categorical", "Continuous"),

-            selected = "Continuous")

-            shinyjs::delay(5,shinyjs::disable("SelectColorType"))}

-        }

-        }

-      }

-    }

-  })###observe_end

-

-  ###Observe Check Box Check Binning & Text Input Number of Bins:

-  observe({

-    if (!is.null(vals$counts)){

-      ###If Cell Annotation###############################################################

-      if(input$TypeSelect_Colorby != 'Pick a Color'){

-

-        if(input$TypeSelect_Colorby == 'Cell Annotation'){

-          if(!is.numeric(colData(vals$counts)@listData[[input$AnnotationSelect_Colorby]])){

-            updateCheckboxInput(session,"checkColorbinning","Perform Binning", value = FALSE)

-            shinyjs::delay(5,shinyjs::disable("checkColorbinning"))

-            shinyjs::delay(5,shinyjs::disable("adjustColorbinning"))

-            updateSelectizeInput(session,"adjustbrewer", label = "Color Palettes:", choices = c("ggplot","Celda"))

-

-          }else if(is.integer(colData(vals$counts)@listData[[input$AnnotationSelect_Colorby]])

-            &length(levels(as.factor(colData(vals$counts)@listData[[input$AnnotationSelect_Colorby]])))<=25

-            &input$SelectColorType == 'Categorical'){

-            updateCheckboxInput(session,"checkColorbinning","Perform Binning", value = FALSE)

-            shinyjs::delay(5,shinyjs::disable("checkColorbinning"))

-            shinyjs::delay(5,shinyjs::disable("adjustColorbinning"))

-            updateSelectizeInput(session,"adjustbrewer", label = "Color Palettes:", choices = c("ggplot","Celda"))

-

-          }else if(is.integer(colData(vals$counts)@listData[[input$AnnotationSelect_Colorby]])

-            &length(levels(as.factor(colData(vals$counts)@listData[[input$AnnotationSelect_Colorby]])))<=25

-            &input$SelectColorType == 'Continuous'){

-

-            shinyjs::enable("checkColorbinning")

-            if(input$checkColorbinning == TRUE){

-              shinyjs::enable("adjustColorbinning")

-              updateSelectizeInput(session,"adjustbrewer", label = "Color Palettes:", choices = c("ggplot","Celda"))}

-

-            else{

-              shinyjs::delay(5,shinyjs::disable("adjustColorbinning"))

-              updateSelectizeInput(session,"adjustbrewer", label = "Color Palettes:", choices = c("RdYlBu",color_seqdiv))}

-

-          }else{

-

-            shinyjs::enable("checkColorbinning")

-            if(input$checkColorbinning == TRUE){

-              shinyjs::enable("adjustColorbinning")

-              updateSelectizeInput(session,"adjustbrewer", label = "Color Palettes:", choices = c("ggplot","Celda"))}

-

-            else{

-              shinyjs::delay(5,shinyjs::disable("adjustColorbinning"))

-              updateSelectizeInput(session,"adjustbrewer", label = "Color Palettes:", choices = c("RdYlBu",color_seqdiv))}

-          }

-

-

-          ###If Reduce Dimensions##############################################################

-        }else if(input$TypeSelect_Colorby == 'Reduced Dimensions'){

-          Dfcolor <- data.frame(reducedDims(vals$counts)@listData[[input$ApproachSelect_Colorby]])

-          if(input$ColumnSelect_Colorby %in% colnames(Dfcolor)){

-            Dfcolor <- Dfcolor[which(colnames(Dfcolor) == input$ColumnSelect_Colorby)]

-

-            if(!is.numeric(Dfcolor[,1])){

-              updateCheckboxInput(session,"checkColorbinning","Perform Binning", value = FALSE)

-              shinyjs::delay(5,shinyjs::disable("checkColorbinning"))

-              shinyjs::delay(5,shinyjs::disable("adjustColorbinning"))

-              updateSelectizeInput(session,"adjustbrewer", label = "Color Palettes:", choices = c("ggplot","Celda"))

-

-            }else if(is.integer(Dfcolor[,1])

-              &length(levels(as.factor(Dfcolor[,1])))<=25

-              &input$SelectColorType == 'Categorical'){

-              updateCheckboxInput(session,"checkColorbinning","Perform Binning", value = FALSE)

-              shinyjs::delay(5,shinyjs::disable("checkColorbinning"))

-              shinyjs::delay(5,shinyjs::disable("adjustColorbinning"))

-              updateSelectizeInput(session,"adjustbrewer", label = "Color Palettes:", choices = c("ggplot","Celda"))

-

-            }else if(is.integer(Dfcolor[,1])

-              &length(levels(as.factor(Dfcolor[,1])))<=25

-              &input$SelectColorType == 'Continuous'){

-

-              shinyjs::enable("checkColorbinning")

-              if(input$checkColorbinning == TRUE){

-                shinyjs::enable("adjustColorbinning")

-                updateSelectizeInput(session,"adjustbrewer", label = "Color Palettes:", choices = c("ggplot","Celda"))}

-

-              else{

-                shinyjs::delay(5,shinyjs::disable("adjustColorbinning"))

-                updateSelectizeInput(session,"adjustbrewer", label = "Color Palettes:", choices = c("RdYlBu",color_seqdiv))}

-

-            }else{

-

-              shinyjs::enable("checkColorbinning")

-              if(input$checkColorbinning == TRUE){

-                shinyjs::enable("adjustColorbinning")

-                updateSelectizeInput(session,"adjustbrewer", label = "Color Palettes:", choices = c("ggplot","Celda"))}

-

-              else{

-                shinyjs::delay(5,shinyjs::disable("adjustColorbinning"))

-                updateSelectizeInput(session,"adjustbrewer", label = "Color Palettes:", choices = c("RdYlBu",color_seqdiv))}

-            }

-          }

-

-

-          ###If Expression Assays##########################################################

-        }else{Dfassay <- assay(vals$counts, input$AdvancedMethodSelect_Colorby)

-        if(input$GeneSelect_Assays_Colorby %in% rownames(Dfassay)){

-          Dfassay <- data.frame(Dfassay[which(rownames(Dfassay)== input$GeneSelect_Assays_Colorby),])

-

-          if(!is.numeric(Dfassay[,1])){

-            updateCheckboxInput(session,"checkColorbinning","Perform Binning", value = FALSE)

-            shinyjs::delay(5,shinyjs::disable("checkColorbinning"))

-            shinyjs::delay(5,shinyjs::disable("adjustColorbinning"))

-            updateSelectizeInput(session,"adjustbrewer", label = "Color Palettes:", choices = c("ggplot","Celda"))

-

-          }else if(is.integer(Dfassay[,1])

-            &length(levels(as.factor(Dfassay[,1])))<=25

-            &input$SelectColorType == 'Categorical'){

-            updateCheckboxInput(session,"checkColorbinning","Perform Binning", value = FALSE)

-            shinyjs::delay(5,shinyjs::disable("checkColorbinning"))

-            shinyjs::delay(5,shinyjs::disable("adjustColorbinning"))

-            updateSelectizeInput(session,"adjustbrewer", label = "Color Palettes:", choices = c("ggplot","Celda"))

-

-          }else if(is.integer(Dfassay[,1])

-            &length(levels(as.factor(Dfassay[,1])))<=25

-            &input$SelectColorType == 'Continuous'){

-

-            shinyjs::enable("checkColorbinning")

-            if(input$checkColorbinning == TRUE){

-              shinyjs::enable("adjustColorbinning")

-              updateSelectizeInput(session,"adjustbrewer", label = "Color Palettes:", choices = c("ggplot","Celda"))}

-

-            else{