0.33

emosca-cnr · May 6, 2022 · 1cd895c · 1cd895c
1 parent c12e563
commit 1cd895c
Show file tree

Hide file tree

Showing 8 changed files with 50 additions and 56 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
diff --git a/NEWS b/NEWS
@@ -1,3 +1,5 @@
+version 0.33
+- various improvements
 version 0.32
 - add requirement for R>=4.0.0
 - updated the vignette to clarify the installation steps

diff --git a/R/add_partitions.R b/R/add_partitions.R
@@ -7,7 +7,7 @@ add_partitions <- function(partitions_obj=NULL, to_add=NULL){
 
 	ans <- create_partitions_obj(to_add)
 
-	clusterings <- merge(clusterings, ans, by=0, all=T, sort=F)
+	clusterings <- merge(partitions_obj, ans, by=0, all=T, sort=F)
 	rownames(clusterings) <- clusterings[, 1]
 	clusterings[, 1] <- NULL
 

diff --git a/R/assess_cluster_enrichment.R b/R/assess_cluster_enrichment.R
@@ -2,16 +2,9 @@
 #' @param features feature list
 #' @param partitions clustering list
 #' @param meta_clusters boolean, TRUE if the assessment involves meta clusters
-#' @param write_output boolean, TRUE to write the output in the output dir
-#' @param out_dir output dir
 #' @export
-#' @importFrom utils write.table
 
-assess_cluster_enrichment <- function(features, partitions, meta_clusters=FALSE, write_output=TRUE, out_dir="./"){
-
-  if(!dir.exists(out_dir)){
-    dir.create(out_dir, recursive=TRUE)
-  }
+assess_cluster_enrichment <- function(features, partitions, meta_clusters=FALSE){
 
   X_fact <- as.matrix(features$df[, features$type=="factor", drop=F])
   X_num <- as.matrix(features$df[, !features$type=="factor", drop=F])

diff --git a/R/extract_cluster_enrichment_tags.R b/R/extract_cluster_enrichment_tags.R
@@ -11,7 +11,7 @@
 #' @param c_sort_desc sorting in decreasing order or ORA
 #' @export
 
-extract_cluster_enrichment_tags <- function(clust_enrich_res, q_selection_criterion="FDRq", q_selection_threshold=0.1, q_sort_crit="nes", q_sort_desc=FALSE, only_pos_nes=TRUE, c_selection_criterion="p_adj", c_selection_threshold=0.1, c_sort_crit="p", c_sort_desc=FALSE){
+extract_cluster_enrichment_tags <- function(clust_enrich_res, q_selection_criterion="FDRq", q_selection_threshold=0.1, q_sort_crit="nes", q_sort_desc=TRUE, only_pos_nes=TRUE, c_selection_criterion="p_adj", c_selection_threshold=0.1, c_sort_crit="p", c_sort_desc=FALSE){
 
 
   ans <- vector("list", 2)
@@ -20,7 +20,7 @@ extract_cluster_enrichment_tags <- function(clust_enrich_res, q_selection_criter
   en_table_sel <- extract_cluster_enrichment_table(clust_enrich_res, q_type=q_selection_criterion, c_type=c_selection_criterion)
   en_table_sort <- extract_cluster_enrichment_table(clust_enrich_res, q_type=q_sort_crit, c_type=c_sort_crit)
 
-  if(only_pos_nes & q_sort_crit=="nes"){
+  if(only_pos_nes & q_sort_crit=="nes" & length(en_table_sort$cluster_gsea_table) > 0){
     for(i in 1:length(en_table_sort$cluster_gsea_table)){
       idx_pos_nes <- en_table_sort$cluster_gsea_table[[i]] < 0
       en_table_sort$cluster_gsea_table[[i]][idx_pos_nes] <- 0 #negative nes ->0
@@ -29,48 +29,57 @@ extract_cluster_enrichment_tags <- function(clust_enrich_res, q_selection_criter
   }
 
   #selection of per-cluster tags
-  en_table_sel$cluster_gsea_table <- lapply( en_table_sel$cluster_gsea_table, function(x) apply(x, 1, function(y) colnames(x)[y<q_selection_threshold]))
-
-  #order
-  for(i in 1:length(en_table_sort$cluster_gsea_table)){#clusterings
-    n_clust <- length(en_table_sel$cluster_gsea_table[[i]])
-    en_table_sort$cluster_gsea_table[[i]] <- split(t(apply(en_table_sort$cluster_gsea_table[[i]], 1, function(x) colnames(en_table_sort$cluster_gsea_table[[i]])[order(abs(x), decreasing = q_sort_desc)])), 1:n_clust)
-  }
-
-  #keep only those selected
-  for(i in 1:length(en_table_sort$cluster_gsea_table)){#clusterings
-    for(j in 1:length(en_table_sort$cluster_gsea_table[[i]])){#clusterings
-      en_table_sort$cluster_gsea_table[[i]][[j]] <- en_table_sort$cluster_gsea_table[[i]][[j]][en_table_sort$cluster_gsea_table[[i]][[j]] %in% en_table_sel$cluster_gsea_table[[i]][[j]]]
+  if(length(en_table_sort$cluster_gsea_table) > 0){
+
+    en_table_sel$cluster_gsea_table <- lapply( en_table_sel$cluster_gsea_table, function(x) apply(x, 1, function(y) colnames(x)[y<q_selection_threshold]))
+
+    #order
+    for(i in 1:length(en_table_sort$cluster_gsea_table)){#clusterings
+
+      cluster_id <- names(en_table_sel$cluster_gsea_table[[i]])
+      en_table_sort$cluster_gsea_table[[i]] <- split(t(apply(en_table_sort$cluster_gsea_table[[i]], 1, function(x) colnames(en_table_sort$cluster_gsea_table[[i]])[order(abs(x), decreasing = q_sort_desc)])), cluster_id)
+    }
+
+    #keep only those selected
+    for(i in 1:length(en_table_sort$cluster_gsea_table)){#clusterings
+      for(j in 1:length(en_table_sort$cluster_gsea_table[[i]])){#clusterings
+        en_table_sort$cluster_gsea_table[[i]][[j]] <- en_table_sort$cluster_gsea_table[[i]][[j]][en_table_sort$cluster_gsea_table[[i]][[j]] %in% en_table_sel$cluster_gsea_table[[i]][[j]]]
+      }
     }
+
+    ans$cluster_gsea_tags <- en_table_sort$cluster_gsea_table
+
   }
 
-  ans$cluster_gsea_tags <- en_table_sort$cluster_gsea_table
-
   #selection
   en_table_sel$cluster_hyper_table <- lapply( en_table_sel$cluster_hyper_table, function(x) lapply( x, function(y) apply(y, 1, function(z) colnames(y)[z<c_selection_threshold])))
 
   #order
-  for(i in 1:length(en_table_sort$cluster_hyper_table)){#clusterings
-    split_factor <- rownames(en_table_sort$cluster_hyper_table[[i]][[1]])
-    en_table_sort$cluster_hyper_table[[i]] <- lapply(en_table_sort$cluster_hyper_table[[i]], function(x) split(t(apply(x, 1, function(y) colnames(x)[order(abs(y), decreasing = c_sort_desc)])), split_factor))
-  }
-
-  #keep only those selected
-  for(i in 1:length(en_table_sort$cluster_hyper_table)){#clusterings
-    for(j in 1:length(en_table_sort$cluster_hyper_table[[i]])){#features
-      for(k in 1:length(en_table_sort$cluster_hyper_table[[i]][[j]])){#clusters
-        en_table_sort$cluster_hyper_table[[i]][[j]][[k]] <- en_table_sort$cluster_hyper_table[[i]][[j]][[k]][en_table_sort$cluster_hyper_table[[i]][[j]][[k]] %in% en_table_sel$cluster_hyper_table[[i]][[j]][[k]] ]
+  if(length(en_table_sort$cluster_hyper_table) > 0){
+
+    for(i in 1:length(en_table_sort$cluster_hyper_table)){#clusterings
+      split_factor <- rownames(en_table_sort$cluster_hyper_table[[i]][[1]])
+      en_table_sort$cluster_hyper_table[[i]] <- lapply(en_table_sort$cluster_hyper_table[[i]], function(x) split(t(apply(x, 1, function(y) colnames(x)[order(abs(y), decreasing = c_sort_desc)])), split_factor))
+    }
+
+    #keep only those selected
+    for(i in 1:length(en_table_sort$cluster_hyper_table)){#clusterings
+      for(j in 1:length(en_table_sort$cluster_hyper_table[[i]])){#features
+        for(k in 1:length(en_table_sort$cluster_hyper_table[[i]][[j]])){#clusters
+          en_table_sort$cluster_hyper_table[[i]][[j]][[k]] <- en_table_sort$cluster_hyper_table[[i]][[j]][[k]][en_table_sort$cluster_hyper_table[[i]][[j]][[k]] %in% en_table_sel$cluster_hyper_table[[i]][[j]][[k]] ]
+        }
       }
     }
-  }
-  #paste labels
-  for(i in 1:length(en_table_sort$cluster_hyper_table)){#clusterings
-    ans$cluster_hyper_tags[[i]] <- vector("list", length(en_table_sort$cluster_hyper_table[[i]][[1]])) #number of clustersfeatures
-    names(ans$cluster_hyper_tags[[i]]) <- names(en_table_sort$cluster_hyper_table[[i]][[1]])
-    for(j in 1:length(ans$cluster_hyper_tags[[i]])){
-      ans$cluster_hyper_tags[[i]][[j]] <- lapply(en_table_sort$cluster_hyper_table[[i]], function(x) unlist(x[j]))
-      ans$cluster_hyper_tags[[i]][[j]] <- paste(names(ans$cluster_hyper_tags[[i]][[j]]), lapply(ans$cluster_hyper_tags[[i]][[j]], function(x) paste0(x, collapse = "_")))
+    #paste labels
+    for(i in 1:length(en_table_sort$cluster_hyper_table)){#clusterings
+      ans$cluster_hyper_tags[[i]] <- vector("list", length(en_table_sort$cluster_hyper_table[[i]][[1]])) #number of clustersfeatures
+      names(ans$cluster_hyper_tags[[i]]) <- names(en_table_sort$cluster_hyper_table[[i]][[1]])
+      for(j in 1:length(ans$cluster_hyper_tags[[i]])){
+        ans$cluster_hyper_tags[[i]][[j]] <- lapply(en_table_sort$cluster_hyper_table[[i]], function(x) unlist(x[j]))
+        ans$cluster_hyper_tags[[i]][[j]] <- paste(names(ans$cluster_hyper_tags[[i]][[j]]), lapply(ans$cluster_hyper_tags[[i]][[j]], function(x) paste0(x, collapse = "_")))
+      }
     }
+
   }
 
   return(ans)

diff --git a/man/assess_cluster_enrichment.Rd b/man/assess_cluster_enrichment.Rd
diff --git a/man/extract_cluster_enrichment_tags.Rd b/man/extract_cluster_enrichment_tags.Rd
diff --git a/vignettes/scMuffin.Rmd b/vignettes/scMuffin.Rmd
@@ -172,7 +172,7 @@ res_dm <- diff_map(GetAssayData(seu_obj_1), root_cell = "random", n_pcs=50)
 
 ## CNV inference
 
-The function calculate_CNV basically retrieves the genomic locations and performs the CNV estimation; `cluster_by_features` (see below) calculates the clustering; `apply_CNV_reference` redefines the CNV levels on the basis of (optional) reference cells; the dedicated plotting function `CNV_heatmap` handles the visualization (based on the R package ComplexHeatmap [@Gu2016]), where the cluster of cells that contains the reference is marked. Here’s an example that illustrates CNV inference using a 100 genes window size and a reference profile from the The Genotype-Tissue Expression project (GTEx) portal (13): 
+The function calculate_CNV basically retrieves the genomic locations and performs the CNV estimation; `cluster_by_features` (see below) calculates the clustering; `apply_CNV_reference` redefines the CNV levels on the basis of (optional) reference cells; the dedicated plotting function `heatmap_CNV` handles the visualization (based on the R package ComplexHeatmap [@Gu2016]), where the cluster of cells that contains the reference is marked. Here’s an example that illustrates CNV inference using a 100 genes window size and a reference profile from the The Genotype-Tissue Expression project (GTEx) portal (13): 
 
 ```{r, include=TRUE, eval=FALSE}
 GTEx_mean <- process_GTEx_gene_reads(geneReads="~/db/GTEx/GTEx_Analysis_2017-06-05_v8_RNASeQCv1.1.9_gene_reads.gct", GTEx_annot="~/db/GTEx/GTEx_Analysis_v8_Annotations_SampleAttributesDS.txt", tissue="Brain")