From 92b34022d6aab62f2290134da64aabecf3c339ba Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Wed, 27 Mar 2024 11:49:24 -0400 Subject: [PATCH] refactor maximal one simplices calculation + placeholder file for persistence engines tests --- R/simplicial-complex-engines.R | 44 ++++++++----------- man/simplicial_complex.Rd | 30 ------------- tests/testthat/test-persistence-engines.R | 0 .../test-simplicial-complex-engines.R | 4 +- 4 files changed, 20 insertions(+), 58 deletions(-) create mode 100644 tests/testthat/test-persistence-engines.R diff --git a/R/simplicial-complex-engines.R b/R/simplicial-complex-engines.R index 130b240..0587b28 100644 --- a/R/simplicial-complex-engines.R +++ b/R/simplicial-complex-engines.R @@ -47,9 +47,7 @@ simplicial_complex_base <- function( df_high_simplices <- indices_to_data(data, faces) - } - - if (complex == "Cech") { + } else if (complex == "Cech") { edges <- proximate_pairs(data, diameter) df_one_simplices <- indices_to_data(data, edges) @@ -63,8 +61,9 @@ simplicial_complex_base <- function( # Pair down to maximal simplices if necessary # necessary <=> only want maximal 0/1-simplices AND no higher simplices if (one_simplices == "maximal" && dimension_max > 1L) { - df_one_simplices <- - get_maximal_one_simplices(edges, faces, df_one_simplices) + edges_maximal <- are_edges_maximal(edges, faces) + df_one_simplices <- + df_one_simplices[rep(edges_maximal, each = 2L), , drop = FALSE] } if (zero_simplices == "maximal" && dimension_max > 0L) { df_zero_simplices <- @@ -175,8 +174,9 @@ simplicial_complex_RTriangle <- function( # Pair down to maximal simplices if necessary # necessary <=> only want maximal 0/1-simplices AND no higher simplices if (one_simplices == "maximal" && dimension_max > 1L) { + edges_maximal <- are_edges_maximal(edges, faces) df_one_simplices <- - get_maximal_one_simplices(edges, faces, df_one_simplices) + df_one_simplices[rep(edges_maximal, each = 2L), , drop = FALSE] } if (zero_simplices == "maximal" && dimension_max > 0L) { df_zero_simplices <- @@ -234,24 +234,15 @@ indices_to_data <- function( } -# Get maximal one_simplices from edges + faces (subset of df_one_simplices) -# Pretty computationally expensive: O(|1-simplices| x |2-simplices|)? -get_maximal_one_simplices <- function(edges, faces, df_one_simplices) { - - edges_unique <- apply(edges, 1L, is_maximal, faces) - - are_maximal <- rep(edges_unique, each = 2L) - df_one_simplices[are_maximal, , drop = FALSE] - -} - -# Determine if edge is contained in faces (is edge a maximal simplex) -is_maximal <- function(edge, faces) { - - res <- apply(faces, 1L, function(face) all(edge %in% face)) - - ! any(res) - +# Which edges in an edge matrix are contained in some face of a face matrix? +are_edges_maximal <- function(edges, faces) { + if (nrow(as.matrix(edges)) == 0L) return(logical(0L)) + ! apply( + apply( + outer(as.matrix(edges), as.matrix(faces), `==`), + c(1L, 2L), any + ), 1L, all + ) } # Get maximal 0-simplices from edges + vertices (rows of df_zero_simplices) @@ -509,7 +500,7 @@ simplicial_complex_TDA <- function( # specified edges if (one_simplices == "maximal" && dimension_max > 1L) { - edges_maximal <- apply(edges, 1L, is_maximal, faces) + edges_maximal <- are_edges_maximal(edges, faces) edges <- edges[edges_maximal, , drop = FALSE] } # 1-simplices, preserving plotting data @@ -521,8 +512,9 @@ simplicial_complex_TDA <- function( id = rep(seq_along(pd_dim[pd_high]), pd_dim[pd_high] + 1L), dimension = rep(pd_dim[pd_high], pd_dim[pd_high] + 1L) ) + df_high_order <- order(df_high_simplices$dimension, df_high_simplices$id) df_high_simplices <- - df_high_simplices[order(df_combin$dimension, df_combin$id), , drop = FALSE] + df_high_simplices[df_high_order, , drop = FALSE] df_high_simplices <- merge( transform(data, row = seq(nrow(data))), df_high_simplices, diff --git a/man/simplicial_complex.Rd b/man/simplicial_complex.Rd index bc587dd..6a8b4b7 100644 --- a/man/simplicial_complex.Rd +++ b/man/simplicial_complex.Rd @@ -192,36 +192,6 @@ Learn more about setting these aesthetics in \code{vignette("ggplot2-specs", pac \examples{ -# equilateral triangle -equilateral_triangle <- - data.frame(x = cos(2*pi*c(0,1/3,2/3)), y = sin(2*pi*c(0,1/3,2/3))) -# small perturbations from key values -eps <- .00000001 - -# Vietoris-Rips -ggplot(equilateral_triangle, aes(x, y)) + - coord_fixed() + - geom_simplicial_complex(diameter = sqrt(3) - eps) -ggplot(equilateral_triangle, aes(x, y)) + - coord_fixed() + - geom_simplicial_complex(diameter = sqrt(3) + eps) - -# Čech -ggplot(equilateral_triangle, aes(x, y)) + - coord_fixed() + - geom_simplicial_complex(complex = "Cech", diameter = sqrt(3) - eps) -ggplot(equilateral_triangle, aes(x, y)) + - coord_fixed() + - geom_simplicial_complex(complex = "Cech", diameter = sqrt(3) + eps) - -# alpha -ggplot(equilateral_triangle, aes(x, y)) + - coord_fixed() + - geom_simplicial_complex(complex = "alpha", diameter = sqrt(3) - eps) -ggplot(equilateral_triangle, aes(x, y)) + - coord_fixed() + - geom_simplicial_complex(complex = "alpha", diameter = sqrt(3) + eps) - set.seed(1) s <- seq(0, 2*pi, length.out = 40) df <- data.frame( diff --git a/tests/testthat/test-persistence-engines.R b/tests/testthat/test-persistence-engines.R new file mode 100644 index 0000000..e69de29 diff --git a/tests/testthat/test-simplicial-complex-engines.R b/tests/testthat/test-simplicial-complex-engines.R index dcd96b4..1d4eb06 100644 --- a/tests/testthat/test-simplicial-complex-engines.R +++ b/tests/testthat/test-simplicial-complex-engines.R @@ -1,7 +1,7 @@ df <- data.frame( - x = c(1, -0.5, -0.5), - y = c(0, 0.866025403784439, -0.866025403784438), + x = c(1, -1/2, -1/2), + y = c(0, sqrt(3)/2, - sqrt(3)/2), PANEL = structure(c(1L, 1L, 1L), levels = "1", class = "factor"), group = c(-1L, -1L, -1L) )