From 30f24c6acd901c3e4597c687ced9aecf8715add5 Mon Sep 17 00:00:00 2001
From: vertesy <abel.vertesy@imba.oeaw.ac.at>
Date: Mon, 12 Feb 2024 21:34:28 +0100
Subject: [PATCH] bf / nf getDiscretePalette

---
 NAMESPACE                      |  1 +
 R/Seurat.Utils.Visualization.R | 50 ++++++++++++++++++++++++----------
 man/getDiscretePalette.Rd      | 11 +++++---
 man/sampleCellsFromIdent.Rd    |  2 +-
 4 files changed, 44 insertions(+), 20 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index 5e7227e..dac9841 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -235,6 +235,7 @@ importFrom(ggplot2,geom_point)
 importFrom(ggplot2,ggplot)
 importFrom(ggplot2,ggtitle)
 importFrom(ggrepel,geom_text_repel)
+importFrom(gplots,rich.colors)
 importFrom(htmlwidgets,saveWidget)
 importFrom(job,job)
 importFrom(matrixStats,rowSums2)
diff --git a/R/Seurat.Utils.Visualization.R b/R/Seurat.Utils.Visualization.R
index d391207..021e829 100644
--- a/R/Seurat.Utils.Visualization.R
+++ b/R/Seurat.Utils.Visualization.R
@@ -892,12 +892,14 @@ gg_color_hue <- function(n) { # reproduce the ggplot2 default color palette
 
 
 # _________________________________________________________________________________________________
-#' @title getDiscretePalette
+#' @title Safely generate a discrete color palette (NA).
 #'
-#' @description Generate a discrete color palette.
+#' @description Safe wrapper around Seurat's DiscretePalette(), which returns NA's if too many
+#' categories are requested
 #' @param ident.used The identity column used for determining the number of clusters, Default: GetClusteringRuns()[1]
 #' @param obj Seurat object, Default: combined.obj
-#' @param palette.used The name of the palette to use, Default: c("alphabet", "alphabet2", "glasbey", "polychrome", "stepped")[1]
+#' @param palette.used The name of the palette to use, Default: c("alphabet", "alphabet2",
+#' "glasbey", "polychrome", "stepped")[1]
 #' @param show.colors Whether to display the colors in the palette, Default: FALSE
 #' @examples
 #' \dontrun{
@@ -906,24 +908,42 @@ gg_color_hue <- function(n) { # reproduce the ggplot2 default color palette
 #' }
 #' }
 #' @importFrom MarkdownHelpers color_check
+#' @importFrom gplots rich.colors
 #'
 #' @export getDiscretePalette
 getDiscretePalette <- function(
     ident.used = GetClusteringRuns()[1],
     obj = combined.obj,
     palette.used = c("alphabet", "alphabet2", "glasbey", "polychrome", "stepped")[1],
-    show.colors = FALSE) {
+    show.colors = FALSE, seed = 1989) {
+
   n.clusters <- nrow(unique(obj[[ident.used]]))
-  colz <- DiscretePalette(n = n.clusters, palette = palette.used)
-  if (anyNA(colz)) {
-    colzOK <- na.omit.strip(colz)
-    repNeeded <- ceiling(length(colz) / length(colzOK))
-    colzFixed <- rep(colzOK, repNeeded)[1:length(colz)]
-    stopif(anyNA(colzFixed))
-    colz <- colzFixed
+
+  colorz <- Seurat::DiscretePalette(n = n.clusters, palette = palette.used)
+
+  if (anyNA(colorz)) {
+
+    colorsOK <- colorz[!is.na(colorz)] # Extract non-NA values
+    n.colz <- length(colorsOK)
+
+    msg <- paste("More categories then present in the palette", n.clusters, "vs."
+                 , n.colz, "in", palette.used)
+    warning(msg, immediate. = TRUE)
+
+    # Resample non-NA values and replace NA values
+    set.seed(seed)
+
+    if (n.clusters > 10 * n.colz) {
+      colorz <- sample(gplots::rich.colors(n.clusters))
+    } else {
+      colorz <- sample(x = colorsOK, size = n.clusters, replace = T)
+    }
+
+    stopif(anyNA(colorz))
+
   }
-  if (show.colors) MarkdownHelpers::color_check(colz)
-  return(colz)
+  if (show.colors) MarkdownHelpers::color_check(colorz)
+  return(colorz)
 }
 
 
@@ -1446,8 +1466,8 @@ qUMAP <- function(
 #'
 #' @export
 clUMAP <- function(
-    ident = "integrated_snn_res.0.5", obj = combined.obj # The quickest way to draw a clustering result  UMAP
-    , reduction = "umap", splitby = NULL,
+    ident = "integrated_snn_res.0.5", obj = combined.obj, # The quickest way to draw a clustering result  UMAP
+    reduction = "umap", splitby = NULL,
     title = ident, sub = NULL,
     prefix = NULL,
     suffix = make.names(sub),
diff --git a/man/getDiscretePalette.Rd b/man/getDiscretePalette.Rd
index 3f3e936..c84c812 100644
--- a/man/getDiscretePalette.Rd
+++ b/man/getDiscretePalette.Rd
@@ -2,13 +2,14 @@
 % Please edit documentation in R/Seurat.Utils.Visualization.R
 \name{getDiscretePalette}
 \alias{getDiscretePalette}
-\title{getDiscretePalette}
+\title{Safely generate a discrete color palette (NA).}
 \usage{
 getDiscretePalette(
   ident.used = GetClusteringRuns()[1],
   obj = combined.obj,
   palette.used = c("alphabet", "alphabet2", "glasbey", "polychrome", "stepped")[1],
-  show.colors = FALSE
+  show.colors = FALSE,
+  seed = 1989
 )
 }
 \arguments{
@@ -16,12 +17,14 @@ getDiscretePalette(
 
 \item{obj}{Seurat object, Default: combined.obj}
 
-\item{palette.used}{The name of the palette to use, Default: c("alphabet", "alphabet2", "glasbey", "polychrome", "stepped")\link{1}}
+\item{palette.used}{The name of the palette to use, Default: c("alphabet", "alphabet2",
+"glasbey", "polychrome", "stepped")\link{1}}
 
 \item{show.colors}{Whether to display the colors in the palette, Default: FALSE}
 }
 \description{
-Generate a discrete color palette.
+Safe wrapper around Seurat's DiscretePalette(), which returns NA's if too many
+categories are requested
 }
 \examples{
 \dontrun{
diff --git a/man/sampleCellsFromIdent.Rd b/man/sampleCellsFromIdent.Rd
index f5510b9..86e7eb1 100644
--- a/man/sampleCellsFromIdent.Rd
+++ b/man/sampleCellsFromIdent.Rd
@@ -4,7 +4,7 @@
 \alias{sampleCellsFromIdent}
 \title{Sample Cells From Identifiers in Seurat Object}
 \usage{
-sampleCellsFromIdent(obj, ident, max.cells, verbose = TRUE)
+sampleCellsFromIdent(obj, ident, max.cells, verbose = TRUE, seed = 1989)
 }
 \arguments{
 \item{obj}{A Seurat object from which cells are to be sampled.}