as_diagram method

NAMESPACE

@@ -2,6 +2,8 @@
 
 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)
 S3method(as_persistence,diagram)
@@ -13,6 +15,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)

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,37 @@ 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
+}
+
+#' @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
+}

inst/tinytest/test-persistence-class.R

@@ -161,4 +161,24 @@ 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)
+
+h <- ripserr::cubical(volcano)
+expect_true(is.list(as_diagram(h)))
+expect_true(! is.list(as_diagram(h, list = FALSE)))
+
 options(opts)