Add ordering function

4 files changed, 89 insertions, 0 deletions

diff --git a/NAMESPACE b/NAMESPACE
index 266fb54..a01512a 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+export(get_order)
 export(gg_csobczak)
 export(heatmap)
 export(networkplot)
@@ -7,3 +8,5 @@ import(ggplot2)
 import(ggraph)
 import(igraph)
 importFrom(reshape2,melt)
+importFrom(stats,as.dist)
+importFrom(stats,hclust)
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])
+}
diff --git a/man/get_order.Rd b/man/get_order.Rd
new file mode 100644
index 0000000..cbf0f38
--- /dev/null
+++ b/man/get_order.Rd
@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/get_order.R
+\name{get_order}
+\alias{get_order}
+\title{Identify Order}
+\usage{
+get_order(R, method = "hclust")
+}
+\arguments{
+\item{R}{A square numeric correlation matrix}
+
+\item{method}{Hierarchical method to perform (default hclust)}
+}
+\value{
+A character vector
+}
+\description{
+Perform clustering to identify the most useful ordering
+to analyze a heatmap or networkplot.
+}
+\examples{
+X <- matrix(data = rnorm(100), nrow = 10)
+R <- cor(X)
+get_order(R)
+
+}
diff --git a/tests/testthat/test-get_order.R b/tests/testthat/test-get_order.R
new file mode 100644
index 0000000..0abb018
--- /dev/null
+++ b/tests/testthat/test-get_order.R
@@ -0,0 +1,15 @@
+test_that("get_order returns a character vector", {
+	p <- 10
+	X <- matrix(rnorm(100), ncol = p)
+	R <- cor(X)
+	R_order <- get_order(R)
+	is.character(R_order)
+})
+
+test_that("get_order returns a character vector the same length as p and n", {
+	p <- 10
+	X <- matrix(rnorm(100), ncol = p)
+	R <- cor(X)
+	R_order <- get_order(R)
+	length(R_order) == p
+})