Dev subset se

R/MarkerFeatures.R

@@ -823,6 +823,9 @@ markerHeatmap <- function(...){
 #' @param pal A custom continuous palette from `ArchRPalettes` (see `paletteContinuous()`) used to override the default continuous palette for the heatmap.
 #' @param binaryClusterRows A boolean value that indicates whether a binary sorting algorithm should be used for fast clustering of heatmap rows.
 #' @param clusterCols A boolean value that indicates whether the columns of the marker heatmap should be clustered.
+#' @param subsetMarkers A vector of rownames from seMarker to use for subsetting of seMarker to only plot specific features on the heatmap.
+#' Note that these rownames are expected to be integers that come from `rownames(rowData(seMarker))`. If this parameter is used for
+#' subsetting, then the values provided to `cutOff` are effectively ignored.
 #' @param labelMarkers A character vector listing the `rownames` of `seMarker` that should be labeled on the side of the heatmap.
 #' @param nLabel An integer value that indicates whether the top `n` features for each column in `seMarker` should be labeled on the side of the heatmap.
 #' @param nPrint If provided `seMarker` is from "GeneScoreMatrix" print the top n genes for each group based on how uniquely up-regulated the gene is.
@@ -847,6 +850,7 @@ plotMarkerHeatmap <- function(
   pal = NULL,
   binaryClusterRows = TRUE,
   clusterCols = TRUE,
+  subsetMarkers = NULL,
   labelMarkers = NULL,
   nLabel = 15,
   nPrint = 15,
@@ -868,6 +872,7 @@ plotMarkerHeatmap <- function(
   .validInput(input = pal, name = "pal", valid = c("character", "null"))
   .validInput(input = binaryClusterRows, name = "binaryClusterRows", valid = c("boolean"))
   .validInput(input = clusterCols, name = "clusterCols", valid = c("boolean"))
+  .validInput(input = subsetMarkers, name = "subsetMarkers", valid = c("integer", "null"))
   .validInput(input = labelMarkers, name = "labelMarkers", valid = c("character", "null"))
   .validInput(input = nLabel, name = "nLabel", valid = c("integer", "null"))
   .validInput(input = nPrint, name = "nPrint", valid = c("integer", "null"))
@@ -919,6 +924,16 @@ plotMarkerHeatmap <- function(
   }else{
     idx <- which(rowSums(passMat, na.rm = TRUE) > 0 & matrixStats::rowVars(mat) != 0 & !is.na(matrixStats::rowVars(mat)))
   }
+
+  if(!is.null(subsetMarkers)) {
+    if(length(which(subsetMarkers %ni% 1:nrow(mat))) == 0){
+      idx <- subsetMarkers
+    } else {
+      stop("Rownames / indices provided to the subsetMarker parameter are outside of the boundaries of seMarker.")
+    }
+
+  }
+
   mat <- mat[idx,,drop=FALSE]
   passMat <- passMat[idx,,drop=FALSE]
 
@@ -951,15 +966,19 @@ plotMarkerHeatmap <- function(
   }
 
   spmat <- passMat / rowSums(passMat)
-  if(metadata(seMarker)$Params$useMatrix == "GeneScoreMatrix"){
-    message("Printing Top Marker Genes:")
-    for(x in seq_len(ncol(spmat))){
-      genes <- head(order(spmat[,x], decreasing = TRUE), nPrint)
-      message(colnames(spmat)[x], ":")
-      message("\t", paste(as.vector(rownames(mat)[genes]), collapse = ", "))
+  #only print out identified marker genes if subsetMarkers is NULL
+  if(is.null(subsetMarkers)) {
+    if(metadata(seMarker)$Params$useMatrix == "GeneScoreMatrix"){
+      message("Printing Top Marker Genes:")
+      for(x in seq_len(ncol(spmat))){
+        genes <- head(order(spmat[,x], decreasing = TRUE), nPrint)
+        message(colnames(spmat)[x], ":")
+        message("\t", paste(as.vector(rownames(mat)[genes]), collapse = ", "))
+      }
     }
   }
 
+
   if(is.null(labelMarkers)){
     labelMarkers <- lapply(seq_len(ncol(spmat)), function(x){
       as.vector(rownames(mat)[head(order(spmat[,x], decreasing = TRUE), nLabel)])