add parameter to control output class

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ripserr
 Title: Calculate Persistent Homology with Ripser-Based Engines
-Version: 1.0.0
+Version: 1.0.0.0003
 Authors@R:
     c(person(given = "Raoul R.",
              family = "Wadhwa",
@@ -79,7 +79,9 @@ Depends: R (>= 3.5.0)
 Imports: 
     Rcpp (>= 1.0),
     stats (>= 3.0),
-    utils (>= 3.0)
+    utils (>= 3.0),
+    phutil,
+    lifecycle
 Suggests: 
     covr (>= 3.5),
     knitr (>= 1.29),

NAMESPACE

@@ -2,6 +2,7 @@
 
 S3method(cubical,array)
 S3method(cubical,matrix)
+S3method(cubical,numeric)
 S3method(head,PHom)
 S3method(print,PHom)
 S3method(tail,PHom)
@@ -17,6 +18,7 @@ export(as.PHom)
 export(cubical)
 export(cubical.array)
 export(cubical.matrix)
+export(cubical.numeric)
 export(is.PHom)
 export(vietoris_rips)
 export(vietoris_rips.data.frame)

NEWS.md

@@ -1,17 +1,31 @@
 # next version
 
-## permission for deaths before births and superlevel set filtrations of rasters
+### output class
 
-A logical argument `sublevel` has been added to `cubical` that, when `FALSE`, will pre- and post-transform raster data in order to obtain superlevel set persistent homology.
-Enabling this, an assertion that all `birth < death` has been removed from checks of persistence data.
+The new `return_class` parameter allows the user to specify whether to output persistence data in the legacy `'PHom'` class or the `'persistence'` class from {phutil}.
+It defaults to `'PHom'` but will switch to `'persistence'` when the `'PHom'` class is deprecated in a future version.
+
+## Vietoris-Rips PH
 
-## sliding window embeddings of multivariable time series (breaking change)
+### sliding window embeddings of multivariable time series (breaking change)
 
 Previously only univariable time series could be passed to `vietoris_rips()` via the sliding window embedding (used for quasi-attractor detection).
 An additional unexported embedding function has been written to handle multivariable time series. (It underperforms the original function on univariable time series, which therefore continue to rely on the original.)
 
 Furthermore, whereas `data_dim` previously defaulted to `2`, it now defaults to the number of observations per time unit of a time series as recovered by `tsp()`. (The behavior for unclassed numeric vectors remains unchanged.)
 
+## cubical PH
+
+### functionality for 1-dimensional arrays
+
+`cubical()` can now handle 1-dimensional arrays (for which no dedicated source code exists) by treating them as 2-dimensional (with an expanse of 1 in the second dimension).
+This enables the new method `cubical.numeric()` to accept vectors.
+
+### deaths before births and superlevel set filtrations
+
+A logical argument `sublevel` has been added to `cubical` that, when `FALSE`, will pre- and post-transform raster data in order to obtain superlevel set persistent homology.
+Enabling this, an assertion that all `birth < death` has been removed from checks of persistence data.
+
 # ripserr 1.0.0
 
 This major version replaces an outdated version of the Ripser C++ library with its current version.

R/PHom.R

@@ -11,6 +11,13 @@ new_PHom <- function(x = data.frame(dimension = integer(0),
                      dim_col = 1,
                      b_col = 2,
                      d_col = 3) {
+  lifecycle::deprecate_soft(
+    "1.1.0",
+    I("'PHom' class"),
+    with = I("'persistence' from the {phutil} package"),
+    id = "PHom"
+  )
+
   # parameter validity checked in PHom helper
 
   # construct df for PHom object
@@ -118,6 +125,13 @@ valid_colval <- function(df, val, val_name) {
 #' # print feature details to confirm accuracy
 #' print.data.frame(df_phom)
 PHom <- function(x, dim_col = 1, birth_col = 2, death_col = 3) {
+  lifecycle::deprecate_soft(
+    "1.1.0",
+    I("'PHom' class"),
+    with = I("'persistence' from the {phutil} package"),
+    id = "PHom"
+  )
+
   ## basic parameter checks (column nums/names are valid, etc.)
   if (!is.data.frame(x)) {
     x <- as.data.frame(x)
@@ -163,6 +177,13 @@ PHom <- function(x, dim_col = 1, birth_col = 2, death_col = 3) {
 #' # print feature details to confirm accuracy
 #' print.data.frame(df_phom)
 as.PHom <- function(x, dim_col = 1, birth_col = 2, death_col = 3) {
+  lifecycle::deprecate_soft(
+    "1.1.0",
+    I("'PHom' class"),
+    with = I("'persistence' from the {phutil} package"),
+    id = "PHom"
+  )
+
   x <- as.data.frame(x)
 
   return(PHom(x))
@@ -191,6 +212,13 @@ as.PHom <- function(x, dim_col = 1, birth_col = 2, death_col = 3) {
 #' # confirm that persistence data is NOT valid
 #' is.PHom(df)
 is.PHom <- function(x) {
+  lifecycle::deprecate_soft(
+    "1.1.0",
+    I("'PHom' class"),
+    with = I("'persistence' from the {phutil} package"),
+    id = "PHom"
+  )
+
   # use validate to implement checks
   return(
     validate_PHom(x = x, error = FALSE)
@@ -243,7 +271,7 @@ print.PHom <- function(x, ...) {
                         "; max = ",
                         signif(max(x$death[is.finite(x$death)], na.rm = TRUE),
                                digits = 5),
-                        "."),
+                        ".\n"),
                  "")
 
   cat(paste(ans1, ans2, ans3, sep = "\n\n"))

R/cubical.R

@@ -21,22 +21,28 @@
 #' @param ... other relevant parameters
 #' @rdname cubical
 #' @export cubical
-#' @return `PHom` object
+#' @return `"PHom"` or [`"persistence"`][phutil::as_persistence] object
 #' @examples 
 #' 
+#' # 1-dim example
+#' dataset <- rnorm(1500)
+#' dim(dataset) <- 1500
+#' cubical_hom1 <- cubical(dataset)
+#' 
 #' # 2-dim example
 #' dataset <- rnorm(10 ^ 2)
 #' dim(dataset) <- rep(10, 2)
-#' cubical_hom2 <- cubical(dataset)
+#' ( cubical_hom2 <- cubical(dataset) )
 #' 
 #' # 3-dim example
 #' dataset <- rnorm(8 ^ 3)
 #' dim(dataset) <- rep(8, 3)
-#' cubical_hom3 <- cubical(dataset)
+#' ( cubical_hom3 <- cubical(dataset) )
 #' 
 #' # 4-dim example
 #' dataset <- rnorm(5 ^ 4)
 #' dim(dataset) <- rep(5, 4)
+#' ( cubical_hom4 <- cubical(dataset) )
 #' 
 #' # sublevel versus superlevel
 #' cubical(volcano)
@@ -56,12 +62,17 @@ cubical <- function(dataset, ...) {
 #'   see Kaji et al. (2020) <https://arxiv.org/abs/2005.12692> for details
 #' @param sublevel logical; whether to take the sublevel set filtration or else
 #'   the superlevel set filtration
+#' @param return_class class of output object; either `"PHom"` (default; legacy)
+#'   or `"persistence"` (from the
+#'   **[phutil](https://cran.r-project.org/package=phutil)** package)
 #' @export cubical.array
 #' @export
 cubical.array <- function(
     dataset,
-    threshold = 9999, method = "lj",
+    threshold = 9999,
+    method = "lj",
     sublevel = TRUE,
+    return_class = c("PHom", "persistence"),
     ...
 ) {
   # do this before checks since it modifies `dataset`
@@ -74,6 +85,8 @@ cubical.array <- function(
                       method = method)
   validate_arr_cub(dataset)
 
+  # if dataset is 1-dimensional, treat it as 2-dimensional
+  if (length(dim(dataset)) == 1L) dim(dataset) <- c(dim(dataset), 1L)
 
   # transform method parameter for C++ function
   method_int <- switch(method,
@@ -124,7 +137,24 @@ cubical.array <- function(
   ans$dimension <- as.integer(ans$dimension)
 
   # convert data frame to a PHom object
-  ans <- new_PHom(ans)
+  ans <- switch(
+    match.arg(return_class),
+    PHom = {
+      lifecycle::deprecate_soft(
+        "1.1.0",
+        I("'PHom' class"),
+        with = I("'persistence' from the {phutil} package"),
+        id = "PHom"
+      )
+      new_PHom(ans)
+    },
+    persistence = phutil::as_persistence(
+      ans,
+      engine = "ripserr::cubical",
+      filtration = "cubical",
+      parameters = list(threshold = threshold, method = method)
+    )
+  )
 
   # return
   return(ans)
@@ -146,4 +176,17 @@ cubical.matrix <- function(dataset, ...) {
 
   # return
   return(ans)
-}
+}
+
+#' @rdname cubical
+#' @export cubical.numeric
+#' @export
+cubical.numeric <- function(dataset, ...) {
+  # convert the numeric vector to a 1-dimensional array
+  dataset <- as.array(dataset, dim = 1L)
+
+  # calculate persistent homology using cubical.array
+  ans <- cubical.array(dataset, ...)
+
+  return(ans)
+}

R/utility.R

@@ -122,7 +122,7 @@ validate_arr_cub <- function(dataset) {
   error_class(dataset, "dataset", "array")
 
   # dataset should have either 2, 3, or 4 dimensions (only ones supported)
-  if (!(length(dim(dataset)) %in% c(2, 3, 4))) {
+  if (!(length(dim(dataset)) %in% seq(4))) {
     stop(paste("dataset parameter must have either 2, 3, or 4 dimensions,",
                "passed argument has", length(dim(dataset)), "dimensions"))
   }
@@ -139,7 +139,11 @@ validate_arr_cub <- function(dataset) {
   }
 
   # make sure dataset is not too large
-  if (length(dim(dataset)) == 2) {
+  if (length(dim(dataset)) == 1L) {
+    if (dim(dataset) > 2000) {
+      stop(paste("Max size for dim 1 = 2000; passed size =", dim(dataset)))
+    }
+  } else if (length(dim(dataset)) == 2) {
     if (dim(dataset)[1] > 2000 |
         dim(dataset)[2] > 1000) {
       stop(paste("Max size for dim 2 = 2000 x 1000; passed size =",