From 97de1524cc665846a2770d1e5be932889b1d3e7c Mon Sep 17 00:00:00 2001
From: Chris Sobczak <chris@sobczak.family>
Date: Mon, 6 Jul 2026 15:36:59 -0700
Subject: Add order option

---
 R/heatmap.R | 50 +++++++++++++++++++-------------------------------
 1 file changed, 19 insertions(+), 31 deletions(-)

diff --git a/R/heatmap.R b/R/heatmap.R
index c40946f..cb6c8f8 100644
--- a/R/heatmap.R
+++ b/R/heatmap.R
@@ -5,6 +5,7 @@
 #' @param R A square numeric correlation matrix
 #' @param title Optional plot title
 #' @param labels Logical to plot column names or not (default FALSE)
+#' @param order Optional character vector of the order you want the plot sorted in
 #'
 #' @return A ggplot object
 #'
@@ -16,45 +17,32 @@
 #' @importFrom reshape2 melt
 #' @import ggplot2
 #' @export
-heatmap <- function(R, title = NULL, labels = FALSE){
+heatmap <- function(R, title = NULL, labels = FALSE, order = NULL){
 	R_list <- tryCatch({
 		if(is.matrix(R)){
-			cnames <- colnames(R)
-			rnames <- rownames(R)
-			if(nrow(R) == ncol(R)){
-				list(
-					R = R[upper.tri(R)],
-					cnames = cnames,
-					rnames = rnames,
-					p = ncol(R)
-				)
-			}
-		}else if(is.vector(R)){
-			m <- length(R)
-			n <- (1 + sqrt(1 + 8 * m)) / 2
-			if(n == floor(n)){
-				list(
-					R = R,
-					cnames = NULL,
-					rnames = NULL,
-					p = n
-				)
-			}else{
-				stop('Input length not compatible with upper triangle')
-			}
+			Rm <- R
+			cnames <- colnames(Rm)
+			rnames <- rownames(Rm)
 		}else{
 			Rm <- as.matrix(R)
 			cnames <- colnames(Rm)
 			rnames <- rownames(Rm)
-			if(nrow(Rm) == ncol(Rm)){
-				list(
-					R = Rm[upper.tri(Rm)],
-					cnames = cnames,
-					rnames = rnames,
-					p = ncol(Rm)
-				)
+		}
+		if(nrow(Rm) == ncol(Rm)){
+			if(!is.null(order)){
+				order <- get_order(Rm)
+				M <- Rm[order, order]
 			}
+			list(
+				M = M[upper.tri(M)],
+				cnames = cnames,
+				rnames = rnames,
+				p = ncol(M)
+			)
+		}else{
+			stop('Input must be coercible to a square matrix')
 		}
+
 	}, error = function(e){
 		stop(paste('Invalid input for heatmap:', e$message))
 	})
-- 
cgit v1.2.3