From 8ecb3a28a60290514dde24599564c34b9773e6a3 Mon Sep 17 00:00:00 2001
From: Chris Sobczak <chris@sobczak.family>
Date: Fri, 10 Jul 2026 16:42:21 -0700
Subject: Add performance metrics

---
 NAMESPACE                            |  1 +
 R/matrix_metrics.R                   | 50 ++++++++++++++++++++++++++++++++++++
 man/matrix_metrics.Rd                | 30 ++++++++++++++++++++++
 tests/testthat/test-matrix_metrics.R |  4 +++
 4 files changed, 85 insertions(+)
 create mode 100644 R/matrix_metrics.R
 create mode 100644 man/matrix_metrics.Rd
 create mode 100644 tests/testthat/test-matrix_metrics.R

diff --git a/NAMESPACE b/NAMESPACE
index 59ce237..c60048b 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+export(matrix_metrics)
 export(simulate_data)
 importFrom(MASS,mvrnorm)
 importFrom(stats,rchisq)
diff --git a/R/matrix_metrics.R b/R/matrix_metrics.R
new file mode 100644
index 0000000..08521b0
--- /dev/null
+++ b/R/matrix_metrics.R
@@ -0,0 +1,50 @@
+#' Matrix Metrics
+#'
+#' Measure the performance of a covariance or correlation
+#' matrix estimate with various metrics.
+#'
+#' @param S_true The true covariance matrix.
+#' @param R_hat The estimate correlation matrix.
+#' @param strong Eigenvalues strength threshold (default 0.75).
+#'
+#' @return A data.frame with 5 metrics.
+#'
+#' @examples
+#' X_obj <- simulate_data(n = 10, p = 10)
+#' X <- X_obj$X
+#' S_true <- X_obj$S
+#' R_hat <- cor(X)
+#' results <- matrix_metrics(S_true, R_hat)
+#'
+#' @export
+matrix_metrics <- function(S_true, R_hat, strong = 0.75){
+	p <- nrow(S_true)
+	D <- S_true - R_hat
+
+	rmse <- sqrt(mean(D^2))
+	# NOTE: Serra's text is ambiguous on squared-vs-not. This uses ||.||_F / sqrt(p),
+	# the reading under which the identity matrix normalises to exactly 1. If you
+	# want the squared version, use sum(D^2)/p instead. Verify against RSC source.
+	L_F <- sqrt(sum(D^2)) / sqrt(p)
+
+	ev_t <- sort(eigen(S_true, symmetric = TRUE, only.values = TRUE)$values)
+	ev_h <- sort(eigen(R_hat,  symmetric = TRUE, only.values = TRUE)$values)
+	L_S  <- sum(abs(ev_t - ev_h))
+
+	lt <- lower.tri(S_true)          # unique off-diagonal pairs (v < l)
+	t0 <- S_true[lt]
+	th <- R_hat[lt]
+
+	E1 <- sum( (t0 == 0) & (abs(th) > strong) )
+	E2 <- sum( (th == 0) & (abs(t0) > strong) )
+	SS <- sum( (t0 > 0 & th < 0) | (t0 < 0 & th > 0) )
+
+	data.frame(
+		rmse = rmse,
+		L_F = L_F,
+		L_S = L_S,
+		E1 = E1,
+		E2 = E2,
+		SS = SS
+	)
+}
diff --git a/man/matrix_metrics.Rd b/man/matrix_metrics.Rd
new file mode 100644
index 0000000..d7beee0
--- /dev/null
+++ b/man/matrix_metrics.Rd
@@ -0,0 +1,30 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/matrix_metrics.R
+\name{matrix_metrics}
+\alias{matrix_metrics}
+\title{Matrix Metrics}
+\usage{
+matrix_metrics(S_true, R_hat, strong = 0.75)
+}
+\arguments{
+\item{S_true}{The true covariance matrix.}
+
+\item{R_hat}{The estimate correlation matrix.}
+
+\item{strong}{Eigenvalues strength threshold (default 0.75).}
+}
+\value{
+A data.frame with 5 metrics.
+}
+\description{
+Measure the performance of a covariance or correlation
+matrix estimate with various metrics.
+}
+\examples{
+X_obj <- simulate_data(n = 10, p = 10)
+X <- X_obj$X
+S_true <- X_obj$S
+R_hat <- cor(X)
+results <- matrix_metrics(S_true, R_hat)
+
+}
diff --git a/tests/testthat/test-matrix_metrics.R b/tests/testthat/test-matrix_metrics.R
new file mode 100644
index 0000000..e9348df
--- /dev/null
+++ b/tests/testthat/test-matrix_metrics.R
@@ -0,0 +1,4 @@
+test_that("Check that error is zero if the input matrices are the same object", {
+	results <- matrix_metrics(diag(10), diag(10))
+	expect_equal(results$rmse[1], 0)
+})
-- 
cgit v1.2.3