update unit tests rev2

.Rbuildignore

@@ -1,2 +1,7 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
+^\.github$
+^docs$
+^Dockerfile$
+^Dockerfiles/.*$
+^Conda_Recipe/.*$

DESCRIPTION

@@ -15,12 +15,16 @@ Description: A set of functions for analyzing single-cell RNA-seq data using the
     and further visualizations and analysis based on user input. This package can
     be run both in a docker container and in user-friendly web-based interactive
     notebooks (NIDAP, Palantir Foundry).
-License: MIT
+License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.3
 Suggests: 
-    testthat (>= 3.0.0)
+    testthat (>= 3.0.0),
+    knitr,
+    rmarkdown,
+    shiny
+VignetteBuilder: knitr
 Depends:
     R (>= 4.0)
 Imports:
@@ -86,4 +90,5 @@ Imports:
     tidyr,
     htmlwidgets,
     scDblFinder
+    , BiocParallel
 Config/testthat/edition: 3

LICENSE

@@ -1,21 +1,2 @@
-MIT License
-
-Copyright (c) 2024 NIDAP Community
-
-Permission is hereby granted, free of charge, to any person obtaining a copy
-of this software and associated documentation files (the "Software"), to deal
-in the Software without restriction, including without limitation the rights
-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-copies of the Software, and to permit persons to whom the Software is
-furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in all
-copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-SOFTWARE.
+YEAR: 2024
+COPYRIGHT HOLDER: NIDAP Community

LICENSE.md

@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2024 NIDAP Community
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+export(aggregateCounts)
 export(annotateCellTypes)
 export(appendMetadataToSeuratObject)
 export(colorByGene)
@@ -40,6 +41,7 @@ import(harmony)
 import(httr)
 import(jsonlite)
 import(parallel)
+import(plotly)
 import(quantmod)
 import(reshape2)
 import(rlang)
@@ -85,12 +87,16 @@ importFrom(dplyr,select)
 importFrom(dplyr,summarise)
 importFrom(ggExtra,ggMarginal)
 importFrom(ggplot2,aes)
+importFrom(ggplot2,coord_fixed)
+importFrom(ggplot2,geom_hline)
 importFrom(ggplot2,geom_point)
 importFrom(ggplot2,geom_vline)
 importFrom(ggplot2,ggplot)
 importFrom(ggplot2,ggtitle)
+importFrom(ggplot2,scale_color_identity)
 importFrom(ggplot2,scale_y_reverse)
 importFrom(ggplot2,theme)
+importFrom(ggplot2,theme_bw)
 importFrom(ggplot2,theme_classic)
 importFrom(ggplot2,xlab)
 importFrom(ggplot2,ylab)
@@ -100,10 +106,12 @@ importFrom(ggpubr,get_legend)
 importFrom(ggpubr,ggarrange)
 importFrom(grDevices,colorRampPalette)
 importFrom(grid,gTree)
+importFrom(grid,gpar)
 importFrom(grid,grid.draw)
 importFrom(grid,grid.newpage)
 importFrom(grid,grobHeight)
 importFrom(grid,textGrob)
+importFrom(grid,unit)
 importFrom(gridExtra,arrangeGrob)
 importFrom(gridExtra,tableGrob)
 importFrom(htmlwidgets,saveWidget)

R/AggregateCounts.R

@@ -38,7 +38,7 @@ aggregateCounts <- function(object,
                                   return.seurat = FALSE,
                                   assay = "SCT",
                                   group.by = var.group,
-                                  slot = slot)[[1]] %>% 
+                                  layer = slot)[[1]] %>% 
                   as.data.frame.matrix() 
 
   pseudobulk$Gene <- rownames(pseudobulk)

R/Color_by_Genes_Automatic.R

@@ -32,12 +32,16 @@
 #' @import ggplot2
 #'
 #' @export
-#' @example Do not run: colorByMarkerTable(object = seurat,
-  #'                                       samples.subset = c("mouse1","mouse2),
-  #'                                       samples.to.display = c("mouse1"),
-  #'                                       marker.table = immuneCellMarkers,
-  #'                                       cells.of.interest = c("CD4","Treg")
-  #'                                       )
+#' @examples
+#' \dontrun{
+#' colorByMarkerTable(
+#'   object = seurat,
+#'   samples.subset = c("mouse1", "mouse2"),
+#'   samples.to.display = c("mouse1"),
+#'   marker.table = immuneCellMarkers,
+#'   cells.of.interest = c("CD4", "Treg")
+#' )
+#' }
 
 #' @return arranged grob of dimension reduction plots colored by individual 
 #'         marker expression

R/Dual_Labeling.R

@@ -48,16 +48,15 @@
 #' @param display.unscaled.values Set to TRUE if you want to view the unscaled
 #' gene/protein expression values (Default is FALSE)
 
-#' @importFrom Seurat
+#' @import Seurat
 #' @importFrom scales rescale
-#' @importFrom gridExtra arrangeGrob
-#' @importFrom grid grid.draw
+#' @importFrom gridExtra arrangeGrob tableGrob
+#' @importFrom grid grid.draw textGrob gpar unit
 #' @importFrom dplyr arrange mutate case_when
 #' @importFrom magrittr %>%
 #' @importFrom stats quantile
-#' @importFrom ggplot2 ggplot geom_point theme_classic xlab ylab geom_vline
+#' @importFrom ggplot2 ggplot geom_point theme_classic xlab ylab geom_vline geom_hline scale_color_identity theme_bw coord_fixed ggtitle aes
 #' @importFrom ggExtra ggMarginal
-#'  geom_hline scale_color_identity theme_bw coord_fixed ggtitle aes
 #'
 #' @export
 #'

R/Harmony.R

@@ -22,11 +22,16 @@
 #' @import ggplot2
 #'   
 #' @export
-#' @example Do not run: harmonyBatchCorrect(object = seurat,
-#'                                          nvar = 2000,
-#'                                          genes.to.add = c("Cd4","Cd8a"),
-#'                                          group.by.var = "Mouse_Origin",
-#'                                          npc = 20)
+#' @examples
+#' \dontrun{
+#' harmonyBatchCorrect(
+#'   object = seurat,
+#'   nvar = 2000,
+#'   genes.to.add = c("Cd4", "Cd8a"),
+#'   group.by.var = "Mouse_Origin",
+#'   npc = 20
+#' )
+#' }
 
 #' @return A list: adj.object with harmony-adjusted gene expression (SCT slot) 
 #'                 adj.tsne: harmonized tSNE plot

R/ModuleScore.R

@@ -71,28 +71,35 @@
 #' @importFrom dplyr select
 #'   
 #' @export
-#' @example Do not run: moduleScore(object = seuratObject,
-#'                                  marker.table = immuneCellMarkers,
-#'                                  celltypes = c("CD4_T","Treg",Monocytes"),
-#'                                  ms_threshold = c("CD4_T 0.1","Treg 0.4", "Monocytes 0.3"),
-#'                                  multi.lvl = FALSE
-#'                                  )
-#'                                  
-#' @example Do not run: moduleScore(object = seuratObject,
-#'                                  marker.table = immuneCellMarkers,
-#'                                  celltypes = c("CD4_T","Treg",Monocytes"),
-#'                                  ms_threshold = c("CD4_T 0.1","Treg 0.4", "Monocytes 0.3"),
-#'                                  general.class = c("CD_T","Monocytes"),
-#'                                  multi.lvl = TRUE,
-#'                                  lvl.df = parentChildTable
-#'                                  )
+#' @examples
+#' \dontrun{
+#' modScore(
+#'   object = seuratObject,
+#'   marker.table = immuneCellMarkers,
+#'   use_columns = c("CD4_T", "Treg", "Monocytes"),
+#'   ms_threshold = c("CD4_T 0.1", "Treg 0.4", "Monocytes 0.3"),
+#'   general.class = c("CD4_T", "Monocytes"),
+#'   multi.lvl = FALSE
+#' )
+#' 
+#' modScore(
+#'   object = seuratObject,
+#'   marker.table = immuneCellMarkers,
+#'   use_columns = c("CD4_T", "Treg", "Monocytes"),
+#'   ms_threshold = c("CD4_T 0.1", "Treg 0.4", "Monocytes 0.3"),
+#'   general.class = c("CD4_T", "Monocytes"),
+#'   multi.lvl = TRUE,
+#'   lvl.df = parentChildTable
+#' )
+#' }
 
 #' @return List containing annotated dimension plot with ModuleScore 
 #'         distribution of cell marker gene, Seurat Object with cell 
 #'         classification metadata
 
 modScore <- function(object, 
                      marker.table, 
+                     group_var = "orig.ident",
                      use_columns,
                      ms_threshold, 
                      general.class, 
@@ -231,7 +238,7 @@ modScore <- function(object,
         umap.pos <- clusmat %>% group_by(clusid) %>% dplyr::summarise(umap1.mean = mean(umap1), umap2.mean = mean(umap2))
         title = as.character(m)
         clusmat <- clusmat %>% dplyr::arrange(clusid)
-        clusid.df <- data.frame(id = object@meta.data$orig.ident, 
+        clusid.df <- data.frame(id = object@meta.data[[group_var]], 
             ModuleScore = object@meta.data[[m]])
 
         g <- ggplot(clusmat, aes(x = umap1, y = umap2)) + theme_bw() + 
@@ -240,7 +247,7 @@ modScore <- function(object,
             1), limits = c(0, 1))) + guides(colour = guide_legend(override.aes = list(size = 5, alpha = 1))) + theme(panel.grid.major = element_blank(), 
             panel.grid.minor = element_blank(), panel.background = element_blank()) + xlab("tsne-1") + ylab("tsne-2")
 
-        g1 <- RidgePlot(object, features = m, group.by = "orig.ident") + 
+        g1 <- RidgePlot(object, features = m, group.by = group_var) + 
             theme(legend.position = "none", title = element_blank(), 
                 axis.text.x = element_text(size = gradient.ft.size)) + 
             geom_vline(xintercept = numeric_threshold[celltype_name], linetype = "dashed", 

R/ModuleScoreApp.R

@@ -0,0 +1,11 @@
+#' Launch the ModuleScore Shiny App
+#'
+#' Opens the interactive app to explore ModuleScores and adjust thresholds.
+#'
+#' @return The result of `shiny::runApp()`
+#' @export
+launch_module_score_app <- function() {
+  appDir <- system.file("shiny/ModuleScoreApp", package = "SCWorkflow")
+  if (appDir == "") stop("Shiny app directory not found in SCWorkflow.")
+  shiny::runApp(appDir, display.mode = "normal")
+}

R/ModuleScoreHelpers.R

@@ -0,0 +1,109 @@
+#' @title Helpers for ModuleScore Shiny app
+#' @description Precompute module scores per celltype and build plots from cached data.
+#' @keywords internal
+#' @importFrom dplyr mutate group_by summarise arrange select
+#' @importFrom ggplot2 ggplot aes theme_bw theme element_blank 
+#' @importFrom geom_point scale_color_gradientn guides guide_legend 
+#' @importFrom xlab ylab element_text geom_violin theme_classic geom_hline 
+#' @importFrom scale_y_continuous geom_line geom_segment scale_y_log10 scale_x_continuous
+#' @importFrom gridExtra arrangeGrob grid textGrob gpar
+NULL
+
+#' @export
+compute_modscore_data <- function(object, marker_list, use_columns,
+                                  reduction = c("tsne","umap","pca"),
+                                  nbins = 10,
+                                  group_var = "orig.ident") {
+  reduction <- match.arg(reduction)
+
+  if (!"Barcode" %in% colnames(object@meta.data)) {
+    object@meta.data$Barcode <- rownames(object@meta.data)
+  }
+  colnames(object@meta.data) <- gsub("orig_ident", "orig.ident", colnames(object@meta.data))
+
+  # Prepare identities and embeddings once
+  idents <- Seurat::Idents(object)
+  emb <- Seurat::Embeddings(object, reduction)
+  if (ncol(emb) < 2) stop("Selected reduction has fewer than 2 dimensions.")
+
+  # Build per-celltype data
+  res <- list()
+  for (celltype_name in use_columns) {
+    genes <- marker_list[[celltype_name]]
+    if (is.null(genes)) next
+
+    object <- Seurat::AddModuleScore(object, list(genes), name = celltype_name, nbin = nbins, assay = "SCT")
+    m <- paste0(celltype_name, "1")
+    object@meta.data[[m]] <- scales::rescale(object@meta.data[[m]], to = c(0, 1))
+
+    clusid <- as.numeric(object@meta.data[[m]])
+    d <- stats::density(clusid)
+
+    # Map embedding columns to names similar to DimPlot
+    colnames_map <- switch(
+      reduction,
+      tsne = c("tSNE_1","tSNE_2"),
+      umap = c("UMAP_1","UMAP_2"),
+      pca  = c("PC_1","PC_2")
+    )
+    coords <- data.frame(
+      ident = as.character(idents),
+      umap1 = emb[, 1],
+      umap2 = emb[, 2],
+      clusid = clusid,
+      check.names = FALSE
+    )
+    colnames(coords)[2:3] <- colnames_map
+
+    coords <- dplyr::mutate(coords, sample_clusid = coords$clusid)
+    coords <- dplyr::arrange(coords, clusid)
+
+    clusid_df <- data.frame(id = object@meta.data[[group_var]],
+                ModuleScore = object@meta.data[[m]],
+                stringsAsFactors = FALSE)
+
+    res[[celltype_name]] <- list(
+      object = object,
+      m = m,
+      coords = coords,
+      clusid_df = clusid_df,
+      density = d
+    )
+  }
+
+  res
+}
+
+#' @export
+build_modscore_plots <- function(object, m, coords, clusid_df, d, threshold,
+                                 gradient_ft_size = 6, violin_ft_size = 6, step_size = 0.1,
+                                 group_var = "orig.ident",
+                                 reduction = c("tsne","umap","pca")) {
+  reduction <- match.arg(reduction)
+
+  g <- ggplot2::ggplot(coords, ggplot2::aes(x = coords[[2]], y = coords[[3]])) +
+    ggplot2::theme_bw() + ggplot2::theme(legend.title = ggplot2::element_blank()) +
+    ggplot2::geom_point(ggplot2::aes(colour = sample_clusid), alpha = 0.5, shape = 20, size = 1) +
+    ggplot2::scale_color_gradientn(colours = c("blue4", "lightgrey", "red"),
+      values = scales::rescale(c(0, threshold/2, threshold, (threshold + 1)/2, 1), limits = c(0, 1))) +
+    ggplot2::guides(colour = ggplot2::guide_legend(override.aes = list(size = 5, alpha = 1))) +
+    ggplot2::theme(panel.grid.major = ggplot2::element_blank(), panel.grid.minor = ggplot2::element_blank(), panel.background = ggplot2::element_blank()) +
+    ggplot2::xlab(if (reduction == "tsne") "tsne-1" else if (reduction == "umap") "umap-1" else "pc-1") +
+    ggplot2::ylab(if (reduction == "tsne") "tsne-2" else if (reduction == "umap") "umap-2" else "pc-2")
+
+  g1 <- Seurat::RidgePlot(object, features = m, group.by = group_var) +
+    ggplot2::theme(legend.position = "none", title = ggplot2::element_blank(), axis.text.x = ggplot2::element_text(size = gradient_ft_size)) +
+    ggplot2::geom_vline(xintercept = threshold, linetype = "dashed", color = "red3") +
+    ggplot2::scale_x_continuous(breaks = seq(0, 1, step_size))
+
+  g3 <- ggplot2::ggplot(data.frame(x = d$x, y = d$y), ggplot2::aes(x, y)) +
+    ggplot2::xlab("ModuleScore") + ggplot2::ylab("Density") + ggplot2::geom_line() +
+    ggplot2::geom_segment(ggplot2::aes(xend = d$x, yend = 0, colour = x)) + ggplot2::scale_y_log10() +
+    ggplot2::scale_color_gradientn(colours = c("blue4", "lightgrey", "red"),
+      values = scales::rescale(c(0, threshold/2, threshold, (threshold + 1)/2, 1), limits = c(0, 1))) +
+    ggplot2::geom_vline(xintercept = threshold, linetype = "dashed", color = "red3") +
+    ggplot2::scale_x_continuous(breaks = seq(0, 1, step_size)) + ggplot2::theme(legend.title = ggplot2::element_blank(), axis.text.x = ggplot2::element_text(size = 6))
+
+  arranged <- gridExtra::arrangeGrob(g, g1, g3, ncol = 2, top = grid::textGrob(m, gp = grid::gpar(fontsize = 14, fontface = "bold")))
+  list(g = g, g1 = g1, g3 = g3, arranged = arranged)
+}