Add ordering function

1 files changed, 45 insertions, 0 deletions

diff --git a/R/get_order.R b/R/get_order.R
new file mode 100644
index 0000000..78ed9d7
--- /dev/null
+++ b/R/get_order.R
@@ -0,0 +1,45 @@
+#' Identify Order
+#'
+#' Perform clustering to identify the most useful ordering
+#' to analyze a heatmap or networkplot.
+#' @param R A square numeric correlation matrix
+#' @param method Hierarchical method to perform (default hclust)
+#'
+#' @return A character vector
+#'
+#' @examples
+#' X <- matrix(data = rnorm(100), nrow = 10)
+#' R <- cor(X)
+#' get_order(R)
+#'
+#' @importFrom stats as.dist hclust
+#'
+#' @export
+get_order <- function(R, method = 'hclust'){
+	if(is.matrix(R)){
+		if(nrow(R) != ncol(R)){
+			stop('Input must be a square matrix')
+		}
+	}else{
+		stop('Input must be a square matrix')
+	}
+
+	if(is.null(colnames(R))){
+		colnames(R) <- as.character(seq_len(ncol(R)))
+	}
+	if(is.null(rownames(R))){
+		rownames(R) <- as.character(seq_len(nrow(R)))
+	}
+
+	if(method == 'hclust'){
+		# convert R into a distance object
+		D <- as.dist(1 - R)
+		hc <- hclust(D, method = 'complete')
+		cluster_order <- hc$order
+	}else if(method == 'laplacian'){
+		stop('Method not implemented yet')
+	}else{
+		stop('Invalid method selected (must be one of: hclust, laplacian)')
+	}
+	return(colnames(R)[cluster_order])
+}