Integration with {infer}

[mgaeta04]

This is a part of my project that I have been working on for the last few weeks with @corybrunson. It would be useful to provide a library of functions in {inphr} that are functionally equivalent to tidymodels {infer}. I've begun by writing a function that works similarly to tidymodels specify(). This function has a rather disorganized str() output, so it likely needs its own print method. Below is my current code:

library(inphr)
ph_specify <- function(x, y) {
  
  check_persistence_set <- function(obj, arg) {     
    # Function verifies that input data is of the correct format
    
    ok <-
      inherits(obj, "persistence_set") ||   
      (
        is.list(obj) &&
          length(obj) > 0 &&
          all(vapply(obj, inherits, logical(1), "persistence"))
      )
    
    if (!ok) {
      cli::cli_abort(
        "{.arg {arg}} must be a persistence_set or a list of persistence objects."
      )
    }
    
    invisible(obj)
  }
  
  check_persistence_set(x, "x")
  check_persistence_set(y, "y")
  
  # str() output
  structure(
    list(
      data = c(x, y),
      groups = factor(c(
        rep("x", length(x)),
        rep("y", length(y))
      )),
      sample_sizes = c(length(x), length(y))
    ),
    class = "inphr_specified"
  )
}


spec <- ph_specify(trefoils1[1], trefoils2[1])
spec
#> $data
#> $data[[1]]
#> 
#> ── Persistence Data ────────────────────────────────────────────────────────────
#> ℹ There are 120, 5, and 1 pairs in dimensions 0, 1, and 2 respectively.
#> ℹ Computed from a Vietoris-Rips filtration using `TDA::ripsDiag()`.
#> ℹ With the following parameters: maxdimension = 2 and maxscale = 6.
#> 
#> $data[[2]]
#> 
#> ── Persistence Data ────────────────────────────────────────────────────────────
#> ℹ There are 120, 5, and 1 pairs in dimensions 0, 1, and 2 respectively.
#> ℹ Computed from a Vietoris-Rips filtration using `TDA::ripsDiag()`.
#> ℹ With the following parameters: maxdimension = 2 and maxscale = 6.
#> 
#> 
#> $groups
#> [1] x y
#> Levels: x y
#> 
#> $sample_sizes
#> [1] 1 1
#> 
#> attr(,"class")
#> [1] "inphr_specified"
str(spec)
#> List of 3
#>  $ data        :List of 2
#>   ..$ :List of 2
#>   .. ..$ pairs   :List of 3
#>   .. .. ..$ : num [1:120, 1:2] 0 0 0 0 0 0 0 0 0 0 ...
#>   .. .. ..$ : num [1:5, 1:2] 1.02 1.1 1.08 1.19 1.82 ...
#>   .. .. ..$ : num [1, 1:2] 2.05 2.07
#>   .. ..$ metadata:List of 6
#>   .. .. ..$ ordered_pairs: logi TRUE
#>   .. .. ..$ data         : symbol S1
#>   .. .. ..$ engine       : chr "TDA::ripsDiag"
#>   .. .. ..$ filtration   : chr "Vietoris-Rips"
#>   .. .. ..$ call         : language TDA::ripsDiag(X = S1, maxdimension = 2, maxscale = 6)
#>   .. .. ..$ parameters   :List of 2
#>   .. .. .. ..$ maxdimension: num 2
#>   .. .. .. ..$ maxscale    : num 6
#>   .. ..- attr(*, "class")= chr "persistence"
#>   ..$ :List of 2
#>   .. ..$ pairs   :List of 3
#>   .. .. ..$ : num [1:120, 1:2] 0 0 0 0 0 0 0 0 0 0 ...
#>   .. .. ..$ : num [1:5, 1:2] 1.02 1.1 1.08 1.19 1.82 ...
#>   .. .. ..$ : num [1, 1:2] 2.05 2.07
#>   .. ..$ metadata:List of 6
#>   .. .. ..$ ordered_pairs: logi TRUE
#>   .. .. ..$ data         : symbol S1
#>   .. .. ..$ engine       : chr "TDA::ripsDiag"
#>   .. .. ..$ filtration   : chr "Vietoris-Rips"
#>   .. .. ..$ call         : language TDA::ripsDiag(X = S1, maxdimension = 2, maxscale = 6)
#>   .. .. ..$ parameters   :List of 2
#>   .. .. .. ..$ maxdimension: num 2
#>   .. .. .. ..$ maxscale    : num 6
#>   .. ..- attr(*, "class")= chr "persistence"
#>  $ groups      : Factor w/ 2 levels "x","y": 1 2
#>  $ sample_sizes: int [1:2] 1 1
#>  - attr(*, "class")= chr "inphr_specified"

I am continuing to work on a functional equivalent of hypothesize(), the next function in the {infer} workflow.

[corybrunson]

Thank you @mgaeta04 ! To ensure that i can reproduce your results, could you replace the code chunks in your OP with the results of a reproducible example using {reprex}? I'm currently getting different output but can't be sure i executed the same commands.

[mgaeta04]

@corybrunson I updated my issue code with the {reprex} package. Let me know if you are still having issues running the code!

[corybrunson]

Thanks! Yes, i was attempting spec <- ph_specify(trefoils1, trefoils2) rather than spec <- ph_specify(trefoils1[1], trefoils2[1]). The former is of course the more realistic test but i assume the latter demonstrated the function but shortened the printed output.

Objects obtained via infer::specify() receive the "infer" class (check the source code of infer::specify and of infer:::append_infer_class), which carries a convenient print() method (run methods(class = "infer")). Would you be able to assign the result both classes "inphr" (or "inphr_specified") and "infer" so that this print() method can be inherited? It would mean making sure that infer:::print.infer() can find everything it needs in the object.

I also just noticed that the tidyverse package {generics} contains a generic specify() function, which means that we have the permission structure (i.e. we could get away with it) to write a new specify.<class>() if we want, rather than ph_specify().

[mgaeta04]

@corybrunson I've updated the function to classify the output as infer. I may submit a PR of this version of the function, but let me know if there are additional adjustments I should make.

ph_specify <- function(x, y) {
  
  check_persistence_set <- function(obj, arg) {
    
    ok <-
      inherits(obj, "persistence_set") ||   
      (
        is.list(obj) &&
          length(obj) > 0 &&
          all(vapply(obj, inherits, logical(1), "persistence"))
      )
    
    if (!ok) {
      cli::cli_abort(
        "{.arg {arg}} must be a persistence_set or a list of persistence objects."
      )
    }
    
    invisible(obj)
  }
  
  check_persistence_set(x, "x")
  check_persistence_set(y, "y")
  
  structure(
    list(
      data = c(x, y),
      groups = factor(c(
        rep("x", length(x)),
        rep("y", length(y))
      )),
      sample_sizes = c(length(x), length(y))
    ),
    class = c("inphr, infer")
  )
}

[corybrunson]

Thanks @mgaeta04 ! I'd say to go ahead and implement this (in a new branch) with documentation (see existing exported functions for how to style things consistently with the rest of the package). Then submit a PR. We can negotiate details directly on the new branch while the PR is open, then merge it once we're satisfied. This way, we can both install and try out the current proposal from the same source code.