safeBPParam

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: SCHNAPPs
 Type: Package
 Title: Single Cell Shiny Application for Analysing Single Cell Transcriptomics Data
-Version: 1.15.17
+Version: 1.15.18
 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.

README.md

@@ -22,10 +22,11 @@ Windows: <https://cran.r-project.org/bin/windows/>
 
 MAC: <https://cran.r-project.org/bin/macosx/>
 
-  update.packages()
+
  if (!require("devtools"))
   install.packages("devtools")
  # devtools::install_github("mul118/shinyMCE")
+  update.packages()
  if (!requireNamespace("BiocManager", quietly = TRUE))
   install.packages("BiocManager")
  # update bioconductor packages if required

inst/app/contributions/coE_coExpression/reactives.R

@@ -436,7 +436,7 @@ scranFindMarkerFullReactiveTable <- reactive({
  oldNcpu = bpnworkers(bpparam())
  on.exit({
  printTimeEnd(start.time, "coE_scranFindMarkerTableReact")
- register(MulticoreParam(oldNcpu))
+ register(safeBPParam(oldNcpu))
  if (!is.null(getDefaultReactiveDomain())) {
  removeNotification(id = "coE_scranFindMarkerTableReact")
  }
@@ -467,7 +467,7 @@ scranFindMarkerFullReactiveTable <- reactive({
  # browser()
  # 4.18 GB
  # parallel --- done
- register(MulticoreParam(nCPU))
+ register(safeBPParam(nCPU))
 
  start.time <- base::Sys.time()
  wmarkers <- tryCatch({

inst/app/contributions/sCA_subClusterAnalysis/reactives.R

@@ -683,7 +683,7 @@ sCA_dge <- reactive({
  register(SnowParam(workers = nCPU))
  } else{
  plan(multisession, workers = nCPU)
- register(MulticoreParam(workers = nCPU))
+ register(safeBPParam(nCPU))
  }
 
 

inst/app/defaultValues.R

@@ -5,7 +5,7 @@
 allowedColors <- unique(c(
  "#2D96FA", "#8D8889", "#E8E0E0", "#FF2F7D", "#60A948", "#732BA3", "#FFC720", "#E96B0C", "#22ABA4", 
  "#8c510a", "#d8b365", "#f6e8c3", "#c7eae5", "#5ab4ac", "#01665e","#000000", "#c51b7d", "#e9a3c9", "#fde0ef", 
- "#e0e0e0", "#FAF4F5", "#999999", "#414144", "#E3E9EB", "#D4070F", "#1C1AAF", "#4d4d4d", "#e6f5d0", "#a1d76a", "#4d9221", "#762a83","white", 
+ "#e0e0e0", "#FAF4F5", "#999999", "#414144", "#E3E9EB", "#D4070F", "#1C1AAF", "#4d4d4d", "#e6f5d0", "#a1d76a", "#4d9221", "#762a83", 
  "#af8dc3", "#e7d4e8", "#d9f0d3", "#7fbf7b", "#1b7837", "#b35806", "#f1a340", "#fee0b6", "#d8daeb", "#998ec3", 
  "#542788", "#fddbc7", "#d1e5f0", "#ef8a62", "#b2182b", "#67a9cf", "#2166ac"))
 names(allowedColors) = make.names(1:length(allowedColors))

inst/app/outputs.R

@@ -180,18 +180,18 @@ observe(label ="obs_pcaN", x = {
 })
 
 
-# check gene names ----
-observe({
- scEx = scEx()
- req(scEx)
- if(any(stringr::str_detect( rownames(scEx), "_"))){
- showNotification(
- "gene names contain '_', which will be replaced by Seurat by '.', which can cause artefacts",
- type = "error",
- duration = NULL
- )
- }
-})
+# # check gene names ----
+# observe({
+#  scEx = scEx()
+#  req(scEx)
+#  if(any(stringr::str_detect( rownames(scEx), "_"))){
+#  showNotification(
+#  "gene names contain '_', which will be replaced by Seurat by '.', which can cause artefacts",
+#  type = "error",
+#  duration = NULL
+#  )
+#  }
+# })
 
 
 output$noLogWarning <- renderText({

inst/app/reactives.R

@@ -1842,10 +1842,18 @@ scEx_log <- reactive({
  } else {
  scEx_log <- do.call(normMethod, args = list())
  }
+ # browser()
  if (is.null(scEx_log)) {
  # problem with normalization
  return(NULL)
  }
+ if(nrow(scEx_log)<2){
+ cat(file = stderr(), "\n\nnormalization returned 0 genes.\n\n\n")
+ return(NULL)
+ }
+ if(ncol(scEx_log)<2){
+ return(NULL)
+ }
  .schnappsEnv$calculated_normalizationRadioButton <- normMethod
 
  add2history(type = "save", input = isolate( reactiveValuesToList(input)), comment = "scEx_log", scEx_log = scEx_log)
@@ -2148,6 +2156,34 @@ pcaFunc <- function(scEx, scEx_log,
  return(val)
  }
 
+ if(nrow(scEx_log)<10){
+ cat(file = stderr(), paste("error in PCA:", e))
+ if (!is.null(getDefaultReactiveDomain())) {
+ showNotification(
+ paste("Problem with PCA, probably not enough genes?", e),
+ type = "warning",
+ id = "pcawarning",
+ duration = NULL
+ )
+ }
+ cat(file = stderr(), "PCA FAILED!!!\n")
+ return(NULL)
+ }
+
+ if(ncol(scEx_log)<10){
+ cat(file = stderr(), paste("error in PCA:", e))
+ if (!is.null(getDefaultReactiveDomain())) {
+ showNotification(
+ paste("Problem with PCA, probably not enough cells?", e),
+ type = "warning",
+ id = "pcawarning",
+ duration = NULL
+ )
+ }
+ cat(file = stderr(), "PCA FAILED!!!\n")
+ return(NULL)
+ }
+
  scaterPCA <- withWarnings({
  # not sure, but this works on another with TsparseMatrix
  if (!is(assays(scEx_log)[["logcounts"]], "CsparseMatrix")) {
@@ -2182,6 +2218,9 @@ pcaFunc <- function(scEx, scEx_log,
  pca
  })
 
+ if(!exists("scaterPCA")){
+ return(NULL)
+ }
  if (is.null(scaterPCA)) {
  return(NULL)
  }
@@ -3213,7 +3252,7 @@ projections <- reactive({
  printTimeEnd(start.time, "projections add history")
  add2history(type = "save", input=isolate( reactiveValuesToList(input)), comment = "projections", projections = projections)
 
- cat(file = stderr(), paste("\n\nscLog: ",isolate(input$whichscLog),"\n\n"))
+ if (DEBUG) cat(file = stderr(), paste("scLog: ",isolate(input$whichscLog),"\n"))
  # add2history(type = "save", comment = "projections", projections = projections)
 
  exportTestValues(projections = {

inst/app/runDevApp.R

@@ -23,7 +23,7 @@ plan("multisession", workers = 8)
 # plan(callr, workers = 4)
 
 library("BiocParallel")
-register(MulticoreParam(2))
+register(safeBPParam(2))
 # register(SerialParam())
 
 localContributionDir = "~/Rstudio/SCHNAPPsContributions/working"
@@ -51,7 +51,7 @@ historyPath = "/Volumes/LaCie2022/RStudio_history/julia/"
 # historyPath = "/Volumes/CBUtechsZeus/bernd/celia/hist_2023-May-26.15.18/"
 # # historyPath = "demoHistory/MPI"
 # # historyPath = "/Volumes/LaCie2022/RStudio_history/marielle/hist_2022-Dec-15.18.15/"
-# historyPath = NULL
+historyPath = NULL
 assign(".SCHNAPPs_locContributionDir", localContributionDir, envir = .schnappsEnv)
 assign(".SCHNAPPs_defaultValueSingleGene", defaultValueSingleGene, envir = .schnappsEnv)
 assign(".SCHNAPPs_defaultValueMultiGenes", defaultValueMultiGenes, envir = .schnappsEnv)

inst/app/runVMApp.R

@@ -20,7 +20,7 @@ library(doParallel)
 registerDoParallel(cores=WORKERS)
 
 library("BiocParallel")
-register(MulticoreParam(WORKERS))
+register(safeBPParam(WORKERS))
 # register(SerialParam())
 
 localContributionDir = "/home/schnapps/SCHNAPPsContributions/"

inst/app/serverFunctions.R

@@ -16,6 +16,15 @@ suppressMessages(library(InteractiveComplexHeatmap))
 library(dendsort)
 library(MASS)
 
+# from LTLA (https://github.com/Bioconductor/BiocParallel/issues/98)
+safeBPParam <- function(nworkers) {
+ if (.Platform$OS.type=="windows") {
+ BiocParallel::SerialParam()
+ } else {
+ BiocParallel::MulticoreParam(nworkers)
+ }
+}
+
 
 ### Try catch from extended examples ----
 #' tryCatch with Warning Extraction
@@ -1551,7 +1560,7 @@ heatmapModuleFunction <- function(
  if (is.null(sortingCols)) return(NULL)
  if (sortingCols == "dendrogram") colTree = TRUE
 
- if (is.null(heatmapData) | is.null(proje) | is.null(heatmapData$mat)) {
+ if (is.null(heatmapData) | is.null(proje) | is.null(heatmapData$mat) ) {
  return(NULL)
  # return(list(
  # src = "empty.png",
@@ -1561,6 +1570,9 @@ heatmapModuleFunction <- function(
  # alt = "pHeatMapPlot should be here (null)"
  # ))
  }
+ if(nrow(heatmapData$mat)<2 | ncol(heatmapData$mat)<2){
+ return(NULL)
+ }
  if(is.null(minMaxVal)) minMaxVal = c(min(heatmapData$mat), max(heatmapData$mat))
  if (.schnappsEnv$DEBUGSAVE) {
  save(file = "~/SCHNAPPsDebug/heatmapModuleFunction.RData", list = c(ls()))

inst/develo/dockerCelia/runDockerApp.R

@@ -19,7 +19,7 @@ plan(sequential)
 
 
 library("BiocParallel")
-register(MulticoreParam(WORKERS))
+register(safeBPParam(WORKERS))
 # register(SerialParam())
 
 localContributionDir = "/root/SCHNAPPsContributions/"

inst/develo/dockerImage/runDockerApp.R

@@ -19,7 +19,7 @@ plan(sequential)
 
 
 library("BiocParallel")
-register(MulticoreParam(WORKERS))
+register(safeBPParam(WORKERS))
 # register(SerialParam())
 
 localContributionDir = "/root/SCHNAPPsContributions/"

inst/develo/params-tests.R

@@ -12,14 +12,14 @@ params <- list(
 params$assay.type <- "counts"
 params$x <- scEx
 
-register(MulticoreParam(
-  workers = ifelse(detectCores() > 1, detectCores() - 1, 1)
+register(safeBPParam(
+ ifelse(detectCores() > 1, detectCores() - 1, 1)
 ),
 default = TRUE
 )
 
-register(MulticoreParam(
- workers = 13
+register(safeBPParam(
+ 13
 ),
 default = TRUE
 )

inst/develo/startSchnapps.R

@@ -15,7 +15,7 @@ library(future)
 plan(sequential)
 
 library("BiocParallel")
-register(MulticoreParam(6))
+register(safeBPParam(6))
 
 schnapps(DEBUG=T)