Merge pull request #99 from LieberInstitute/improve_layer_stat_cor_plot

Improve layer stat cor plot

Author: lcolladotor

R/annotate_registered_clusters.R

@@ -58,6 +58,13 @@ annotate_registered_clusters <-
                 annotate_registered_cluster,
                 cutoff_merge_ratio = cutoff_merge_ratio
             )
+        
+        if(any(grepl("/", colnames(cor_stats_layer)))) {
+          stop(
+            "Cannot use refrence lables containing '/' - check colnames(cor_stats_layer)",
+            call. = FALSE
+          )
+        }
 
         confidence <- apply(cor_stats_layer, 1, max) > confidence_threshold
 

R/layer_stat_cor_plot.R

@@ -199,15 +199,26 @@ layer_stat_cor_plot <- function(
 }
 
 create_annotation_matrix <- function(annotation_df, cor_stats_layer) {
+  
+    if(!setequal(rownames(cor_stats_layer), annotation_df$cluster)){
+      stop(
+        "Query cluster names do not match between rownames(cor_stats_layer) and annotation$cluster.\n
+        Be sure the annotation data matches.",
+        call. = FALSE
+      )
+    }
+      
     anno_list <- lapply(
         rownames(cor_stats_layer),
         function(cluster) {
             # look up confidence
             confidence <- annotation_df[match(cluster, annotation_df$cluster), "layer_confidence"]
             sym <- ifelse(confidence == "good", "X", "*")
             # match annotations
-            anno <- annotation_df[match(cluster, annotation_df$cluster), "layer_label"]
-            return(ifelse(unlist(lapply(colnames(cor_stats_layer), grepl, anno)), sym, ""))
+            anno <- gsub("\\*","",annotation_df[match(cluster, annotation_df$cluster), "layer_label"])
+            anno_lgl_row <- unlist(lapply(colnames(cor_stats_layer), "%in%", unlist(strsplit(anno, split = "/"))))
+            
+            return(ifelse(anno_lgl_row, sym, ""))
         }
     )
 

tests/testthat/test-annotate_registered_cluster.R

@@ -0,0 +1,25 @@
+## Obtain the necessary data
+if (!exists("modeling_results")) {
+    modeling_results <- fetch_data(type = "modeling_results")
+}
+
+## query spatialDLPFC modeling results
+query_modeling_results <- fetch_data(
+  type = "spatialDLPFC_Visium_modeling_results"
+)
+
+## Compute the correlations
+cor_stats_layer <- layer_stat_cor(
+  stats = query_modeling_results$enrichment,
+  modeling_results,
+  model_type = "enrichment"
+)
+
+## Obtain labels
+annotate_registered_clusters(cor_stats_layer)
+
+
+test_that("Stop with slash", {
+  colnames(cor_stats_layer) <- gsub("ayer", "/", colnames(cor_stats_layer))
+  expect_error(annotate_registered_clusters(cor_stats_layer))
+})

tests/testthat/test-layer_stat_cor_plot.R

@@ -0,0 +1,56 @@
+
+## Obtain the necessary data
+## reference human pilot modeling results
+if (!exists("modeling_results")) {
+    modeling_results <- fetch_data(type = "modeling_results")
+}
+
+## query spatialDLPFC modeling results
+query_modeling_results <- fetch_data(
+    type = "spatialDLPFC_Visium_modeling_results"
+)
+
+## Compute the correlations
+cor_stats_layer <- layer_stat_cor(
+    stats = query_modeling_results$enrichment,
+    modeling_results,
+    model_type = "enrichment"
+)
+
+## Default plot with no annotations and defaults for ComplexHeatmap()
+# default_plot <- layer_stat_cor_plot(cor_stats_layer)
+
+
+## Add annotation
+annotation_df <- annotate_registered_clusters(
+    cor_stats_layer,
+    confidence_threshold = .55
+)
+
+# anno_plot <- layer_stat_cor_plot(cor_stats_layer, annotation = annotation_df)
+
+## test w/ numeric reference lables
+cor_stats_numeric <- cor_stats_layer
+colnames(cor_stats_numeric) <- c(13, 6:1)
+
+annotation_df_numeric <- annotate_registered_clusters(
+  cor_stats_numeric,
+  confidence_threshold = .55
+)
+
+# layer_stat_cor_plot(cor_stats_numeric, annotation = annotation_df_numeric)
+
+
+test_that("annotation checks work",{
+  annotation_df$cluster <- gsub("Sp09", "",annotation_df$cluster)
+  expect_error(create_annotation_matrix(annotation_df, cor_stats_layer))
+})
+
+test_that("annotation matrix works w/ short cluster names", {
+  anno_matrix <- create_annotation_matrix(annotation_df, cor_stats_layer)
+  anno_matrix_numeric <- create_annotation_matrix(annotation_df_numeric, cor_stats_numeric)
+  colnames(anno_matrix_numeric) <- colnames(anno_matrix)
+  
+  expect_equal(anno_matrix, anno_matrix_numeric)
+})
+