From f65a465fe2d744a9c4c0ce1b3cdc14d2927996b0 Mon Sep 17 00:00:00 2001 From: Bernd Jagla Date: Mon, 22 Apr 2024 10:51:11 +0200 Subject: [PATCH] safeBPParam --- DESCRIPTION | 2 +- README.md | 3 +- .../DE_DataExploration/parameters.R | 186 +++++++++++------- .../coE_coExpression/reactives.R | 4 +- .../sCA_subClusterAnalysis/reactives.R | 2 +- inst/app/defaultValues.R | 2 +- inst/app/outputs.R | 24 +-- inst/app/reactives.R | 41 +++- inst/app/runDevApp.R | 4 +- inst/app/runVMApp.R | 2 +- inst/app/serverFunctions.R | 14 +- inst/develo/dockerCelia/runDockerApp.R | 2 +- inst/develo/dockerImage/runDockerApp.R | 2 +- inst/develo/params-tests.R | 8 +- inst/develo/startSchnapps.R | 2 +- 15 files changed, 198 insertions(+), 100 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4d9c7e17..0b203383 100755 --- 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.17 +Version: 1.15.18 Authors@R: c(person("Bernd", "Jagla", role = c("aut", "cre"), email = "bernd.jagla@pasteur.fr", comment = c(ORCID = "0000-0002-7696-0484"))) Maintainer: Bernd Jagla 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/README.md b/README.md index 4c004988..49459ba0 100755 --- a/README.md +++ b/README.md @@ -22,10 +22,11 @@ Windows: MAC: - 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 diff --git a/inst/app/contributions/DE_DataExploration/parameters.R b/inst/app/contributions/DE_DataExploration/parameters.R index fedad491..ba9a230d 100644 --- a/inst/app/contributions/DE_DataExploration/parameters.R +++ b/inst/app/contributions/DE_DataExploration/parameters.R @@ -19,15 +19,15 @@ myNormalizationChoices <- list( myNormalizationParameters <- list( DE_logNormalization = tagList( sc_numericInput("DE_logNormalization_sf", - label = "scale by (0 => minvalue)", - min = 0, max = 200000, step = 1, value = defaultValue("DE_logNormalization_sf", 0) + label = "scale by (0 => minvalue)", + min = 0, max = 200000, step = 1, value = defaultValue("DE_logNormalization_sf", 0) ) - ), + ), DE_scaterNormalization = h5("no Parameters implemented"), DE_seuratSCTnorm = tagList( sc_numericInput("DE_seuratSCTnorm_nHVG", - label = "Number of variable genes", - min = 10, max = 200000, step = 1, value = 3000 + label = "Number of variable genes", + min = 10, max = 200000, step = 1, value = 3000 ), sc_selectInput( "DE_seuratSCTnorm_var2reg", @@ -42,8 +42,8 @@ myNormalizationParameters <- list( ), DE_seuratLogNorm = tagList( sc_numericInput("DE_seuratLogNorm_nHVG", - label = "Number of variable genes", - min = 10, max = 200000, step = 1, value = 3000 + label = "Number of variable genes", + min = 10, max = 200000, step = 1, value = 3000 ), sc_selectInput( "DE_seuratLogNorm_var2reg", @@ -59,23 +59,23 @@ myNormalizationParameters <- list( DE_logGeneNormalization = sc_textInput(inputId = "DE_geneIds_norm", label = "comma separated list of genes used for normalization", value = ""), DE_seuratStandard = tagList( sc_numericInput("DE_seuratStandard_dims", - label = "Which dimensions to use from the CCA to specify the neighbor search space", - min = 2, max = 20000, step = 1, value = 30 + label = "Which dimensions to use from the CCA to specify the neighbor search space", + min = 2, max = 20000, step = 1, value = 30 ), sc_numericInput("DE_seuratStandard_anchorF", - label = "select the provided number of features to be used in anchor finding", - min = 60, max = 30000, step = 10, - value = 2000 + label = "select the provided number of features to be used in anchor finding", + min = 60, max = 30000, step = 10, + value = 2000 ), sc_numericInput("DE_seuratStandard_kF", - label = "How many neighbors (k) to use when filtering anchors", - min = 2, max = 3000, step = 1, - value = 200 + label = "How many neighbors (k) to use when filtering anchors", + min = 2, max = 3000, step = 1, + value = 200 ), sc_numericInput("DE_seuratStandard_k.weight", - label = "Number of neighbors to consider when weighting", - min = 2, max = 3000, step = 1, - value = 100 + label = "Number of neighbors to consider when weighting", + min = 2, max = 3000, step = 1, + value = 100 ), sc_selectInput( "DE_seuratStandard_splitby", @@ -89,8 +89,8 @@ myNormalizationParameters <- list( ), DE_seuratSCtransform = tagList( sc_numericInput("DE_seuratSCtransform_nhvg", - label = "number of highly variable genes", - min = 200, max = 400000, step = 10, value = 3000 + label = "number of highly variable genes", + min = 200, max = 400000, step = 10, value = 3000 ), sc_selectInput( "DE_seuratSCtransform_vars2regress", @@ -103,31 +103,31 @@ myNormalizationParameters <- list( # options = list(maxItems = 20) ), sc_numericInput("DE_seuratSCtransform_dimsMin", - label = "minimum dimension (PCA) to use", - min = 1, max = 100, step = 1, value = 1 + label = "minimum dimension (PCA) to use", + min = 1, max = 100, step = 1, value = 1 ), sc_numericInput("DE_seuratSCtransform_dimsMax", - label = "maximum dimension (PCA) to use", - min = 3, max = 100, step = 1, value = 30 + label = "maximum dimension (PCA) to use", + min = 3, max = 100, step = 1, value = 30 ), sc_numericInput("DE_seuratSCtransform_nfeatures", - label = "number of genes to keep for the integration step", - min = 200, max = 400000, step = 10, value = 3000 + label = "number of genes to keep for the integration step", + min = 200, max = 400000, step = 10, value = 3000 ), sc_numericInput("DE_seuratSCtransform_k.anchor", - label = "Number of anchors to use", - min = 1, max = 100, step = 1, - value = 5 + label = "Number of anchors to use", + min = 1, max = 100, step = 1, + value = 5 ), sc_numericInput("DE_seuratSCtransform_k.filter", - label = "How many neighbors (k) to use when filtering anchors, should be smaller than the lowest number of cells per sample", - min = 1, max = 1000, step = 10, - value = 200 + label = "How many neighbors (k) to use when filtering anchors, should be smaller than the lowest number of cells per sample", + min = 1, max = 1000, step = 10, + value = 200 ), sc_numericInput("DE_seuratSCtransform_k.score", - label = "k score", - min = 1, max = 1000, step = 1, - value = 30 + label = "k score", + min = 1, max = 1000, step = 1, + value = 30 ), # sc_numericInput("DE_seuratSCtransform_scalingFactor", # label = "Scaling to use for transformed data", @@ -148,13 +148,13 @@ myNormalizationParameters <- list( ), DE_seuratRefBased = tagList( sc_numericInput("DE_seuratRefBased_nfeatures", - label = "Number of features to retain/use", - min = 200, max = 20000, step = 10, value = 3000 + label = "Number of features to retain/use", + min = 200, max = 20000, step = 10, value = 3000 ), sc_numericInput("DE_seuratRefBased_k.filter", - label = "How many neighbors (k) to use when filtering anchors, should be smaller than the lowest number of cells per sample", - min = 60, max = 30000, step = 10, - value = 200 + label = "How many neighbors (k) to use when filtering anchors, should be smaller than the lowest number of cells per sample", + min = 60, max = 30000, step = 10, + value = 200 ), # sc_numericInput("DE_seuratRefBased_scaleFactor", # label = "Scaling to use for transformed data", @@ -198,9 +198,9 @@ DE_seuratRefBasedFunc <- function(scEx, scExMat, nfeatures = 3000, k.filter = 10 # not sure that NA would be a good solution # so we are asking to remove the cells manually if (sum(limitCells) < ncol(scEx)) { - errStr = paste("please remove the following cells:\n", + errStr = paste("\n\nplease remove the following cells:\n", paste(colnames(scEx)[!limitCells], - collapse = ", ")) + collapse = ", "),"\n\n") cat (file = stderr(), errStr) if (!is.null(getDefaultReactiveDomain())) { showNotification(errStr, id = "DE_seuratError", duration = NULL, type = "error") @@ -215,6 +215,12 @@ DE_seuratRefBasedFunc <- function(scEx, scExMat, nfeatures = 3000, k.filter = 10 counts = scExMat, meta.data = meta.data ) + rownameMap = tibble("scExName" = rownames(scExMat), "seurName" = str_replace_all(rownames(scExMat),"_","-")) + if(!all(rownameMap$seurName == rownames(seurDat))){ + cat(file = stderr(), paste("\n\n!!!Error during Seurat normalization:\nrownames not equal\n\n\n")) + return(NULL) + } + seur.list <- SplitObject(seurDat, split.by = splitby) # for (i in 1:length(seur.list)) { # seur.list[[i]] <- SCTransform(seur.list[[i]], verbose = TRUE) @@ -265,7 +271,8 @@ DE_seuratRefBasedFunc <- function(scEx, scExMat, nfeatures = 3000, k.filter = 10 k.weight = min(100, min(unlist(lapply(seur.list, ncol)))) ) # return matrix object!!! - integrated[["integrated"]]$scale.data %>% as.matrix() + LayerData(GetAssay(seurDat),"scale.data") %>% as.matrix() + # integrated[["integrated"]]$scale.data %>% as.matrix() } else { seur.list[[1]][["SCT"]]$scale.data %>% as.matrix() } @@ -287,9 +294,11 @@ DE_seuratRefBasedFunc <- function(scEx, scExMat, nfeatures = 3000, k.filter = 10 return(NULL) } ) - if (is.null(A)) { + if (is.null(A) || nrow(A)<2 || ncol(A)<2) { return(NULL) } + rownames(A) = (rownameMap[match(rownames(A), rownameMap$seurName),"scExName"] %>% as.vector())[[1]] + scEx_bcnorm <- SingleCellExperiment( assay = list(logcounts = as(A, "TsparseMatrix")), colData = colData(scEx)[colnames(A), , drop = FALSE], @@ -399,9 +408,9 @@ DE_seuratSCtransformFunc <- function(scEx, # not sure that NA would be a good solution # so we are asking to remove the cells manually if (sum(limitCells) < ncol(scEx)) { - errStr = paste("please remove the following cells:\n", + errStr = paste("\n\nplease remove the following cells:\n", paste(colnames(scEx)[!limitCells], - collapse = ", ")) + collapse = ", "),"\n\n") cat (file = stderr(), errStr) if (!is.null(getDefaultReactiveDomain())) { showNotification(errStr, id = "DE_seuratError", duration = NULL, type = "error") @@ -411,13 +420,18 @@ DE_seuratSCtransformFunc <- function(scEx, # scEx = scEx[, limitCells] # meta.data = meta.data[limitCells,, drop = FALSE] } - if(vars2regress %in% names(colData(scEx))){ - meta.data[,vars2regress] = colData(scEx)[,vars2regress] + if(all(vars2regress %in% names(colData(scEx)))){ + meta.data = cbind(meta.data ,colData(scEx)[,c(vars2regress)]) } seurDat <- CreateSeuratObject( counts = scExMat, meta.data = meta.data ) + rownameMap = tibble("scExName" = rownames(scExMat), "seurName" = str_replace_all(rownames(scExMat),"_","-")) + if(!all(rownameMap$seurName == rownames(seurDat))){ + cat(file = stderr(), paste("\n\n!!!Error during Seurat normalization:\nrownames not equal\n\n\n")) + return(NULL) + } seur.list <- SplitObject(seurDat, split.by = splitby) seur.list <- lapply(seur.list, FUN = function(x) SCTransform(object = x, @@ -461,7 +475,8 @@ DE_seuratSCtransformFunc <- function(scEx, verbose = DEBUG, k.weight = min(100, min(unlist(lapply(seur.list, ncol)))) ) - integrated@assays$integrated@scale.data + LayerData(GetAssay(seurDat),"scale.data") %>% as.matrix() + # integrated@assays$integrated@scale.data } else { seur.list[[1]]@assays$SCT@scale.data } @@ -483,10 +498,12 @@ DE_seuratSCtransformFunc <- function(scEx, # FeaturePlot(integrated, c("CCR7", "S100A4", "GZMB", "GZMK", "GZMH")) - if (is.null(A)) { + if (is.null(A) || nrow(A)<2 || ncol(A)<2) { return(NULL) } A=as.matrix(A) + rownames(A) = (rownameMap[match(rownames(A), rownameMap$seurName),"scExName"] %>% as.vector())[[1]] + scEx_bcnorm <- SingleCellExperiment( assay = list(logcounts = as(A, "TsparseMatrix")), colData = colData(scEx)[colnames(A), , drop = FALSE], @@ -600,9 +617,9 @@ DE_seuratStandardfunc <- function(scEx, scExMat, dims = 10, anchorsF = 2000, kF # not sure that NA would be a good solution # so we are asking to remove the cells manually if (sum(limitCells) < ncol(scEx)) { - errStr = paste("please remove the following cells:\n", + errStr = paste("\n\nplease remove the following cells:\n", paste(colnames(scEx)[!limitCells], - collapse = ", ")) + collapse = ", "),"\n\n") cat (file = stderr(), errStr) if (!is.null(getDefaultReactiveDomain())) { showNotification(errStr, id = "DE_seuratError", duration = NULL, type = "error") @@ -619,14 +636,20 @@ DE_seuratStandardfunc <- function(scEx, scExMat, dims = 10, anchorsF = 2000, kF counts = assay(scEx, "counts"), meta.data = meta.data ) + rownameMap = tibble("scExName" = rownames(scExMat), "seurName" = str_replace_all(rownames(scExMat),"_","-")) + if(!all(rownameMap$seurName == rownames(seurDat))){ + cat(file = stderr(), paste("\n\n!!!Error during Seurat normalization:\nrownames not equal\n\n\n")) + return(NULL) + } + seur.list <- Seurat::SplitObject(seurDat, split.by = splitby) seur.list <- lapply(seur.list, FUN = function(x) { # parallel # plan("multiprocess", workers = 4) x <- Seurat::NormalizeData(x, verbose = DEBUG) x <- Seurat::FindVariableFeatures(x, - selection.method = "vst", - nfeatures = 2000, verbose = DEBUG + selection.method = "vst", + nfeatures = 2000, verbose = DEBUG ) } ) @@ -653,6 +676,7 @@ DE_seuratStandardfunc <- function(scEx, scExMat, dims = 10, anchorsF = 2000, kF integrated <- Seurat::ScaleData(integrated, verbose = DEBUG) integrated[["integrated"]]["scale.data"] + } else { seur.list[[1]][["RNA"]]$counts } @@ -664,10 +688,12 @@ DE_seuratStandardfunc <- function(scEx, scExMat, dims = 10, anchorsF = 2000, kF return(NULL) } ) - if (is.null(A)) { + if (is.null(A) || nrow(A)<2 || ncol(A)<2) { return(NULL) } - A <- as.matrix(A) + # A <- as.matrix(A) + # A <- seurDat[["SCT"]]@scale.data %>% as.matrix() + A <- LayerData(GetAssay(seurDat),"scale.data") %>% as.matrix() scEx_bcnorm <- SingleCellExperiment( assay = list(logcounts = as(A, "TsparseMatrix")), colData = colData(scEx)[colnames(A), , drop = FALSE], @@ -767,7 +793,7 @@ DE_seuratSCTnorm <- reactive({ runThis <- DE_seuratSCTnormButton() nHVG = isolate(input$DE_seuratSCTnorm_nHVG) var2reg = isolate(input$DE_seuratSCTnorm_var2reg) - + # if (length(var2reg)<1) if (is.null(scEx) | runThis == "") { if (DEBUG) { @@ -815,19 +841,19 @@ DE_seuratSCTnormfunc <- function(scEx, scExMat, nHVG, var2reg) { if (is.null(var2reg)) { var2reg = NULL meta.data <- as.data.frame(cellMeta[, "sampleNames", drop = FALSE]) - } else if(var2reg == "" ) { + } else if(length(var2reg) == 1 && var2reg == "" ) { var2reg = NULL meta.data <- as.data.frame(cellMeta[, "sampleNames", drop = FALSE]) } else { - meta.data <- as.data.frame(cellMeta[, var2reg, drop = FALSE]) + meta.data <- as.data.frame(cellMeta[, c(var2reg), drop = FALSE]) limitCells = meta.data[,1] %in% levels(meta.data[,1])[table(meta.data[,1]) > 30] # we cannot remove cell here because this would change scEX and projections # not sure that NA would be a good solution # so we are asking to remove the cells manually if (sum(limitCells) < ncol(scEx)) { - errStr = paste("please remove the following cells:\n", + errStr = paste("\n\nplease remove the following cells:\n", paste(colnames(scEx)[!limitCells], - collapse = ", ")) + collapse = ", "),"\n\n") cat (file = stderr(), errStr) if (!is.null(getDefaultReactiveDomain())) { showNotification(errStr, id = "DE_seuratError", duration = NULL, type = "error") @@ -850,6 +876,11 @@ DE_seuratSCTnormfunc <- function(scEx, scExMat, nHVG, var2reg) { return(NULL) } ) + rownameMap = tibble("scExName" = rownames(scExMat), "seurName" = str_replace_all(rownames(scExMat),"_","-")) + if(!all(rownameMap$seurName == rownames(seurDat))){ + cat(file = stderr(), paste("\n\n!!!Error during Seurat normalization:\nrownames not equal\n\n\n")) + return(NULL) + } # UMI-based normalisation & logTransformation # browser() # parallel @@ -863,7 +894,11 @@ DE_seuratSCTnormfunc <- function(scEx, scExMat, nHVG, var2reg) { verbose = DEBUG) - A <- seurDat[["SCT"]]@scale.data %>% as.matrix() + A <- GetAssay(seurDat)@scale.data %>% as.matrix() + if(is.null(A) || nrow(A)<2 || ncol(A)<2){ + return(NULL) + } + rownames(A) = (rownameMap[match(rownames(A), rownameMap$seurName),"scExName"] %>% as.vector())[[1]] scEx_bcnorm <- SingleCellExperiment( assay = list(logcounts = as(A, "TsparseMatrix")), colData = colData(scEx)[colnames(A), , drop = FALSE], @@ -960,19 +995,19 @@ DE_seuratLogNormfunc <- function(scEx, scExMat, nHVG, var2reg) { var2reg = NULL meta.data <- as.data.frame(cellMeta[, "sampleNames", drop = FALSE]) - } else if(var2reg == "" ) { + } else if((length(var2reg) == 1 && var2reg == "" )) { var2reg = NULL meta.data <- as.data.frame(cellMeta[, "sampleNames", drop = FALSE]) } else { - meta.data <- as.data.frame(cellMeta[, var2reg, drop = FALSE]) + meta.data <- as.data.frame(cellMeta[, c(var2reg), drop = FALSE]) limitCells = meta.data[,1] %in% levels(meta.data[,1])[table(meta.data[,1]) > 30] # we cannot remove cell here because this would change scEX and projections # not sure that NA would be a good solution # so we are asking to remove the cells manually if (sum(limitCells) < ncol(scEx)) { - errStr = paste("please remove the following cells:\n", + errStr = paste("\n\nplease remove the following cells:\n", paste(colnames(scEx)[!limitCells], - collapse = ", ")) + collapse = ", "),"\n\n") cat (file = stderr(), errStr) if (!is.null(getDefaultReactiveDomain())) { showNotification(errStr, id = "DE_seuratError", duration = NULL, type = "error") @@ -983,7 +1018,7 @@ DE_seuratLogNormfunc <- function(scEx, scExMat, nHVG, var2reg) { # scEx = scEx[, limitCells] # meta.data = meta.data[limitCells,, drop = FALSE] } - + seurDat <- tryCatch( { seurDat <- CreateSeuratObject( @@ -996,6 +1031,12 @@ DE_seuratLogNormfunc <- function(scEx, scExMat, nHVG, var2reg) { return(NULL) } ) + rownameMap = tibble("scExName" = rownames(scExMat), "seurName" = str_replace_all(rownames(scExMat),"_","-")) + if(!all(rownameMap$seurName == rownames(seurDat))){ + cat(file = stderr(), paste("\n\n!!!Error during Seurat normalization:\nrownames not equal\n\n\n")) + return(NULL) + } + # UMI-based normalisation & logTransformation # browser() # parallel @@ -1012,7 +1053,12 @@ DE_seuratLogNormfunc <- function(scEx, scExMat, nHVG, var2reg) { seurDat = Seurat::ScaleData(object = seurDat, vars.to.regress = var2reg) - A <- seurDat[["RNA"]]["scale.data"] %>% as.matrix() + A <- LayerData(GetAssay(seurDat),"scale.data") %>% as.matrix() + if(is.null(A) || nrow(A)<2 || ncol(A)<2){ + return(NULL) + } + rownames(A) = (rownameMap[match(rownames(A), rownameMap$seurName),"scExName"] %>% as.vector())[[1]] + scEx_bcnorm <- SingleCellExperiment( assay = list(logcounts = as(A, "TsparseMatrix")), colData = colData(scEx)[colnames(A), , drop = FALSE], @@ -1255,9 +1301,9 @@ DE_logNormalization <- reactive(label = "rlogNorm", { } # cp = load(file="~/SCHNAPPsDebug/DE_logNormalization.RData") if (is.null(sfactor)) { - sfactor = defaultValue("DE_logNormalization_sf", 0) + sfactor = defaultValue("DE_logNormalization_sf", 0) } - + # TODO ?? define scaling factor somewhere else??? # sfactor <- max(max(assays(scEx)[["counts"]]), 1000) retVal <- DE_logNormalizationfunc(scEx, sfactor) diff --git a/inst/app/contributions/coE_coExpression/reactives.R b/inst/app/contributions/coE_coExpression/reactives.R index e0f27653..cf2abb3a 100644 --- a/inst/app/contributions/coE_coExpression/reactives.R +++ b/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({ diff --git a/inst/app/contributions/sCA_subClusterAnalysis/reactives.R b/inst/app/contributions/sCA_subClusterAnalysis/reactives.R index b8f4940c..7cabd0c3 100644 --- a/inst/app/contributions/sCA_subClusterAnalysis/reactives.R +++ b/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)) } diff --git a/inst/app/defaultValues.R b/inst/app/defaultValues.R index c26e8202..35223c12 100644 --- a/inst/app/defaultValues.R +++ b/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)) diff --git a/inst/app/outputs.R b/inst/app/outputs.R index 24208990..61d6641a 100644 --- a/inst/app/outputs.R +++ b/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({ diff --git a/inst/app/reactives.R b/inst/app/reactives.R index 72259fcb..6b9f4bd4 100644 --- a/inst/app/reactives.R +++ b/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 = { diff --git a/inst/app/runDevApp.R b/inst/app/runDevApp.R index 9269eca8..f3914044 100644 --- a/inst/app/runDevApp.R +++ b/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) diff --git a/inst/app/runVMApp.R b/inst/app/runVMApp.R index f221dadd..85a2b8cd 100644 --- a/inst/app/runVMApp.R +++ b/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/" diff --git a/inst/app/serverFunctions.R b/inst/app/serverFunctions.R index 9af29fd2..46c4bb7c 100644 --- a/inst/app/serverFunctions.R +++ b/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())) diff --git a/inst/develo/dockerCelia/runDockerApp.R b/inst/develo/dockerCelia/runDockerApp.R index 0cddcaf8..85f83429 100644 --- a/inst/develo/dockerCelia/runDockerApp.R +++ b/inst/develo/dockerCelia/runDockerApp.R @@ -19,7 +19,7 @@ plan(sequential) library("BiocParallel") -register(MulticoreParam(WORKERS)) +register(safeBPParam(WORKERS)) # register(SerialParam()) localContributionDir = "/root/SCHNAPPsContributions/" diff --git a/inst/develo/dockerImage/runDockerApp.R b/inst/develo/dockerImage/runDockerApp.R index 0cddcaf8..85f83429 100644 --- a/inst/develo/dockerImage/runDockerApp.R +++ b/inst/develo/dockerImage/runDockerApp.R @@ -19,7 +19,7 @@ plan(sequential) library("BiocParallel") -register(MulticoreParam(WORKERS)) +register(safeBPParam(WORKERS)) # register(SerialParam()) localContributionDir = "/root/SCHNAPPsContributions/" diff --git a/inst/develo/params-tests.R b/inst/develo/params-tests.R index fabe8b3a..af8918e3 100644 --- a/inst/develo/params-tests.R +++ b/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 ) diff --git a/inst/develo/startSchnapps.R b/inst/develo/startSchnapps.R index 487ac9f6..1c7f7c8b 100755 --- a/inst/develo/startSchnapps.R +++ b/inst/develo/startSchnapps.R @@ -15,7 +15,7 @@ library(future) plan(sequential) library("BiocParallel") -register(MulticoreParam(6)) +register(safeBPParam(6)) schnapps(DEBUG=T)