OR bug fix

analyses/braf-fusions/01-fusion-breakpoints-by-imaging-cluster.Rmd

@@ -162,26 +162,6 @@ write_tsv(type_df,
           file.path(results_dir, "lgg-braf-fusion-common-breakpoint-type-image-clusters.tsv"))
 
 ```
-Generate enrichment heatmap of breakpoint types (common vs. rare) in imaging clusters
-
-```{r cluster-breakpoint type heatmap}
-plot_df <- imaging_plus_fusions %>%
-  dplyr::filter(!is.na(breakpoint_type)) %>%
-  dplyr::mutate(`Cluster Assignment` = glue::glue("cluster{`Cluster Assignment`}"))
-
-breakpoint_type_ht <- plot_enr(plot_df, "breakpoint_type", "Cluster Assignment",
-                     var1_names = c("common", "rare"),
-                     var2_names = c("cluster1", "cluster2", "cluster3"),
-                     padjust = FALSE)
-
-pdf(file.path(plot_dir, "breakpoint-type-by-cluster-ht.pdf"),
-    width = 4, height = 2.5)
-
-draw(breakpoint_type_ht)
-
-dev.off()
-```
-
 
 Generate enrichment heatmap of breakpoint groups in imaging clusters
 
@@ -203,6 +183,31 @@ draw(breakpoint_group_ht)
 dev.off()
 ```
 
+Plot distribution of breakpoint type (common vs. rare) across clusters
+
+```{r}
+cluster_breakpoint_type_ct <- table(plot_df$breakpoint_type, plot_df$`Cluster Assignment`)
+
+col_fun = colorRamp2(c(0, ceiling(max(cluster_breakpoint_type_ct))), c("white", "orangered"))
+
+pdf(file.path(plot_dir, "breakpoint-type-by-cluster-ht.pdf"),
+    width = 3, height = 2)
+
+Heatmap(cluster_breakpoint_type_ct,
+       name = "Count",
+       cluster_rows = F,
+       cluster_columns = F,
+       rect_gp = gpar(col = "black", lwd = 2),
+       col = col_fun,
+       cell_fun = function(j, i, x, y, width, height, fill) {
+         grid.text(sprintf("%s", cluster_breakpoint_type_ct[i, j]), x, y, gp = gpar(fontsize = 12))
+       },
+       column_names_side = "top",
+       column_names_rot = 25,
+       column_names_centered = FALSE)
+
+dev.off()
+```
 
 Assess distribution of breakpoint type by imaging cluster (common vs. rare)
 

analyses/braf-fusions/util/heatmap_function.R

@@ -24,25 +24,36 @@ plot_enr <- function(df, var1, var2,
       no_var2 <- sum(unlist(df[,var2]) == colnames(enr)[j] & !is.na(unlist(df[,var2])))
       no_var1_var2 <- sum(unlist(df[,var1]) == rownames(enr)[i] & unlist(df[,var2]) == colnames(enr)[j])
       ct[i,j] <- no_var1_var2
-      enr[i,j] <- (no_var1_var2/no_var2)/(no_var1/nrow(df))
-      pval[i,j] <- phyper(no_var1_var2, no_var1, nrow(df) - no_var1, no_var2, lower.tail = F)
+      or_mat <- matrix(c(no_var1_var2, no_var1-no_var1_var2,
+                         no_var2-no_var1_var2, 
+                         nrow(df)-no_var1-no_var2+no_var1_var2),
+                       2, 2)
+      enr[i,j] <- fisher.test(or_mat, alternative = "greater")$estimate
+      pval[i,j] <- phyper(no_var1_var2, no_var1,
+                          nrow(df) - no_var1, no_var2,
+                          lower.tail = FALSE)
     }
   }
 
   if (padjust == TRUE) {
 
     fdr <- t(apply(pval, 1, function(x) p.adjust(x, "fdr")))
-    sig_mat <- ifelse(fdr < 0.05 & enr > 1 & ct > 1, "*", "")
+    sig_mat <- ifelse(fdr < 0.05 & enr > 1 & ct > 1 & !is.infinite(enr), "*", "")
 
   } else {
 
-    sig_mat <- ifelse(pval < 0.05 & enr > 1 & ct > 1, "*", "")
+    sig_mat <- ifelse(pval < 0.05 & enr > 1 & ct > 1 & !is.infinite(enr), "*", "")
 
   }
 
   fill_mat <- matrix(glue::glue("{round(enr, 1)}{sig_mat}"), 
                      nrow(enr), ncol(enr))
 
+  fill_mat <- matrix(str_replace_all(fill_mat, "Inf", "NR"), 
+                     nrow(enr), ncol(enr))
+
+  enr <- ifelse(is.infinite(enr), 0, enr)
+
   ct_enr_mat <- matrix(glue::glue("{ct}\n({fill_mat})"),
                        nrow(ct), ncol(ct))