Skip to content

Commit

Permalink
harmonize dimension variable + debug vignette
Browse files Browse the repository at this point in the history
  • Loading branch information
@corybrunson
corybrunson committed Feb 1, 2024
1 parent b15b92e commit 1928739
Show file tree
Hide file tree
Showing 50 changed files with 158 additions and 159 deletions.
8 changes: 4 additions & 4 deletions R/persistence.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,9 +41,9 @@
#' stat = "persistence",
#' start = "birth value of each feature (from 'dataset' aesthetic).",
#' end = "death value of each feature (from 'dataset' aesthetic).",
#' dimension = "feature dimension (from 'dataset' aesthetic).",
#' dimension = "integer feature dimension (from 'dataset' aesthetic).",
#' group = "interaction of existing 'group', dataset ID, and 'dimension'.",
#' id = "feature identifier (across 'group').",
#' id = "character feature identifier (across 'group').",
#' part =
#' "whether features belong to ordinary, relative, or extended homology.",
#' persistence =
Expand Down Expand Up @@ -130,8 +130,8 @@ StatPersistence <- ggproto(
# + issue warnings when choices are incompatible
params$filtration <-
match.arg(params$filtration, c("Vietoris", "Rips", "alpha"))
params$engine <-
match.arg(params$engine, c("TDA", "GUDHI", "Dionysus", "ripserr"))
if (! is.null(params$engine)) params$engine <-
match.arg(params$engine, c("TDA", "GUDHI", "Dionysus", "ripserr"))
params$engine <-
assign_filtration_engine(params$filtration, params$engine)

Expand Down
58 changes: 29 additions & 29 deletions R/simplicial-complex-engines.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ simplicial_complex_base <- function(

# df_zero_simplices <- indices_to_data(data)
df_zero_simplices <- data
df_zero_simplices$dim <- 0L
df_zero_simplices$dimension <- 0L
df_zero_simplices$id <- seq(nrow(data))

# Compute other data.frame objects based on complex
Expand All @@ -20,7 +20,7 @@ simplicial_complex_base <- function(
edges <- proximate_pairs(data, diameter)
df_one_simplices <- indices_to_data(data, edges)

# Now do simplices (only of dim 1)
# Now do simplices (only of dimension 1)
# (need edges as a nice data.frame again)
edges <- as.data.frame(proximate_pairs(data, diameter))

Expand Down Expand Up @@ -54,14 +54,14 @@ simplicial_complex_base <- function(
edges <- proximate_pairs(data, diameter)
df_one_simplices <- indices_to_data(data, edges)

# Now do simplices (only of dim 1)
# Now do simplices (only of dimension 1)
faces <- proximate_triples(data, diameter)
df_high_simplices <- indices_to_data(data, faces)

}

# Pair down to maximal simplices if necessary
# necessary <=> only want maximal 0/1-simplices AND no higher-dim simplices
# necessary <=> only want maximal 0/1-simplices AND no higher simplices
# being plotted
if (one_simplices == "maximal" & dimension_max > 1L) {
df_one_simplices <-
Expand Down Expand Up @@ -105,7 +105,7 @@ simplicial_complex_RTriangle <- function(

df_one_simplices <- indices_to_data(data, edges)

# Now do simplices (only of dim 2)
# Now do simplices (only of dimension 2)

# Delaunay triangulation, keeping only indices of edges and of triangles
dt <- RTriangle::triangulate(
Expand Down Expand Up @@ -175,7 +175,7 @@ simplicial_complex_RTriangle <- function(
}

# Pair down to maximal simplices if necessary
# necessary <=> only want maximal 0/1-simplices AND no higher-dim simplices
# necessary <=> only want maximal 0/1-simplices AND no higher simplices
# being plotted
if (one_simplices == "maximal" & dimension_max > 1L) {
df_one_simplices <-
Expand All @@ -196,7 +196,7 @@ simplicial_complex_RTriangle <- function(
# Converts a matrix of indices corresponding to simplices of equal
# dimensions (0, 1, or 2) to correct representation for GeomSimplicialComplex
# (indices arg. is missing when we want the 0-simplices)
# m = dim + 1, no. of points in each simplex
# m = dimension + 1, no. of points in each simplex
indices_to_data <- function(
data, indices = matrix(seq(nrow(data)), ncol = 1L), m = NULL
) {
Expand All @@ -212,9 +212,9 @@ indices_to_data <- function(
res$id <- rep(seq(length(indices) / m), each = m)

# Always needs to be 2 -- GeomSimplicialComplex only wants different values
# if simplices of dim > 2 being plotted (i.e. engine = "simplextree")
# res$dim <- ordered(2)
res$dim <- m - 1L
# if simplices of dimension > 2 being plotted (i.e. engine = "simplextree")
# res$dimension <- ordered(2)
res$dimension <- m - 1L

# Type of object for GeomSimplicialComplex to plot
# res$type <- switch(
Expand All @@ -228,8 +228,8 @@ indices_to_data <- function(

# If res is empty, still need columns
res$id <- vector("integer")
# res$dim <- ordered(x = character(), levels = 2)
res$dim <- vector("integer")
# res$dimension <- ordered(x = character(), levels = 2)
res$dimension <- vector("integer")
# res$type <- vector("character")

}
Expand Down Expand Up @@ -345,7 +345,7 @@ simplicial_complex_simplextree <- function(
# The entire set of 0-simplices needs to come from data
df_zero_simplices <- data
df_zero_simplices$id <- seq(nrow(data))
df_zero_simplices$dim <- 0L
df_zero_simplices$dimension <- 0L

# Compute simplicial complex up to `dimension_max`, encoded as a 'simplextree'
# (all further computed values derive from st)
Expand Down Expand Up @@ -387,12 +387,12 @@ simplicial_complex_simplextree <- function(

# include relevant computed values
df_simplices$id <- ids
df_simplices$dim <- dims
df_simplices$dimension <- dims

# reorder rows so that higher dim simplices are plotted last
# note: order among simplices of equal dim doesn't matter
# reorder rows so that higher dimension simplices are plotted last
# note: order among simplices of equal dimension doesn't matter
# b/c we split() on id
df_simplices <- df_simplices[order(df_simplices$dim), , drop = FALSE]
df_simplices <- df_simplices[order(df_simplices$dimension), , drop = FALSE]

# take convex hull of each simplex for polygon grob:
# (df_simplices is brielfly a list of data.frames, each corresponding to a
Expand All @@ -401,13 +401,13 @@ simplicial_complex_simplextree <- function(
df_simplices <- lapply(df_simplices, simplex_chull)
df_simplices <- do.call(rbind, df_simplices)

# Store 1- and >1-dim simplices seperately
# (1-dim need to be drawn as line segments)
df_one_simplices <- df_simplices[df_simplices$dim == 1L, , drop = FALSE]
df_high_simplices <- df_simplices[df_simplices$dim > 1L, , drop = FALSE]
# Store 1- and >1-dimension simplices seperately
# (1-dimension need to be drawn as line segments)
df_one_simplices <- df_simplices[df_simplices$dimension == 1L, , drop = FALSE]
df_high_simplices <- df_simplices[df_simplices$dimension > 1L, , drop = FALSE]

# Overwrite df_one_simplices to include non-maximal edges
# if user wants all one-simplices or if higher-dim simplices aren't plotted,
# if user wants all 1-simplices or if higher simplices aren't plotted,
if (one_simplices == "all" | dimension_max == 1L) {

# convert matrix of edges into a list
Expand All @@ -422,7 +422,7 @@ simplicial_complex_simplextree <- function(
# combine ordered pairs for each edge into dataframe
df_one_simplices <- data[edges, , drop = FALSE]
df_one_simplices$id <- edge_id
df_one_simplices$dim <- 1L
df_one_simplices$dimension <- 1L

}

Expand All @@ -432,7 +432,7 @@ simplicial_complex_simplextree <- function(
maximal_vertices <- setdiff(seq(nrow(data)), st$vertices)

df_zero_simplices <- data[maximal_vertices, , drop = FALSE]
df_zero_simplices$dim <- 0L
df_zero_simplices$dimension <- 0L
df_zero_simplices$id <- seq(nrow(data))

}
Expand All @@ -447,7 +447,7 @@ data_to_simplextree <- function(df, diameter, dimension_max, complex) {

if (complex %in% c("Rips", "Vietoris")) {
# For the Vietoris-Rips complex, just return the flag complex:
# w/ simplices with dim up to dimension_max
# w/ simplices with dimension up to dimension_max

# Find edges given diameter:
edges <- t(proximate_pairs(df, diameter))
Expand Down Expand Up @@ -491,7 +491,7 @@ simplicial_complex_TDA <- function(
# The entire set of 0-simplices needs to come from data
df_zero_simplices <- data
df_zero_simplices$id <- seq(nrow(data))
df_zero_simplices$dim <- 0L
df_zero_simplices$dimension <- 0L

# Compute simplicial complex up to `dimension_max`, encoded as a 'Diagram'
# (all further computed values derive from `pd`)
Expand All @@ -508,10 +508,10 @@ simplicial_complex_TDA <- function(
df_combin <- data.frame(
row = unlist(pd$cmplx),
id = rep(seq_along(pd_dim), pd_dim + 1L),
dim = rep(pd_dim, pd_dim + 1L)
dimension = rep(pd_dim, pd_dim + 1L)
)
df_combin <-
df_combin[order(df_combin$dim, df_combin$id), , drop = FALSE]
df_combin[order(df_combin$dimension, df_combin$id), , drop = FALSE]

# merge coordinates with combinatorics & return
df_simplices <- merge(df_coords, df_combin, by = "row")
Expand Down Expand Up @@ -553,7 +553,7 @@ assign_complex_engine <- function(complex, engine, dimension_max) {

if (complex %in% c("Rips", "Vietoris")) {

# Default to "base" engine if not plotting high dim simplices
# Default to "base" engine if not plotting high dimension simplices
# if (dimension_max < 3L & is.null(engine)) return("base")

return(complex_engine_rules("Vietoris-Rips", engine, c(
Expand Down
47 changes: 24 additions & 23 deletions R/simplicial-complex.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -51,9 +51,9 @@

#' @eval rd_sec_computed_vars(
#' stat = "simplicial_complex",
#' dim = "dimension of the corresponding simplex.",
#' id = "simplex identifier within each `dim`.",
#' face = "encoding of `dim` for high-dimensional simplices (`dim >= 2L`)."
#' dimension = "integer dimension of the corresponding simplex.",
#' id = "character simplex identifier within each `dimension`.",
#' face = "factor encoding of `dimension` for `>= 2L`-dimensional simplices."
#' )

#' @name simplicial_complex
Expand Down Expand Up @@ -95,7 +95,7 @@ StatSimplicialComplex <- ggproto(

required_aes = c("x", "y"),

# Alternatively, could assign fill = after_stat(dim)
# Alternatively, could assign fill = after_stat(dimension)
default_aes = aes(alpha = after_stat(face)),

compute_group = function(
Expand Down Expand Up @@ -126,10 +126,11 @@ StatSimplicialComplex <- ggproto(
# logic to deduce reasonable values of engine
# + issue warnings when choices are incompatible
complex <- match.arg(complex, c("Vietoris", "Rips", "Cech", "alpha"))
engine <- match.arg(
engine,
c("base", "RTriangle", "TDA", "GUDHI", "Dionysus", "simplextree")
)
if (! is.null(engine))
engine <- match.arg(
engine,
c("base", "RTriangle", "TDA", "GUDHI", "Dionysus", "simplextree")
)
engine <- assign_complex_engine(complex, engine, dimension_max)

res <- switch(
Expand Down Expand Up @@ -159,27 +160,27 @@ StatSimplicialComplex <- ggproto(

# TODO:
# Take care of zero_ or one_simplices == "none"
# and remove simplices w/ dim > dimension_max
# and remove simplices w/ dimension > dimension_max
if (dimension_max < 2L) {
res <- res[res$dim < 2L, , drop = FALSE]
res <- res[res$dimension < 2L, , drop = FALSE]
}
if (dimension_max < 1L | one_simplices == "none") {
res <- res[res$dim != 1L, , drop = FALSE]
res <- res[res$dimension != 1L, , drop = FALSE]
}
# QUESTION: Require upstream that `dimension_max >= 0`?
if (dimension_max < 0L | zero_simplices == "none") {
res <- res[res$dim != 0L, , drop = FALSE]
res <- res[res$dimension != 0L, , drop = FALSE]
}

# make a factor variable for high-dimensional simplices
if (max(res$dim >= 2L)) {
res$face <- as.character(ifelse(res$dim < 2L, 2L, res$dim))
if (max(res$dimension >= 2L)) {
res$face <- as.character(ifelse(res$dimension < 2L, 2L, res$dimension))
} else {
res$face <- NA_character_
}
res$face <- factor(
res$face,
levels = as.character(seq(2L, max(c(2L, res$dim))))
levels = as.character(seq(2L, max(c(2L, res$dimension))))
)

res
Expand Down Expand Up @@ -262,28 +263,28 @@ GeomSimplicialComplex <- ggproto(
# order
munched <- munched[order(munched$id),]

zero_simplex_data <- data[data$dim == "0", , drop = FALSE]
one_simplex_data <- data[data$dim == "1", , drop = FALSE]
zero_simplex_data <- data[data$dimension == "0", , drop = FALSE]
one_simplex_data <- data[data$dimension == "1", , drop = FALSE]
high_simplex_data <-
data[data$dim != "0" & data$dim != "1", , drop = FALSE]
data[data$dimension != "0" & data$dimension != "1", , drop = FALSE]

} else {

data <- coord$transform(data, panel_params)

data <- data[order(data$id), , drop = FALSE]

zero_simplex_data <- data[data$dim == "0", , drop = FALSE]
one_simplex_data <- data[data$dim == "1", , drop = FALSE]
zero_simplex_data <- data[data$dimension == "0", , drop = FALSE]
one_simplex_data <- data[data$dimension == "1", , drop = FALSE]
high_simplex_data <-
data[data$dim != "0" & data$dim != "1", , drop = FALSE]
data[data$dimension != "0" & data$dimension != "1", , drop = FALSE]

}

# List to hold various grobs (polygons, linesegments, points)
grobs <- list()

# Drawing the simplices w/ dim > 1 -----
# Drawing the simplices w/ dimension > 1 -----
if (nrow(high_simplex_data) > 0L) {

# For gpar(), there is one entry per polygon (not one entry per point).
Expand Down Expand Up @@ -373,7 +374,7 @@ GeomSimplicialComplex <- ggproto(
linewidth = 0.5, linetype = 1,
shape = 21L, size = 1.5, stroke = .5),

required_aes = c("x", "y", "id", "dim"),
required_aes = c("x", "y", "id", "dimension"),

draw_key = draw_key_simplex,

Expand Down
Loading

0 comments on commit 1928739

Please sign in to comment.