From 88c5059ffc0bd3fb41e4ffa17957e514d1296f48 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Sun, 26 Oct 2025 13:34:33 -0400 Subject: [PATCH 1/2] draft as_diagram with persistence method + example + test --- NAMESPACE | 2 ++ R/persistence-class.R | 31 ++++++++++++++++++++++++++ inst/tinytest/test-persistence-class.R | 16 +++++++++++++ man/persistence.Rd | 16 +++++++++++++ 4 files changed, 65 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 6db930c..f7b606d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,6 +2,7 @@ S3method(as.data.frame,persistence) S3method(as.matrix,persistence) +S3method(as_diagram,persistence) S3method(as_persistence,PHom) S3method(as_persistence,data.frame) S3method(as_persistence,diagram) @@ -13,6 +14,7 @@ S3method(format,persistence) S3method(format,persistence_set) S3method(print,persistence) S3method(print,persistence_set) +export(as_diagram) export(as_persistence) export(as_persistence_set) export(bottleneck_distance) diff --git a/R/persistence-class.R b/R/persistence-class.R index 3fed9f4..019c53e 100644 --- a/R/persistence-class.R +++ b/R/persistence-class.R @@ -47,6 +47,8 @@ #' leaves were born. Defaults to `0` if all heights are non-negative and #' `-Inf` otherwise. #' @inheritParams base::as.data.frame +#' @param list Logical; whether to return the `diagram` object as the sole +#' element of a list. Defaults to `TRUE` for consistency with the TDA package. #' @returns An object of class [`persistence`] which is a list of 2 elements: #' @@ -85,6 +87,13 @@ #' #' as.data.frame(x) #' +#' # back and forth between `diagram` and `persistence` +#' x <- tdaunif::sample_projective_plane(n = 12) +#' ( d <- TDA::alphaComplexDiag(x, maxdimension = 2) ) +#' ( p <- as_persistence(d) ) +#' as_diagram(p) +#' as_diagram(p, list = FALSE) +#' #' # distances between cities #' euroclust <- hclust(eurodist, method = "ward.D") #' as_persistence(euroclust) @@ -428,3 +437,25 @@ as.data.frame.persistence <- function( } df } + +#' @rdname persistence +#' @export +as_diagram <- function(x, ...) { + UseMethod("as_diagram") +} + +#' @rdname persistence +#' @export +as_diagram.persistence <- function(x, list = TRUE, ...) { + res <- as.matrix.persistence(x) + # NB: {TDA} may produce diagrams with `Death` column before `Bith`. + colnames(res)[match(c("birth", "death"), colnames(res))] <- + c("Birth", "Death") + class(res) <- "diagram" + attr(res, "maxdimension") <- max(res[, 1L]) + attr(res, "scale") <- + range(res[! apply(is.infinite(res[, c(2L, 3L)]), 1, any), c(2L, 3L)]) + attr(res, "call") <- x$metadata$call + if (list) res <- list(diagram = res) + res +} diff --git a/inst/tinytest/test-persistence-class.R b/inst/tinytest/test-persistence-class.R index 5c15f2c..9dc9c4d 100644 --- a/inst/tinytest/test-persistence-class.R +++ b/inst/tinytest/test-persistence-class.R @@ -161,4 +161,20 @@ expect_equal(xm[, "dimension"], c(0L, 0L, 1L, 1L)) expect_equal(xm[, "birth"], c(0, 1, 0, 1)) expect_equal(xm[, "death"], c(2, 3, 2, 3)) +# Test that as_diagram() works + +x <- cbind(x = runif(6), y = runif(6)) + +d <- TDA::alphaComplexDiag(x, maxdimension = 2) +p <- as_persistence(d) +expect_true(is.list(as_diagram(p))) +expect_true(! is.list(as_diagram(p, list = FALSE))) +expect_identical(as_diagram(p), d) + +d <- TDA::ripsDiag(x, maxdimension = 2, maxscale = 1.5) +p <- as_persistence(d) +expect_true(is.list(as_diagram(p))) +expect_true(! is.list(as_diagram(p, list = FALSE))) +expect_identical(as_diagram(p), d) + options(opts) diff --git a/man/persistence.Rd b/man/persistence.Rd index 8e76264..18287a5 100644 --- a/man/persistence.Rd +++ b/man/persistence.Rd @@ -15,6 +15,8 @@ \alias{get_pairs} \alias{as.matrix.persistence} \alias{as.data.frame.persistence} +\alias{as_diagram} +\alias{as_diagram.persistence} \title{An \code{S3} class for storing persistence data} \usage{ as_persistence(x, warn = TRUE, ...) @@ -42,6 +44,10 @@ get_pairs(x, dimension, ...) \method{as.matrix}{persistence}(x, ...) \method{as.data.frame}{persistence}(x, row.names = NULL, optional = TRUE, ...) + +as_diagram(x, ...) + +\method{as_diagram}{persistence}(x, list = TRUE, ...) } \arguments{ \item{x}{An \code{R} object containing the persistence data to be coerced into an @@ -89,6 +95,9 @@ which to recover a matrix of persistence pairs.} \code{optional} only for column names treatment, basically with the meaning of \code{\link[base]{data.frame}(*, check.names = !optional)}. See also the \code{make.names} argument of the \code{matrix} method.} + +\item{list}{Logical; whether to return the \code{diagram} object as the sole +element of a list. Defaults to \code{TRUE} for consistency with the TDA package.} } \value{ An object of class \code{\link{persistence}} which is a list of 2 elements: @@ -146,6 +155,13 @@ get_pairs(x, dimension = 1) as.data.frame(x) +# back and forth between `diagram` and `persistence` +x <- tdaunif::sample_projective_plane(n = 12) +( d <- TDA::alphaComplexDiag(x, maxdimension = 2) ) +( p <- as_persistence(d) ) +as_diagram(p) +as_diagram(p, list = FALSE) + # distances between cities euroclust <- hclust(eurodist, method = "ward.D") as_persistence(euroclust) From 0fdd1699ae521257b1b14e9ee58a218e9bc79efe Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Sun, 26 Oct 2025 15:23:18 -0400 Subject: [PATCH 2/2] write as_diagram method for phom class --- NAMESPACE | 1 + R/persistence-class.R | 12 ++++++++++++ inst/tinytest/test-persistence-class.R | 4 ++++ man/persistence.Rd | 3 +++ 4 files changed, 20 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index f7b606d..7767015 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,6 +2,7 @@ S3method(as.data.frame,persistence) S3method(as.matrix,persistence) +S3method(as_diagram,PHom) S3method(as_diagram,persistence) S3method(as_persistence,PHom) S3method(as_persistence,data.frame) diff --git a/R/persistence-class.R b/R/persistence-class.R index 019c53e..0a9aba2 100644 --- a/R/persistence-class.R +++ b/R/persistence-class.R @@ -459,3 +459,15 @@ as_diagram.persistence <- function(x, list = TRUE, ...) { if (list) res <- list(diagram = res) res } + +#' @rdname persistence +#' @export +as_diagram.PHom <- function(x, list = TRUE, ...) { + res <- cbind(dimension = x$dimension, Birth = x$birth, Death = x$death) + class(res) <- "diagram" + attr(res, "maxdimension") <- max(res[, 1L]) + attr(res, "scale") <- + range(res[! apply(is.infinite(res[, c(2L, 3L)]), 1, any), c(2L, 3L)]) + if (list) res <- list(diagram = res) + res +} diff --git a/inst/tinytest/test-persistence-class.R b/inst/tinytest/test-persistence-class.R index 9dc9c4d..26f8ff2 100644 --- a/inst/tinytest/test-persistence-class.R +++ b/inst/tinytest/test-persistence-class.R @@ -177,4 +177,8 @@ expect_true(is.list(as_diagram(p))) expect_true(! is.list(as_diagram(p, list = FALSE))) expect_identical(as_diagram(p), d) +h <- ripserr::cubical(volcano) +expect_true(is.list(as_diagram(h))) +expect_true(! is.list(as_diagram(h, list = FALSE))) + options(opts) diff --git a/man/persistence.Rd b/man/persistence.Rd index 18287a5..98e9f42 100644 --- a/man/persistence.Rd +++ b/man/persistence.Rd @@ -17,6 +17,7 @@ \alias{as.data.frame.persistence} \alias{as_diagram} \alias{as_diagram.persistence} +\alias{as_diagram.PHom} \title{An \code{S3} class for storing persistence data} \usage{ as_persistence(x, warn = TRUE, ...) @@ -48,6 +49,8 @@ get_pairs(x, dimension, ...) as_diagram(x, ...) \method{as_diagram}{persistence}(x, list = TRUE, ...) + +\method{as_diagram}{PHom}(x, list = TRUE, ...) } \arguments{ \item{x}{An \code{R} object containing the persistence data to be coerced into an