Merge branch 'release/v2.0.8' into main

Author: dputhier

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: scigenex
 Type: Package
 Title: The scigenex package (Single-Cell Informative GENe Explorer)
-Version: 2.0.7
+Version: 2.0.8
 Date: 2020-07-22
 Author: J. Bavais, Sebastien Nin, Lionel Spinelli and Denis Puthier
 Maintainer: J. Bavais <julie.bavais@yahoo.fr>

Makefile

@@ -1,5 +1,5 @@
 MAKEFILE=Makefile
-VERSION=2.0.7
+VERSION=2.0.8
 
 .PHONY: help
 

NAMESPACE

@@ -116,6 +116,7 @@ importFrom(Matrix,colSums)
 importFrom(Matrix,rowSums)
 importFrom(Matrix,t)
 importFrom(Seurat,AddModuleScore)
+importFrom(Seurat,Assays)
 importFrom(Seurat,DimPlot)
 importFrom(Seurat,FeaturePlot)
 importFrom(Seurat,NoAxes)

R/ClusterSet_class.R

@@ -306,7 +306,7 @@ setMethod("[", signature(x = "ClusterSet"),
               }
             } else {
               if (missing(i)) {
-                n_data <- x@data[, j]
+                n_data <- x@data[, j, drop = FALSE]
                 n_gene_clusters <- x@gene_clusters
                 n_top_genes <- x@top_genes
                 n_gene_clusters_metadata <- x@gene_clusters_metadata
@@ -909,7 +909,7 @@ setGeneric("subsample_by_ident",
 #' @param object a ClusterSet object.
 #' @param ident A named vector. Names are cell/column names, values are classes/identity. 
 #' Typically the result of the Seurat::Ident() function.
-#' @param nbcell The number of cell to select.
+#' @param nbcell The number of cell to select per population (cell identity).
 #' @param seed A seed for subsampling.
 #' @export
 #' @examples
@@ -927,7 +927,7 @@ setMethod("subsample_by_ident",
           signature("ClusterSet"), 
           function(object, 
                    ident=NULL, 
-                   nbcell=TRUE,
+                   nbcell=1e6,
                    seed=123) {
 
 

R/convert.R

@@ -1,57 +1,120 @@
 #' @title Transform a Seurat objects / FindAllMarkers result into a ClusterSet.
 #' @description Transform a Seurat objects into a ClusterSet.
 #' @param object A Seurat object.
-#' @param markers A Seurat::FindAllMarkers() result or a named vector (clusters with gene_names as named).
+#' @param markers A Seurat::FindAllMarkers() result or a named vector (clusters with gene_names as named). 
+#' Named vectors can contains several position with the same gene name (overlapping clusters).
 #' @param layer One of 'data', 'counts' or 'scale.data'. The slot to extract from the seurat object to perform clustering analysis.
 #' SCT is the recommended method from Seurat package when working with spatial transcriptomics data.
 #' @param assay The type of assay (e.g. "RNA", "Spatial", "Sketch", "SCT"...).
+#' @param p_val_adj If markers is the output from Seurat::FindAllMarkers(), the adjusted p-value threshold. 
 #' @importFrom SeuratObject LayerData
 #' @importFrom Matrix Matrix
+#' @importFrom Seurat Assays
 #' @examples
 #' ## From a scRNA-seq/Seurat object
 #' library(SeuratObject)
 #' library(Seurat)
 #' data("pbmc_small", package="SeuratObject")
-#' cs <- cluster_set_from_seurat(pbmc_small, Seurat::FindAllMarkers(pbmc_small))
+#' markers <- Seurat::FindAllMarkers(pbmc_small, only.pos = TRUE)
+#' cs <- cluster_set_from_seurat(pbmc_small, markers)
+#' cs <- top_genes(cs)
 #' plot_heatmap(cs)
 #' plot_heatmap(cs)
-#' plot_heatmap(cs[1,])
+#' plot_heatmap(cs[2, ])
 #' plot_heatmap(cs, cell_clusters = Seurat::Idents(pbmc_small))
 #' plot_heatmap(cs[1,Idents(pbmc_small) == "0"], 
-#'              cell_clusters = Seurat::Idents(pbmc_small), label_size = 6)
+#' cell_clusters = Seurat::Idents(pbmc_small), label_size = 6)
 #' plot_profiles(cs, ident = Seurat::Idents(pbmc_small))
 #' @export
 cluster_set_from_seurat <- function(object=NULL, 
                                     markers=NULL,
                                     layer=c('data', 'counts', 'scale.data'),
-                                    assay='RNA'){
+                                    assay='RNA',
+                                    p_val_adj=0.001){
 
+  print_msg("Converting a Seurat object from cluster_set...", msg_type = "DEBUG")
+  
+  if(is.null(object) | !inherits(object, "Seurat"))
+    print_msg("The 'object' argument should be a Seurat object.", msg_type="STOP")
+  
+  if(is.null(markers))
+    print_msg("Please provide a set of markers/clusters...", msg_type="STOP")
+  
+  if(is.factor(markers))
+    markers <- as.character(markers)
+    
+  print_msg(paste0("This seurat object contains the following assay : ", 
+                   Seurat::Assays(object), ".")  , msg_type = "INFO")
+
+  if(!assay %in% Seurat::Assays(object)){
+    print_msg("The selected assay is not available. See 'assay' argument...", msg_type="STOP")
+  }
+   
   layer <- match.arg(layer)
 
   object <- SeuratObject::LayerData(object, assay=assay, layer=layer)
 
   if(inherits(markers, "data.frame")){
 
-    gn <- markers$gene
-    clusters <- markers$cluster
+    print_msg("Selecting  markers based on p_val_adj...", msg_type = "DEBUG")
+    markers <- markers[markers$p_val_adj <= p_val_adj, , drop=FALSE]
+    object <- object[markers$gene, , drop = FALSE]
+    print_msg("Disambiguating gene duplicates using '~' separator", msg_type = "DEBUG")
+    gn <- make.unique(markers$gene, sep = "~")
+  
+    clusters <- as.character(markers$cluster)
     names(clusters) <- gn
-    object <- object[markers$gene, ]
-    
+
   }else if(is.vector(markers)){
     if(is.null(names(markers)))
       print_msg("The 'markers' argument should be a named vector.",
                 msg_type="STOP")
+    object <- object[names(markers), , drop = FALSE]
     clusters <- markers
+    names(clusters) <- make.unique(names(clusters), sep = "~")
+    gn <- names(clusters)
+    
   }else{
     print_msg("The 'markers' argument should be a data.frame or named vector.",
               msg_type="STOP")
   }
+
+  if(length(grep("~", gn))){
+    print_msg("There are duplicated gene names, handling them...", msg_type = "DEBUG")
+    gn_non_dup <- gn[-grep("~[0-9]+$", gn)]
+    
+    tmp_mat <-  object[gn_non_dup, ]
+    
+    gn_dup <- gn[grep("~[0-9]+$", gn)]
+    max_dup <- max(as.numeric(sub(".*~([0-9]+)$", "\\1", gn_dup)))
+  
+    print_msg(paste0("The maximum number of duplicates for one gene is : ", max_dup, "."), msg_type = "DEBUG")
+    
+    for(i in 1:max_dup){
+      print_msg(paste0("Looping though duplicate : ", i, "."), msg_type = "DEBUG")
+      gn_dup_i <- gn_dup[grep(paste0("~", i, "$"), gn_dup)]
+      
+      if(length(gn_dup_i) > 0){
+        print_msg(paste0("Adding ", length(gn_dup_i), " genes to the matrix."), msg_type = "DEBUG")
+        to_select <- gsub(gn_dup_i, pattern = "~[0-9]+$", replacement = "")
+        print_msg("Subsetting...", msg_type = "DEBUG")
+        sub_mat <- object[to_select, , drop = FALSE]
+        rownames(sub_mat) <- gn_dup_i
+        print_msg("Binding...", msg_type = "DEBUG")
+        tmp_mat <- rbind(tmp_mat, sub_mat)
+      }
+      
+    }  
+    
+    object <- tmp_mat
+  }
 
   gn <- split(names(clusters), clusters)
 
   obj_out <- new(Class = "ClusterSet")
   obj_out@gene_clusters <- gn
-  obj_out@data <- Matrix::Matrix(object, sparse = TRUE)
+  
+  obj_out@data <- object
   obj_out@gene_clusters_metadata <- list("cluster_id" = setNames(as.character(unique(clusters)), 
                                                                  as.character(unique(clusters))),
                                           "number" = length(table(clusters)),
@@ -72,6 +135,8 @@ cluster_set_from_seurat <- function(object=NULL,
                          "all_gene_expression_matrix" = vector(),
                          "all_neighbor_distances" = vector())
 
+  obj_out <- compute_centers(obj_out)
+  
   return(obj_out)
 }
 
@@ -100,8 +165,7 @@ cluster_set_from_matrix <- function(object=NULL,
     print_msg("The 'object' argument should be a data.frame or matrix.",
               msg_type="STOP")
   }
-  
- 
+
   if(!inherits(markers, "list")){
     print_msg("The 'marker' argument should be a list.",
               msg_type="STOP")
@@ -114,7 +178,7 @@ cluster_set_from_matrix <- function(object=NULL,
     print_msg("No marker were found in the matrix.")
     return(new(Class = "ClusterSet"))
   }
-  
+
   print_msg("Subsetting object.", msg_type = "INFO")
   object <- object[marker_found, ]
 

R/gm_report.R

@@ -34,6 +34,8 @@
 #' @param SpatialFeaturePlot_params Some parameters for Seurat::SpatialFeaturePlot() function.
 #' @param SpatialDimPlot_params Some parameters for Seurat::SpatialDimPlot() function.
 #' @param plot_ggheatmap_params Some parameters for plot_ggheatmap() function.
+#' @param subsample_by_ident_params The number of cell to take per cell type when subsampling the data for plotting interactive heatmap.
+#' Reduce this number if you have a large dataset (e.g. > 10000 cells/spots). Otherwise the dataset will be too large to be handled by the web browser.
 #' @param plot_heatmap_params Some parameters for plot_heatmap() function.
 #' @param cnetplot_params Some parameters for enrichplot:::cnetplot.enrichResult() function.
 #' @param rm_tmpdir Whether to delete temporary directory.
@@ -58,7 +60,7 @@
 #' set_verbosity(3)
 #' load_example_dataset('7870305/files/lymph_node_tiny_clusters_2')
 #' load_example_dataset('7870305/files/lymph_node_tiny_2')
-#' gm_report(lymph_node_tiny_clusters_2[1:4,], 
+#' gm_report(lymph_node_tiny_clusters_2[1:2,], 
 #'                 lymph_node_tiny_2, 
 #'                 smp_species="Homo sapiens", 
 #'                 smp_region="total", 
@@ -70,6 +72,19 @@
 #'                 is_spatial_exp=TRUE,
 #'                 SpatialFeaturePlot_params=list(pt.size.factor = 3000),
 #'                 SpatialDimPlot_params=list(pt.size.factor = 3000)) # Object was created with an older seurat version
+#' set_verbosity(3)
+#' markers <- Seurat::FindAllMarkers(lymph_node_tiny_2, only.pos = TRUE)
+#' cs <- cluster_set_from_seurat(lymph_node_tiny_2, markers, p_val_adj=0.001, assay="Spatial")
+#' gm_report(cs[1:2,], 
+#'                 lymph_node_tiny_2, 
+#'                 smp_species="Homo sapiens", 
+#'                 smp_region="total", 
+#'                 smp_organ="lymph node", 
+#'                 smp_stage="adult", 
+#'                 annotation_src="CC",
+#'                 is_spatial_exp=TRUE,
+#'                 bioc_org_db="org.Hs.eg.db",
+#'                 api_key=NULL) # Object was created with an older seurat version
 #' @importFrom fs path_home
 #' @importFrom bookdown render_book
 #' @importFrom xaringanExtra use_panelset
@@ -129,7 +144,10 @@ gm_report <- function(cluster_set = NULL,
                             SpatialFeaturePlot_params=list(pt.size.factor = 1.7),
                             SpatialDimPlot_params=list(pt.size.factor = 1.7),
                             plot_ggheatmap_params=list(use_top_genes=FALSE, 
-                                                       hide_gene_name=TRUE),
+                                                       hide_gene_name=TRUE,
+                                                       xlab = "Cells/Spots",
+                                                       ylab="Genes"),
+                            subsample_by_ident_params=list(nbcell=200),
                             plot_heatmap_params=list(link="complete", 
                                                      use_top_genes=FALSE,
                                                      interactive=TRUE,
@@ -149,6 +167,8 @@ gm_report <- function(cluster_set = NULL,
                                       "exp_genes",
                                       "exp_heatmap",
                                       "exp_dimplot",
+                                      "exp_metrics",
+                                      "exp_pop",
                                       "exp_spatial_dist",
                                       "exp_spatial_dimplot",
                                       "exp_mean_1",
@@ -230,12 +250,12 @@ gm_report <- function(cluster_set = NULL,
   }
 
   add_module_score_used_params$object <- seurat_object
-  add_module_score_used_params$features <- cluster_set@gene_clusters
+  add_module_score_used_params$features <- lapply(cluster_set@gene_clusters, gsub, pattern = "~[0-9]+$", replacement = "_")
   add_module_score_used_params$name <- "MOD_"
   seurat_object <- do.call(Seurat::AddModuleScore, add_module_score_used_params)
 
   tmp_dir <- tempdir(check = FALSE)
-  tmp_dir <- paste0(tmp_dir, format(Sys.time(), "%a-%b-%e-%H-%M-%S-%Y"))
+  tmp_dir <- paste0(tmp_dir, gsub(" ", "", format(Sys.time(), "%a-%b-%H-%M-%S-%Y")))
 
   dir.create(tmp_dir, showWarnings = FALSE, recursive = TRUE)
 
@@ -252,7 +272,6 @@ gm_report <- function(cluster_set = NULL,
     print_msg(paste0("The temporary dir contains file: ", tpfile))
   }
 
-  
   print_msg("Computing top genes.", msg_type = "DEBUG")
   cluster_set <- top_genes(cluster_set)
 
@@ -275,7 +294,6 @@ gm_report <- function(cluster_set = NULL,
   }
 
 
- 
   module_rmd <- file.path(tmp_dir, "module.Rmd")
 
   print_msg("Preparing parameters for the report.")

R/plot_profiles.R

@@ -172,7 +172,8 @@ plot_profiles <- function(data = NULL,
       axis.text.y = ggplot2::element_text(size = size_text_y),
       strip.text = ggplot2::element_blank()
     ) +
-    ggplot2::scale_fill_manual(values=color_cluster, name=legend_name)
+    ggplot2::scale_fill_manual(values=color_cluster, name=legend_name) +
+    ggplot2::xlab("Cell Indentity") 
 
 }
 
@@ -297,14 +298,14 @@ plot_multi_profiles <- function(data = NULL,
 
   m <- reshape2::melt(centers_summarized_by_cell_type)
 
-  colnames(m) <- c("Cluster", "Cell_type", "Intensity")
-  m$Cell_type <- factor(m$Cell_type, levels=levels(ident), ordered = TRUE)
+  colnames(m) <- c("Cluster", "Cell_Indentity", "Intensity")
+  m$Cell_Indentity <- factor(m$Cell_Indentity, levels=levels(ident), ordered = TRUE)
   m$Cluster <-   factor(m$Cluster, levels=unique(m$Cluster), ordered = TRUE)
 
   Cluster <- NULL
   ggplot2::ggplot(data= m,
                   ggplot2::aes(
-                    x = .data[["Cell_type"]],
+                    x = .data[["Cell_Indentity"]],
                     y = .data[["Intensity"]],
                     group = Cluster,
                     color = .data[["Cluster"]]