Merge pull request #131 from william-hutchison/fix-factor-colour

Fix factor colour
stemangiola · Aug 5, 2024 · 5d9409e · 5d9409e
2 parents 68db595 + 9c227c7
commit 5d9409e
Show file tree

Hide file tree

Showing 12 changed files with 1,199 additions and 109 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: tidyHeatmap
 Title: A Tidy Implementation of Heatmap
-Version: 1.10.1
+Version: 1.10.3
 Authors@R: 
     c(person(given = "Stefano",
            family = "Mangiola",

diff --git a/R/methods.R b/R/methods.R
@@ -1,3 +1,6 @@
+# Specify undefined global variables for R CMD check
+utils::globalVariables(c("shape", "size", "text", ":="))
+
 #the class definition
 InputHeatmap<-setClass(
 	"InputHeatmap",  

diff --git a/R/utilities.R b/R/utilities.R
@@ -723,7 +723,14 @@ get_top_left_annotation = function(.data_, .column, .row, .abundance, annotation
 
 				# If it is a list of colors
 				else
-					colorRampPalette(palette_annotation$discrete[[.y]])(length(unique(.x))) %>% setNames(unique(.x))
+				    if (is(.x, "factor")) {
+				      color_vector <- palette_annotation$discrete[[.y]] %>% setNames(levels(.x))
+				      color_vector[!is.na(names(color_vector))]
+
+				    } else {
+				      colorRampPalette(palette_annotation$discrete[[.y]])(length(unique(.x))) %>% setNames(unique(.x))
+				    }			
+
 			} else if (.x %>% class %in% c("integer", "numerical", "numeric", "double")){
 
 				# If is colorRamp 

diff --git a/tests/testthat/_snaps/tests/grouped-annotated-heatmap-2.svg b/tests/testthat/_snaps/tests/grouped-annotated-heatmap-2.svg
diff --git a/tests/testthat/_snaps/tests/grouped-custom-color-both.svg b/tests/testthat/_snaps/tests/grouped-custom-color-both.svg
diff --git a/tests/testthat/_snaps/tests/legend.svg b/tests/testthat/_snaps/tests/legend.svg