diff --git a/DESCRIPTION b/DESCRIPTION index 76e4473..16e81e5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -45,4 +45,4 @@ VignetteBuilder: Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.2 +RoxygenNote: 7.3.3 diff --git a/inst/tinytest/test-persistence-class.R b/inst/tinytest/test-persistence-class.R index 5c15f2c..1cd9d3f 100644 --- a/inst/tinytest/test-persistence-class.R +++ b/inst/tinytest/test-persistence-class.R @@ -1,6 +1,6 @@ using("tinysnapshot") -opts <- options(cli.width = 80) +opts <- options(cli.width = 80, cli.hyperlink = FALSE) m <- as.matrix(noisy_circle_ripserr) diff --git a/inst/tinytest/test-persistence.R b/inst/tinytest/test-persistence.R new file mode 100644 index 0000000..24943bd --- /dev/null +++ b/inst/tinytest/test-persistence.R @@ -0,0 +1,168 @@ +mat <- matrix(c(0, 1, 2, 1, 0.5, 2, 2, 1, 3), ncol = 3, byrow = TRUE) +colnames(mat) <- c("dimension", "birth", "death") +pd <- as_persistence(mat) +df <- data.frame( + dimension = c(1, 1, 1, 1, 1), + birth = c(1, .6, 1.3, 2.1, 1.99), + death = c(2, 1.2, .7, 4.2, 1.99) +) + + +#as_persistence.default correctly processes a basic matrix" +expect_inherits(pd, "persistence") +expect_equal(length(pd$pairs), 3) # 3 unique degrees (0,1,2) +expect_equal( + unname(pd$pairs[[1]]), + matrix(c(1, 2), ncol = 2), + ignore_attr = TRUE +) # Degree 0 +expect_equal( + unname(pd$pairs[[2]]), + matrix(c(0.5, 2), ncol = 2), + ignore_attr = TRUE +) # Degree 1 +expect_equal( + unname(pd$pairs[[3]]), + matrix(c(1, 3), ncol = 2), + ignore_attr = TRUE +) # Degree 2 + +#correctly processes output from `____$diag` from the {TDA} package +coords <- df[, c("birth", "death")] + +df3d <- t(data.frame( + w = c(1.1, -.2, 1.07), + x = c(1.3, 2.1, 1.99), + y = c(0.7, 4.2, 1.99), + z = c(0.2, 0.4, 0.35) +)) + +pd <- TDA::alphaComplexDiag(df3d, maxdimension = 1)$diagram +pd[, c(2, 3)] <- sqrt(pd[, c(2, 3)]) +pd_p <- as_persistence(pd) + +expect_inherits(pd_p, "persistence") +expect_equal(pd_p$metadata$parameters$maxdimension, 1) +expect_equal(length(pd_p$pairs[[1]][1, ]), 2) #correct Format + + +pd2 <- TDA::alphaShapeDiag(df3d, maxdimension = 2)$diagram +pd2[, c(2, 3)] <- sqrt(pd2[, c(2, 3)]) +pd_p2 <- as_persistence(pd2) + +expect_inherits(pd_p2, "persistence") +expect_equal(pd_p$metadata$parameters$maxdimension, 1) +expect_equal(length(pd_p2$pairs[[1]][1, ]), 2) #correct Format + + +FltRips <- TDA::ripsFiltration( + X = df, + maxdimension = 1, + maxscale = 1.5, + dist = "euclidean", + library = "Dionysus", + printProgress = FALSE +) +DiagFltRips <- TDA::filtrationDiag( + filtration = FltRips, + maxdimension = 1, + library = "Dionysus", + location = TRUE, + printProgress = FALSE +) +pd3 <- DiagFltRips$diagram +pd3[, c(2, 3)] <- sqrt(pd3[, c(2, 3)]) +pd_p3 <- as_persistence(pd3) + +expect_inherits(pd_p3, "persistence") +expect_equal(pd_p3$metadata$parameters$maxdimension, 1) +expect_equal(length(pd_p3$pairs[[1]][1, ]), 2) #correct Format + + +Diag1 <- TDA::gridDiag( + coords, + TDA::distFct, + lim = cbind(c(-1, 1), c(-1, 1)), + maxdimension = 1, + by = 0.05, + sublevel = TRUE, + printProgress = FALSE +) +pd4 <- Diag1$diagram +pd4[, c(2, 3)] <- sqrt(pd4[, c(2, 3)]) +pd_p4 <- as_persistence(pd4) + +expect_inherits(pd_p4, "persistence") +expect_equal(pd_p4$metadata$parameters$maxdimension, 1) +expect_equal(length(pd_p4$pairs[[1]][1, ]), 2) #correct Format + + +pd5 <- TDA::ripsDiag(df, maxdimension = 1, maxscale = 10)$diagram +pd5[, c(2, 3)] <- sqrt(pd5[, c(2, 3)]) +pd_p5 <- as_persistence(pd5) + +expect_inherits(pd_p5, "persistence") +expect_equal(length(pd_p5$pairs), 1) +expect_equal(length(pd_p5$pairs[[1]][1, ]), 2) #correct Format + + +#as_persistence.PHom correctly processes output from `ripserr::cubical` from {ripserr} +if (requireNamespace("ripserr", quietly = TRUE)) { + pd <- ripserr::cubical(volcano) + pd_p <- as_persistence(pd) + + rip_ver <- as.character(utils::packageVersion("ripserr")) + + if (utils::compareVersion(rip_ver, "0.3.0") >= 0) { + #ripserr ≥ 0.3.0 + expect_inherits(pd_p, "persistence") + expect_equal(pd_p$metadata$engine, "ripserr::") + expect_equal(pd_p$metadata$filtration, "Vietoris-Rips/cubical") + expect_equal(length(pd_p$pairs[[1]][1, ]), 2) + } else { + #ripserr < 0.3.0 + expect_inherits(pd_p, "persistence") + expect_equal(pd_p$metadata$engine, "ripserr::") + expect_equal(pd_p$metadata$filtration, "Vietoris-Rips/cubical") + expect_equal(length(pd_p$pairs[[1]][1, ]), 2) + } +} + +#as_persistence.list handles a list of matrices correctly" +pd <- as_persistence(list( + matrix(c(1, 2), ncol = 2), + matrix(c(0.5, 2), ncol = 2) +)) + +expect_inherits(pd, "persistence") +expect_equal(length(pd$pairs), 2) #Two degrees (0 and 1) +expect_equal(pd$pairs[[1]], matrix(c(1, 2), ncol = 2)) +expect_equal(pd$pairs[[2]], matrix(c(0.5, 2), ncol = 2)) + + +#as_persistence.persistence returns the object unchanged +mat <- matrix(c(0, 1, 2, 1, 0.5, 2), ncol = 3, byrow = TRUE) +colnames(mat) <- c("dimension", "birth", "death") +pd <- as_persistence(mat) +pd2 <- as_persistence(pd) + +expect_identical(pd, pd2) + + +#as.data.frame.persistence creates correct format +mat <- matrix(c(0, 1, 2, 1, 0.5, 2), ncol = 3, byrow = TRUE) +colnames(mat) <- c("dimension", "birth", "death") +pd <- as_persistence(mat) +df <- as.data.frame(pd) + +expect_inherits(df, "data.frame") +expect_equal(colnames(df), c("dimension", "birth", "death")) +expect_equal(as.numeric(df[1, ]), c(0, 1, 2)) + + +#`get_pairs` correctly grabs pairs from persistence object + +pd_p <- as_persistence(pd) +expect_equal(get_pairs(pd_p, 1), pd_p$pairs[[2]]) +expect_true(all(is.na(get_pairs(pd_p, 3)))) #nonexistent dimension returns empty matrix +expect_error(get_pairs(pd)) #verifies failure given incorrect class