new function

.gitignore

@@ -3,5 +3,4 @@
 .RData
 .Ruserdata
 inst/doc
-docs
 .DS_Store

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: HDStIM
 Type: Package
 Title: High Dimensional Stimulation Immune Mapping ('HDStIM')
-Version: 0.1.1
+Version: 1.0.0
 Authors@R: 
     c(person(given = "Rohit",
              family = "Farmer",
@@ -34,11 +34,14 @@ Imports:
     uwot,
     dplyr,
     tidyr,
+    magrittr,
     broom,
     tidyselect, 
     ggridges,
     Boruta,
-    scales
+    scales,
+    ComplexHeatmap,
+    circlize
 Suggests: 
     knitr,
     rmarkdown,

NAMESPACE

@@ -4,14 +4,21 @@ export(HDStIM)
 export(marker_ranking_boruta)
 export(plot_K_Fisher)
 export(plot_exprs)
+export(plot_marker_ranking_heatmap)
 export(plot_umap)
 import(Boruta)
+import(ComplexHeatmap)
+import(circlize)
 import(dplyr)
 import(ggplot2)
+import(magrittr)
 importFrom(broom,tidy)
 importFrom(dplyr,filter)
+importFrom(dplyr,group_by)
+importFrom(dplyr,mutate)
 importFrom(dplyr,select)
 importFrom(dplyr,slice_sample)
+importFrom(dplyr,ungroup)
 importFrom(ggridges,geom_density_ridges)
 importFrom(grDevices,dev.off)
 importFrom(grDevices,png)

R/marker_ranking_boruta.R

@@ -22,7 +22,7 @@
 #'                       chi11$unstim_label, seed_val = 123, umap = FALSE, umap_cells = NULL,
 #'                       verbose = FALSE)
 #'
-#' attribute_stats <- marker_ranking_boruta(mapped_data, path = NULL, n_cells = NULL,
+#' marker_ranking <- marker_ranking_boruta(mapped_data, path = NULL, n_cells = NULL,
 #'                                         max_runs = 1000, seed_val = 123,
 #'                                         verbose = 0)
 #' }

R/plot_marker_ranking_heatmap.R

@@ -0,0 +1,79 @@
+#' @title Marker ranking heatmap
+#' @description
+#' A consolidated heatmap showing the importance scores of all the state markers (X-axis) from
+#' all the stimulation-cell population combinations that passed the Fisher's exact test (Y-axis).
+#'
+#' @param marker_ranking    Returned list from the \code{\link{marker_ranking_boruta}} function.
+#' @import ComplexHeatmap circlize magrittr
+#' @importFrom dplyr select
+#' @importFrom dplyr group_by
+#' @importFrom dplyr mutate
+#' @importFrom dplyr ungroup
+#' @return                 A ComplexHeatmap object
+#' @export
+#' @examples
+#' \donttest{
+#' mapped_data <- HDStIM(chi11$expr_data, chi11$state_markers,
+#'                       chi11$cluster_col, chi11$stim_label,
+#'                       chi11$unstim_label, seed_val = 123, umap = TRUE,
+#'                       umap_cells = 50, verbose = FALSE)
+#'
+#' marker_ranking <- marker_ranking_boruta(mapped_data, path = NULL, n_cells = NULL,
+#'                                         max_runs = 1000, seed_val = 123,
+#'                                         verbose = 0)
+#'
+#' pht <- plot_marker_ranking_heatmap(marker_ranking)
+#' }
+plot_marker_ranking_heatmap <- function(marker_ranking){
+
+  cell_population <- meanImp <- min_max <- state_marker <- stim_type <- NULL
+
+  att_stats <- marker_ranking$attribute_stats %>%
+    dplyr::select(stim_type, cell_population, state_marker, meanImp) %>%
+    dplyr::group_by(stim_type, cell_population) %>%
+    dplyr::mutate(min_max = (meanImp - min(meanImp)) /(max(meanImp)-min(meanImp))) %>%
+    dplyr::select(stim_type, cell_population, state_marker, min_max) %>%
+    dplyr::mutate("stim_pop" = paste0(stim_type, "::", cell_population)) %>%
+    dplyr::ungroup()
+
+  mat <- matrix(nrow = length(unique(att_stats$stim_pop)), ncol = length(unique(att_stats$state_marker)))
+  colnames(mat) <- unique(att_stats$state_marker)
+  rownames(mat) <- unique(att_stats$stim_pop)
+  for(i in 1:nrow(att_stats)){
+    rowi <- att_stats$stim_pop[i]
+    coli <- as.character(att_stats$state_marker[i])
+    val <- att_stats$min_max[i]
+    mat[rowi, coli] <- val
+  }
+
+  sorted_cols <- order(colnames(mat))
+  mat <- mat[, sorted_cols]
+
+  sorted_rows <- order(rownames(mat))
+  mat <- mat[sorted_rows,]
+
+  r_breaks <- sapply(rownames(mat), function(x) strsplit(x, "::")[[1]][1]) %>%
+    as.character()
+
+  cleaned_row_names <- sapply(rownames(mat), function(x) strsplit(x, "::")[[1]][2]) %>%
+    as.character()
+
+  rownames(mat) <- cleaned_row_names
+
+  col_fun = colorRamp2(c(0, 1), c("black", "yellow"))
+  col_fun(seq(0, 1))
+
+  hmap <- ComplexHeatmap::Heatmap(mat, cluster_rows = FALSE, cluster_columns = FALSE,
+                                  col = col_fun, row_split = r_breaks,
+                                  heatmap_legend_param = list(title = "Importance"))
+
+                                  # column_names_gp = gpar(fontsize = 10),
+                                  # row_names_gp = gpar(fontsize = 10))
+
+  # png(filename = file.path("/Users/farmerr2/sandbox/development", "marker_ranking_heatmap.png") , width = 7,
+  #    height = 5, units = "in", pointsize = 12, bg = "white", res = 600)
+  # draw(hmap)
+  # dev.off()
+
+  return(hmap)
+}

README.Rmd

@@ -17,7 +17,6 @@ knitr::opts_chunk$set(
 
 <!-- badges: start -->
 [![Actions Status](https://github.com/niaid/HDStIM/workflows/R-CMD-check/badge.svg)](https://github.com/niaid/HDStIM/actions?query=workflow%3AR-CMD-check)
-[![pkgdown](https://github.com/niaid/HDStIM/workflows/pkgdown/badge.svg)](https://github.com/niaid/HDStIM/actions?query=workflow%3Apkgdown)
 <!-- badges: end -->
 
 The goal of this package is to identify response to a stimulant in CyTOF/Flow cytometry stimulation assays by labeling cells as responded or not based on an unsupervised high dimensional approach. Starting from the annotated cell populations either through automated clustering such as FlowSOM or traditional cell gating, the primary function `HDStIM()` follows a heuristic approach to label cells as responding or non-responding. 

docs/.nojekyll

@@ -0,0 +1 @@
+