From ea489f0b5cb7919dfc32d4e33def5af46807b504 Mon Sep 17 00:00:00 2001 From: Chris Sobczak Date: Mon, 6 Jul 2026 15:13:21 -0700 Subject: Add ordering function --- NAMESPACE | 3 +++ R/get_order.R | 45 +++++++++++++++++++++++++++++++++++++++++ man/get_order.Rd | 26 ++++++++++++++++++++++++ tests/testthat/test-get_order.R | 15 ++++++++++++++ 4 files changed, 89 insertions(+) create mode 100644 R/get_order.R create mode 100644 man/get_order.Rd create mode 100644 tests/testthat/test-get_order.R 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 +}) -- cgit v1.2.3