allow more levels

C3BI-pasteur-fr · Apr 11, 2024 · 12cf527 · 12cf527
1 parent 3e16697
commit 12cf527
Show file tree

Hide file tree

Showing 3 changed files with 31 additions and 13 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: SCHNAPPs
 Type: Package
 Title: Single Cell Shiny Application for Analysing Single Cell Transcriptomics Data
-Version: 1.15.15
+Version: 1.15.17
 Authors@R: c(person("Bernd", "Jagla", role = c("aut", "cre"), email = "[email protected]", comment = c(ORCID = "0000-0002-7696-0484")))
 Maintainer: Bernd Jagla <[email protected]>
 Description: Single Cell sHiny APPlication (SCHNAPPs) is a R/Shiny based application to interact, manipulate, explore, and analyze single cell RNA-seq experiments, including MARS-seq and others.

diff --git a/inst/app/outputs.R b/inst/app/outputs.R
@@ -811,14 +811,21 @@ output$ColorSelection <- renderUI({
   # where and how to store the colors
   tabs= lapply(names(projections), FUN = function(name){
     if(is.factor(projections[,name])){
-      if(length(levels(projections[,name]))>30) return(NULL)
+      if(length(levels(projections[,name]))>100) {
+        showNotification(
+          paste(name," has more than 100 levels\n"),
+          type = "error",
+          duration = NULL
+        )
+        return(NULL)
+      }
       return(tmpFun(name = name, value = paste0(name, "ColorPanel"), lev = levels(projections[,name]), idStr = paste0(name, ".col."),
                     sampCol = defaultValue(paste0(name, ".colVec"), allowedColors[seq(levels(projections[,name]))]),
                     allowedColors = allowedColors)
       )
     } else {
       return(tmpFunCont(name = name, value = paste0(name, "ColorPanel"),
-                        sampCol = defaultValue(paste0(name, ".colVec"), c("white", "#2D96FA")),
+                        sampCol = defaultValue(paste0(name, ".colVec"), c("#FAF4F5", "#2D96FA")),
                         allowedColors = allowedColors)
       )
     }
@@ -1027,8 +1034,8 @@ observeEvent(eventExpr = obscolorParamsChanger() , label = "ob_colorParams", {
   # browser()
   lapply(names(projections), FUN = function(name){
     if(is.factor(projections[,name])){
-      if(length(levels(projections[,name]))>30) {
-        cat(file = stderr(), paste0(name, "factor", ">30 levels\n"))
+      if(length(levels(projections[,name]))>100) {
+        cat(file = stderr(), paste0("\n\n\t", name, " factor", ">100 levels\n\n"))
         return(NULL)
       }
       # browser()

diff --git a/inst/app/reactives.R b/inst/app/reactives.R
@@ -406,7 +406,7 @@ inputDataFunc <- function(inFile) {
   if (.schnappsEnv$DEBUGSAVE) {
     save(file = "~/SCHNAPPsDebug/readInp.RData", list = c(ls()))
   }
-  # load(file='~/SCHNAPPsDebug/readInp.RData')
+  # cp =load(file='~/SCHNAPPsDebug/readInp.RData')
 
 
   #' save orginial data
@@ -3370,7 +3370,7 @@ sample <- reactive({
   for (pdColName in colnames(pd)) {
     # in case dbCluster is already in the colData this would create dbCluster.1 later on
     if (pdColName == "dbCluster") next()
-    if (length(levels(factor(pd[, pdColName]))) < 30) {
+    if (length(levels(factor(pd[, pdColName]))) < 100) {
       if (is.null(retVal)) {
         retVal <- data.frame(pd[, pdColName])
         colnames(retVal) <- pdColName
@@ -3658,13 +3658,18 @@ inputSample <- reactive({
   if (.schnappsEnv$DEBUGSAVE) {
     save(file = "~/SCHNAPPsDebug/inputSample.RData", list = c(ls()))
   }
-  # load(file='~/SCHNAPPsDebug/inputSample.RData')
-
+  # cp=load(file='~/SCHNAPPsDebug/inputSample.RData')
+  if(!"sampleNames" %in% colnames(colData(scEx))){
+    if (!is.null(getDefaultReactiveDomain())) {
+      showNotification("no sampleNames in colData(scEx)", id = "inputSampleErr", duration = NULL)
+      return(NULL)
+    }
+  }
   # TODO should come from sampleInfo
-  sampInf <- gsub(".*-(.*)", "\\1", scEx$barcode)
+  # sampInf <- gsub(".*-(.*)", "\\1", scEx$barcode)
   cellIds <- data.frame(
     cellName = colnames(scEx),
-    sample = sampInf,
+    sample = colData(scEx)$sampleNames,
     # number of genes per cell
     ngenes = Matrix::colSums(assays(scEx)[[1]]>0),
     nUMI = Matrix::colSums(assays(scEx)[[1]])
@@ -3707,12 +3712,18 @@ inputSampleOrg <- reactive({
     save(file = "~/SCHNAPPsDebug/inputSample.RData", list = c(ls()))
   }
   # load(file='~/SCHNAPPsDebug/inputSample.RData')
+  if(!"sampleNames" %in% colnames(colData(scEx))){
+    if (!is.null(getDefaultReactiveDomain())) {
+      showNotification("no sampleNames in colData(scEx)", id = "inputSampleErr", duration = NULL)
+      return(NULL)
+    }
+  }
 
   # TODO should come from sampleInfo
-  sampInf <- gsub(".*-(.*)", "\\1", dataTables$scEx$barcode)
+  # sampInf <- gsub(".*-(.*)", "\\1", dataTables$scEx$barcode)
   cellIds <- data.frame(
     cellName = colnames(dataTables$scEx),
-    sample = sampInf,
+    sample = colData(dataTables$scEx)$sampleNames,
     # number of genes per cell
     ngenes = Matrix::colSums(assays(dataTables$scEx)[[1]]>0),
     nUMI = Matrix::colSums(assays(dataTables$scEx)[[1]])