Merge pull request #230 from saeyslab/issue-198-idents

Issue 198 fix

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: nichenetr
 Type: Package
 Title: NicheNet: Modeling Intercellular Communication by Linking Ligands to Target Genes
-Version: 2.0.3
+Version: 2.0.4
 Authors@R: c(person("Robin", "Browaeys",  role = c("aut")),
             person("Chananchida", "Sang-aram", role = c("aut", "cre"), email = "[email protected]"))
 Description: This package allows you the investigate intercellular communication from a computational perspective. More specifically, it allows to investigate how interacting cells influence each other's gene expression. Functionalities of this package (e.g. including predicting extracellular upstream regulators and their affected target genes) build upon a probabilistic model of ligand-target links that was inferred by data-integration.

R/application_prediction.R

@@ -847,7 +847,7 @@ nichenet_seuratobj_aggregate = function(receiver, seurat_obj, condition_colname,
   if (verbose == TRUE){print("Perform DE analysis in receiver cell")}
 
   seurat_obj_receiver= subset(seurat_obj, idents = receiver)
-  seurat_obj_receiver = SetIdent(seurat_obj_receiver, value = seurat_obj_receiver[[condition_colname]])
+  seurat_obj_receiver = SetIdent(seurat_obj_receiver, value = seurat_obj_receiver[[condition_colname, drop=TRUE]])
   DE_table_receiver = FindMarkers(object = seurat_obj_receiver, ident.1 = condition_oi, ident.2 = condition_reference, min.pct = expression_pct) %>% rownames_to_column("gene")
 
   SeuratV4 = c("avg_log2FC") %in% colnames(DE_table_receiver)
@@ -1030,7 +1030,7 @@ nichenet_seuratobj_aggregate = function(receiver, seurat_obj, condition_colname,
     names(order_ligands_adapted) = NULL
 
     seurat_obj_subset = seurat_obj %>% subset(idents = sender_celltypes)
-    seurat_obj_subset = SetIdent(seurat_obj_subset, value = seurat_obj_subset[[condition_colname]]) %>% subset(idents = condition_oi) ## only shows cells of the condition of interest
+    seurat_obj_subset = SetIdent(seurat_obj_subset, value = seurat_obj_subset[[condition_colname, drop=TRUE]]) %>% subset(idents = condition_oi) ## only shows cells of the condition of interest
     rotated_dotplot = DotPlot(seurat_obj %>% subset(cells = Cells(seurat_obj_subset)), features = order_ligands_adapted, cols = "RdYlBu") + coord_flip() + theme(legend.text = element_text(size = 10), legend.title = element_text(size = 12)) # flip of coordinates necessary because we want to show ligands in the rows when combining all plots
     rm(seurat_obj_subset)
 
@@ -1782,11 +1782,11 @@ nichenet_seuratobj_aggregate_cluster_de = function(seurat_obj, receiver_affected
   if (verbose == TRUE){print("Perform DE analysis between two receiver cell clusters")}
 
   seurat_obj_receiver_affected= subset(seurat_obj, idents = receiver_affected)
-  seurat_obj_receiver_affected = SetIdent(seurat_obj_receiver_affected, value = seurat_obj_receiver_affected[[condition_colname]])
+  seurat_obj_receiver_affected = SetIdent(seurat_obj_receiver_affected, value = seurat_obj_receiver_affected[[condition_colname, drop=TRUE]])
   seurat_obj_receiver_affected= subset(seurat_obj_receiver_affected, idents = condition_oi)
 
   seurat_obj_receiver_reference= subset(seurat_obj, idents = receiver_reference)
-  seurat_obj_receiver_reference = SetIdent(seurat_obj_receiver_reference, value = seurat_obj_receiver_reference[[condition_colname]])
+  seurat_obj_receiver_reference = SetIdent(seurat_obj_receiver_reference, value = seurat_obj_receiver_reference[[condition_colname, drop=TRUE]])
   seurat_obj_receiver_reference= subset(seurat_obj_receiver_reference, idents = condition_reference)
 
   seurat_obj_receiver = merge(seurat_obj_receiver_affected, seurat_obj_receiver_reference)
@@ -2003,14 +2003,14 @@ get_lfc_celltype = function(celltype_oi, seurat_obj, condition_colname, conditio
   requireNamespace("Seurat")
   requireNamespace("dplyr")
   if(!is.null(celltype_col)){
-    seurat_obj_celltype = SetIdent(seurat_obj, value = seurat_obj[[celltype_col]])
+    seurat_obj_celltype = SetIdent(seurat_obj, value = seurat_obj[[celltype_col, drop=TRUE]])
     seuratObj_sender = subset(seurat_obj_celltype, idents = celltype_oi)
 
   } else {
     seuratObj_sender = subset(seurat_obj, idents = celltype_oi)
 
   }
-  seuratObj_sender = SetIdent(seuratObj_sender, value = seuratObj_sender[[condition_colname]])
+  seuratObj_sender = SetIdent(seuratObj_sender, value = seuratObj_sender[[condition_colname, drop=TRUE]])
   DE_table_sender = FindMarkers(object = seuratObj_sender, ident.1 = condition_oi, ident.2 = condition_reference, min.pct = expression_pct, logfc.threshold = 0.05) %>% rownames_to_column("gene")
 
   SeuratV4 = c("avg_log2FC") %in% colnames(DE_table_sender)

R/prioritization.R

@@ -267,7 +267,7 @@ process_table_to_ic = function(table_object, table_type = "expression",
 #' ligand_target_matrix = ligand_target_matrix %>% .[!is.na(rownames(ligand_target_matrix)), !is.na(colnames(ligand_target_matrix))]
 #'
 #' # Ligand activity analysis
-#' seurat_obj_receiver = subset(seurat_obj, idents = receiver) %>% SetIdent(value = .[["aggregate"]])
+#' seurat_obj_receiver = subset(seurat_obj, idents = receiver) %>% SetIdent(value = .[["aggregate", drop = TRUE]])
 #' geneset_oi = FindMarkers(object = seurat_obj_receiver, ident.1 = "LCMV, ident.2 = "SS, min.pct = 0.10) %>% rownames_to_column("gene") %>%
 #'      filter(p_val_adj <= 0.05 & abs(avg_log2FC) >= 0.25) %>% pull(gene) %>% .[. %in% rownames(ligand_target_matrix)]
 #' expressed_genes_sender = sender_celltypes %>% unique() %>% lapply(get_expressed_genes, seurat_obj, 0.10) %>% unlist() %>% unique()

R/supporting_functions.R

@@ -247,6 +247,23 @@ alias_to_symbol_seurat = function(seurat_obj, organism) {
         rownames(RNA@scale.data) = newnames
       }
     }
+
+    if (length(RNA@var.features) > 0){
+      newnames = convert_alias_to_symbols(RNA@var.features, organism = organism, verbose = FALSE)
+      doubles =  newnames %>% table() %>% .[. > 1] %>% names()
+      genes_remove = (names(newnames[newnames %in% doubles]) != (newnames[newnames %in% doubles])) %>%  .[. == TRUE] %>% names()
+      newnames[genes_remove] = genes_remove # set the doubles back to their old names
+      RNA@var.features = newnames
+    }
+
+    if (nrow(RNA@meta.features) > 0){
+      newnames = convert_alias_to_symbols(rownames(RNA@meta.features), organism = organism, verbose = FALSE)
+      doubles =  newnames %>% table() %>% .[. > 1] %>% names()
+      genes_remove = (names(newnames[newnames %in% doubles]) != (newnames[newnames %in% doubles])) %>%  .[. == TRUE] %>% names()
+      newnames[genes_remove] = genes_remove # set the doubles back to their old names
+      rownames(RNA@meta.features) = newnames
+    }
+
   } else {"Unequal gene sets: nrow(seurat_obj@assays$RNA) != nrow(newnames)"}
 
   if(!is.null(RNA@counts)){
@@ -280,6 +297,28 @@ alias_to_symbol_seurat = function(seurat_obj, organism) {
     }
   }
 
+  if (length(RNA@var.features) > 0){
+    dim_before = length(RNA@var.features)
+    RNA@var.features = RNA@var.features %>% .[!is.na(.)]
+    dim_after = length(RNA@var.features)
+    if(dim_before != dim_after){
+      print("length of var.features changed")
+      print(paste0("before: ",dim_before))
+      print(paste0("after: ",dim_before))
+    }
+  }
+
+  if (nrow(RNA@meta.features) > 0){
+    dim_before = dim(RNA@meta.features)
+    RNA@meta.features = RNA@meta.features %>% .[!is.na(rownames(.)), ]
+    dim_after = dim(RNA@meta.features)
+    if(sum(dim_before != dim_after) > 0){
+      print("length of meta.features changed")
+      print(paste0("before: ",dim_before))
+      print(paste0("after: ",dim_before))
+    }
+  }
+
   seurat_obj@assays$RNA = RNA
 
   if(!is.null( seurat_obj@assays$SCT)){
@@ -313,6 +352,23 @@ alias_to_symbol_seurat = function(seurat_obj, organism) {
           rownames(SCT@scale.data) = newnames
         }
       }
+
+      if (length(SCT@var.features) > 0){
+        newnames = convert_alias_to_symbols(SCT@var.features, organism = organism, verbose = FALSE)
+        doubles =  newnames %>% table() %>% .[. > 1] %>% names()
+        genes_remove = (names(newnames[newnames %in% doubles]) != (newnames[newnames %in% doubles])) %>%  .[. == TRUE] %>% names()
+        newnames[genes_remove] = genes_remove # set the doubles back to their old names
+        SCT@var.features = newnames
+      }
+
+      if (nrow(SCT@meta.features) > 0){
+        newnames = convert_alias_to_symbols(rownames(SCT@meta.features), organism = organism, verbose = FALSE)
+        doubles =  newnames %>% table() %>% .[. > 1] %>% names()
+        genes_remove = (names(newnames[newnames %in% doubles]) != (newnames[newnames %in% doubles])) %>%  .[. == TRUE] %>% names()
+        newnames[genes_remove] = genes_remove # set the doubles back to their old names
+        rownames(SCT@meta.features) = newnames
+      }
+
     } else {"Unequal gene sets: nrow(seurat_obj@assays$SCT) != nrow(newnames)"}
 
     if(!is.null(SCT@counts)){
@@ -345,6 +401,30 @@ alias_to_symbol_seurat = function(seurat_obj, organism) {
         print(paste0("after: ",dim_before))
       }
     }
+
+    if (length(SCT@var.features) > 0){
+      dim_before = length(SCT@var.features)
+      SCT@var.features = SCT@var.features %>% .[!is.na(.)]
+      dim_after = length(SCT@var.features)
+      if(dim_before != dim_after){
+        print("length of var.features changed")
+        print(paste0("before: ",dim_before))
+        print(paste0("after: ",dim_before))
+      }
+    }
+
+
+    if (nrow(SCT@meta.features) > 0){
+      dim_before = dim(SCT@meta.features)
+      SCT@meta.features = SCT@meta.features %>% .[!is.na(rownames(.)), ]
+      dim_after = dim(SCT@meta.features)
+      if(sum(dim_before != dim_after) > 0){
+        print("length of meta.features changed")
+        print(paste0("before: ",dim_before))
+        print(paste0("after: ",dim_before))
+      }
+    }
+
     seurat_obj@assays$SCT = SCT
   }
 
@@ -383,6 +463,23 @@ alias_to_symbol_seurat = function(seurat_obj, organism) {
           rownames(integrated@scale.data) = newnames
         }
       }
+
+      if (length(integrated@var.features) > 0){
+        newnames = convert_alias_to_symbols(integrated@var.features, organism = organism, verbose = FALSE)
+        doubles =  newnames %>% table() %>% .[. > 1] %>% names()
+        genes_remove = (names(newnames[newnames %in% doubles]) != (newnames[newnames %in% doubles])) %>%  .[. == TRUE] %>% names()
+        newnames[genes_remove] = genes_remove # set the doubles back to their old names
+        integrated@var.features = newnames
+      }
+
+      if (nrow(integrated@meta.features) > 0){
+        newnames = convert_alias_to_symbols(rownames(integrated@meta.features), organism = organism, verbose = FALSE)
+        doubles =  newnames %>% table() %>% .[. > 1] %>% names()
+        genes_remove = (names(newnames[newnames %in% doubles]) != (newnames[newnames %in% doubles])) %>%  .[. == TRUE] %>% names()
+        newnames[genes_remove] = genes_remove # set the doubles back to their old names
+        rownames(integrated@meta.features) = newnames
+      }
+
     } else {"Unequal gene sets: nrow(seurat_obj@assays$integrated) != nrow(newnames)"}
 
     if(!is.null(integrated@counts)){
@@ -415,6 +512,29 @@ alias_to_symbol_seurat = function(seurat_obj, organism) {
         print(paste0("after: ",dim_before))
       }
     }
+
+    if (length(integrated@var.features) > 0){
+      dim_before = length(integrated@var.features)
+      integrated@var.features = integrated@var.features %>% .[!is.na(.)]
+      dim_after = length(integrated@var.features)
+      if(dim_before != dim_after){
+        print("length of var.features changed")
+        print(paste0("before: ",dim_before))
+        print(paste0("after: ",dim_before))
+      }
+    }
+
+    if (nrow(integrated@meta.features) > 0){
+      dim_before = dim(integrated@meta.features)
+      integrated@meta.features = integrated@meta.features %>% .[!is.na(rownames(.)), ]
+      dim_after = dim(integrated@meta.features)
+      if(sum(dim_before != dim_after) > 0){
+        print("length of meta.features changed")
+        print(paste0("before: ",dim_before))
+        print(paste0("after: ",dim_before))
+      }
+    }
+
     seurat_obj@assays$integrated = integrated
   }
 

tests/testthat/test-differential_nichenet.R

@@ -11,7 +11,7 @@ test_that("Differential NicheNet pipeline works", {
   seurat_object_lite@meta.data$celltype_aggregate = paste(seurat_object_lite@meta.data$celltype, seurat_object_lite@meta.data$aggregate,sep = "_") # user adaptation required on own dataset
 
   celltype_id = "celltype_aggregate" # metadata column name of the cell type of interest
-  seurat_obj = SetIdent(seurat_object_lite, value = seurat_object_lite[[celltype_id]])
+  seurat_obj = SetIdent(seurat_object_lite, value = seurat_object_lite[[celltype_id, drop=TRUE]])
 
   niches = list(
     "LCMV_niche" = list(
@@ -90,7 +90,7 @@ test_that("Differential NicheNet pipeline works", {
   length(geneset_niche2)
 
   top_n_target = 250
- 
+
   niche_geneset_list = list(
     "LCMV_niche" = list(
       "receiver" = niches[[1]]$receiver,

vignettes/differential_nichenet_pEMT.Rmd

@@ -70,7 +70,7 @@ [email protected]$celltype_aggregate %>% table() %>% sort(decreasing = TRUE)
 
 ```{r}
 celltype_id = "celltype_aggregate" # metadata column name of the cell type of interest
-seurat_obj = SetIdent(seurat_obj, value = seurat_obj[[celltype_id]])
+seurat_obj = SetIdent(seurat_obj, value = seurat_obj[[celltype_id, drop=TRUE]])
 ```
 
 ## Read in the NicheNet ligand-receptor network and ligand-target matrix

vignettes/differential_nichenet_pEMT.md

@@ -103,7 +103,7 @@ [email protected]$celltype_aggregate %>% table() %>% sort(decreasing = TRUE)
 
 ``` r
 celltype_id = "celltype_aggregate" # metadata column name of the cell type of interest
-seurat_obj = SetIdent(seurat_obj, value = seurat_obj[[celltype_id]])
+seurat_obj = SetIdent(seurat_obj, value = seurat_obj[[celltype_id, drop=TRUE]])
 ```
 
 ## Read in the NicheNet ligand-receptor network and ligand-target matrix