diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,13 @@ The serialization format carries its own version tag, independent of the package version; any change to it is recorded here explicitly. +## 1.4.0.5 - 2026-08-29 + +* Add the GHC-9.14 `zigzag` sublibrary. Stable labelled activation points become + independently sampled exact alpha complexes; adjacent observations glue + through checked union cospans, and Homology returns stage-labelled exact + zigzag intervals without comparing DCEL handles across meshes. + ## 1.4.0.4 - 2026-08-28 * Add exact affine upper envelopes through the existing power-cell owner, with diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -14,7 +14,8 @@ regions and labelled overlay, intrinsic valuations, polygonal Minkowski morphology, exact regular/power geometry, the Voronoi dual, natural-neighbour interpolation, Ruppert refinement, walk point location, convex hull, exact Shewchuk predicates, -and versioned binary serialization. +exact zigzag persistence across non-nested activation depths, and versioned +binary serialization. ## Persistence rose @@ -67,10 +68,13 @@ | `alphaFiltration` | Every critical radius matters | Delaunay mesh | `AlphaFiltration` / `AlphaFiltrationError` | | `fromExactCellSet` | Exact cells need a generic complex view | `ExactCellSet` | `DCELComplex` | | `filteredAlphaComplex` | Alpha births must enter persistence | `AlphaFiltration` | Filtered chain complex / `DCELError` | +| `activationAlphaZigzag` | Non-nested labelled depths need checked correspondence | `NonEmpty (ActivationSlice depth label)` | Admitted complexes, adjacent-union witnesses, and checked zigzag / `ActivationZigzagError` | +| `activationZigzagIntervals` / `activationAlphaPersistence` | An admitted zigzag / labelled depth family needs its exact barcode | `ActivationZigzag` / `NonEmpty (ActivationSlice depth label)` | Stage-labelled exact zigzag intervals / `ActivationZigzagError` | | `canonicalize` | Numbering must ignore construction history | Mesh with unit edge/face payloads | Canonical mesh / `BuildError` | [Interpret cell sets as incidence categories.](docs/category-observatory/README.md#cell-complex-and-category-interpretation) · [Compute persistent alpha topology.](docs/persistence-rose/README.md#exact-alpha-filtration-and-persistent-topology) +· [Track topology across non-nested activation depths.](docs/activation-zigzag.md) ## Exact power cells and affine envelopes @@ -140,6 +144,25 @@ -> Either BuildError (Triangulation 'Unconstrained annotation () () ()) ``` +### Zigzag composition + +The activation surface composes admitted local geometry with exact global +reduction through the existing typed obstruction: + +```haskell +activationAlphaPersistence slices = + activationAlphaZigzag slices >>= activationZigzagIntervals +``` + +Each slice yields a canonical labelled subcomplex `K_i`. Adjacent sections glue +through `K_i -> K_i ∪ K_{i+1} <- K_{i+1}`: the union is the join of labelled +subcomplexes, and both legs are checked chain maps satisfying +`boundary . inclusion = inclusion . boundary`. The glued zigzag is therefore a +finite path in chain complexes; rational homology and interval decomposition +produce its authoritative global barcode. Betti profiles are derived views, +while any failed local, overlap, or gluing obligation remains an +`ActivationZigzagError`. + [Publication schedules and scale behavior.](docs/mesh-publication.md) ## Use @@ -197,5 +220,6 @@ | `moonlight-triangulation:parallel` | `.Parallel` | Bounded concurrent union; adds `async`. | | `moonlight-triangulation:serialize` | `.Serialization` | Versioned binary envelopes; adds `binary`, `bytestring`, and `transformers`. | | `moonlight-triangulation:cell-complex` (GHC 9.14+) | `.CellComplex` | Cell, chain, and filtered-alpha interpretations; adds Homology. | +| `moonlight-triangulation:zigzag` (GHC 9.14+) | `.Zigzag` | Labelled activation alpha complexes, adjacent-union witnesses, and stage-labelled zigzag intervals; adds Homology and construction. | [Build and validate package components locally.](docs/development.md) diff --git a/docs/README.md b/docs/README.md --- a/docs/README.md +++ b/docs/README.md @@ -15,6 +15,7 @@ | Which workflows are compile-checked? | [Example index](./examples/README.md) | | How does the C ABI serve Python, TypeScript, and Rust? | [Foreign bindings](../ffi/bindings/README.md) | | How are exact alpha filtrations lowered into persistence? | [Persistence rose](./persistence-rose/README.md) | +| How is topology tracked across non-nested activation depths? | [Activation zigzag persistence](./activation-zigzag.md) | | What does one finite alpha interval look like? | [Alpha eclipse](./persistence-rose/alpha-eclipse.md) | | How does an exact cell set become an incidence category and nerve? | [Category observatory](./category-observatory/README.md) | | How does Moonlight compare on Spade's construction suite? | [Delaunay construction comparison](./delaunay-compare/README.md) | diff --git a/docs/activation-zigzag.md b/docs/activation-zigzag.md new file mode 100644 --- /dev/null +++ b/docs/activation-zigzag.md @@ -0,0 +1,71 @@ +# Activation zigzag persistence + +Use `Moonlight.Triangulation.Zigzag` when independently observed activation +point clouds do not form a monotone filtration. Each point carries a stable +label, each depth carries its own coordinates and exact squared-radius alpha +threshold, and adjacent observations meet through the canonical cospan + +```text +K(depth i) -> K(depth i) union K(depth i+1) <- K(depth i+1). +``` + +The union is the compatibility context, not another sampled depth. Returned +interval endpoints therefore alternate between `ObservedDepth` and +`AdjacentDepthUnion`; both endpoints are inclusive. + +## Use + +On GHC 9.14 or newer, depend only on the three public surfaces named by the +workflow: + +```cabal +build-depends: + moonlight-homology >= 0.1.0.3 && < 0.2, + moonlight-triangulation:dcel >= 1.4 && < 1.5, + moonlight-triangulation:zigzag >= 1.4 && < 1.5, + vector >= 0.13 && < 0.14 +``` + +Construct a nonempty `ActivationSlice depth label` family, then call +`activationAlphaPersistence` for the stage-labelled barcode. Call +`activationAlphaZigzag` first when the admitted complexes, common cells, union +complexes, or checked inclusion maps are also required. +`activationComplexBasisAt` resolves each numeric chain basis back to its stable +labelled cells. + +`ZigzagArrow` and `ZigzagInterval` are functorial carriers: use `fmap` or +`traverse` to relabel payloads and endpoints without rebuilding the checked +diagram or changing degree and multiplicity. + +The compile-checked +[`squareLoopAcrossDepths`](./examples/Moonlight/Triangulation/Example/ActivationZigzag.hs) +example observes a square before its boundary appears, while it carries one +loop, and after its Delaunay faces fill that loop. Its degree-one result is: + +```haskell +ZigzagInterval + { zigzagIntervalDegree = HomologicalDegree 1 + , zigzagIntervalFirst = AdjacentDepthUnion 0 1 + , zigzagIntervalLast = ObservedDepth 1 + , zigzagIntervalMultiplicity = 1 + } +``` + +## Contract + +- Labels, not mesh handles or input positions, identify vertices across + depths. The input is `NonEmpty`, depth keys are unique, labels are unique within each slice, labels + may appear or disappear between slices, and coordinates may move. +- Distinct labels at the same coordinate are rejected rather than silently + merged. Every geometric, alpha-selection, chain, or correspondence failure + is returned through `ActivationZigzagError`. +- Geometry and alpha comparisons are exact for the supplied finite binary64 + `Point` coordinates and `RadiusSquared` values. Induced homology maps and the + zigzag interval decomposition use exact rational arithmetic. +- Each slice is triangulated once. At each degree, the reducer prepares and + consumes every adjacent homology map once. It targets finite depth traces, + not an unbounded stream. + +`moonlight-triangulation:zigzag` owns only labelled alpha ingestion and the +adjacent-union witnesses. `Moonlight.Homology.Persistence` remains the sole +owner of checked chain maps and exact zigzag reduction. diff --git a/docs/examples/Moonlight/Triangulation/Example/ActivationZigzag.hs b/docs/examples/Moonlight/Triangulation/Example/ActivationZigzag.hs new file mode 100644 --- /dev/null +++ b/docs/examples/Moonlight/Triangulation/Example/ActivationZigzag.hs @@ -0,0 +1,60 @@ +module Moonlight.Triangulation.Example.ActivationZigzag + ( ActivationZigzagExampleError (..) + , squareLoopAcrossDepths + ) where + +import Data.Bifunctor (first) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.List.NonEmpty qualified as NonEmpty +import Data.Vector qualified as Vector +import Moonlight.Homology.Chain (HomologicalDegree (..)) +import Moonlight.Triangulation.Types + ( Point (..) + , RadiusSquaredError + , mkRadiusSquared + ) +import Moonlight.Triangulation.Zigzag + ( ActivationInterval + , ActivationPoint (..) + , ActivationSlice (..) + , ActivationZigzagError + , ZigzagInterval (..) + , activationAlphaPersistence + ) + +data ActivationZigzagExampleError + = ActivationRadiusFailed !RadiusSquaredError + | ActivationPersistenceFailed !(ActivationZigzagError Int String) + deriving stock (Eq, Show) + +-- | Observe a square before its boundary appears, while it carries one loop, +-- and after its two Delaunay faces fill that loop. The returned interval uses +-- the expanded observation/union stages rather than pretending the slices are +-- a monotone filtration. +squareLoopAcrossDepths :: Either ActivationZigzagExampleError [ActivationInterval Int] +squareLoopAcrossDepths = do + let depths :: NonEmpty Int + depths = 0 :| [1, 2] + thresholds <- + traverse + (first ActivationRadiusFailed . mkRadiusSquared . fromIntegral) + depths + intervals <- + first ActivationPersistenceFailed + ( activationAlphaPersistence + ( NonEmpty.zipWith + (\depthValue threshold -> ActivationSlice depthValue threshold squarePoints) + depths + thresholds + ) + ) + pure (filter ((== HomologicalDegree 1) . zigzagIntervalDegree) intervals) + +squarePoints :: Vector.Vector (ActivationPoint String) +squarePoints = + Vector.fromList + [ ActivationPoint "south-west" (Point (-1) (-1)) + , ActivationPoint "south-east" (Point 1 (-1)) + , ActivationPoint "north-east" (Point 1 1) + , ActivationPoint "north-west" (Point (-1) 1) + ] diff --git a/docs/examples/README.md b/docs/examples/README.md --- a/docs/examples/README.md +++ b/docs/examples/README.md @@ -3,9 +3,9 @@ [Return to the package overview.](../../README.md#use) · [Browse the documentation.](../README.md) -Each example imports only the public `Moonlight.Triangulation` facade. The -`moonlight-triangulation-examples-test` component compiles the modules and -owns their deterministic expected results. +The ordinary examples import only the public `Moonlight.Triangulation` facade. +The activation example names its opt-in `zigzag` component explicitly. Package +tests compile every module and own their deterministic expected results. | Workflow | Canonical source | | --- | --- | @@ -13,6 +13,8 @@ | Recover a constrained annulus interior | [`ConstrainedRegion.hs`](./Moonlight/Triangulation/Example/ConstrainedRegion.hs) | | Descend an alpha face section to its boundary | [`AlphaBoundary.hs`](./Moonlight/Triangulation/Example/AlphaBoundary.hs) | | Overlay, measure, and morph exact regions | [`PlanarRegion.hs`](./Moonlight/Triangulation/Example/PlanarRegion.hs) | +| Track an alpha loop across non-nested depths | [`ActivationZigzag.hs`](./Moonlight/Triangulation/Example/ActivationZigzag.hs) | -[The focused test owner](../../test/examples/Main.hs) checks every published -summary against these sources. +[The facade example test](../../test/examples/Main.hs) and +[zigzag test](../../test/zigzag/Main.hs) check every published summary against +these sources. diff --git a/moonlight-triangulation.cabal b/moonlight-triangulation.cabal --- a/moonlight-triangulation.cabal +++ b/moonlight-triangulation.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: moonlight-triangulation -version: 1.4.0.4 +version: 1.4.0.5 synopsis: Delaunay meshes and exact planar-region algebra. description: Delaunay and constrained Delaunay triangulation as a lawful finite-set algebra, together with exact rational planar @@ -23,7 +23,8 @@ On GHC 9.14, a public cell-complex component interprets admitted exact cell selections for Homology and Category and lowers exact Delaunay alpha filtrations into persistent - homology. + homology; an opt-in zigzag component tracks exact topology + across independently sampled, non-nested labelled depths. Failure is values: every refusal names its witness. license: MIT license-file: LICENSE @@ -43,6 +44,7 @@ CHANGELOG.md docs/README.md docs/development.md + docs/activation-zigzag.md docs/examples/README.md docs/mesh-publication.md docs/category-observatory/README.md @@ -106,7 +108,7 @@ source-repository this type: git location: https://github.com/PaleRoses/moonlight.git - tag: moonlight-triangulation-1.4.0.4 + tag: moonlight-triangulation-1.4.0.5 subdir: moonlight-triangulation flag warnings-as-errors @@ -288,6 +290,27 @@ , moonlight-triangulation:dcel-internal , vector >= 0.13 && < 0.14 +-- Stable activation labels induce canonical simplices across independently +-- built depth meshes. This opt-in layer owns the exact alpha ingestion and +-- adjacent-union correspondence witnesses; Homology owns the zigzag reducer. +library zigzag + import: shared-properties + visibility: public + hs-source-dirs: src-zigzag + exposed-modules: + Moonlight.Triangulation.Zigzag + if impl(ghc < 9.14) + buildable: False + build-depends: + base >= 4.22 && < 5 + , containers >= 0.6 && < 0.9 + , moonlight-core >= 0.1 && < 0.2 + , moonlight-homology >= 0.1.0.3 && < 0.2 + , moonlight-triangulation:build + , moonlight-triangulation:cell-complex + , moonlight-triangulation:dcel + , vector >= 0.13 && < 0.14 + library build-internal import: shared-properties visibility: private @@ -687,6 +710,29 @@ , moonlight-triangulation:build-internal , moonlight-triangulation:cell-complex , moonlight-triangulation:dcel-internal + , tasty >= 1.4 && < 1.6 + , tasty-hunit >= 0.10 && < 0.11 + , vector >= 0.13 && < 0.14 + +-- Public activation ingestion, labelled adjacent-union correspondences, and +-- exact non-monotone persistence, including its compiled documentation path. +test-suite moonlight-triangulation-zigzag-test + import: shared-properties + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: + test/zigzag + docs/examples + other-modules: + Moonlight.Triangulation.Example.ActivationZigzag + if impl(ghc < 9.14) + buildable: False + build-depends: + base >= 4.22 && < 5 + , containers >= 0.6 && < 0.9 + , moonlight-homology >= 0.1.0.3 && < 0.2 + , moonlight-triangulation:dcel + , moonlight-triangulation:zigzag , tasty >= 1.4 && < 1.6 , tasty-hunit >= 0.10 && < 0.11 , vector >= 0.13 && < 0.14 diff --git a/src-zigzag/Moonlight/Triangulation/Zigzag.hs b/src-zigzag/Moonlight/Triangulation/Zigzag.hs new file mode 100644 --- /dev/null +++ b/src-zigzag/Moonlight/Triangulation/Zigzag.hs @@ -0,0 +1,508 @@ +-- | Exact alpha-complex persistence across non-nested activation depths. +-- +-- Each observed depth is rebuilt independently from stable labelled points. +-- Consecutive complexes are compared through the canonical union cospan +-- @K_i -> K_i union K_(i+1) <- K_(i+1)@. Stable simplex labels, never DCEL +-- handles, own cross-mesh identity. Homology remains the sole owner of the +-- zigzag interval decomposition. +module Moonlight.Triangulation.Zigzag + ( ActivationPoint (..), + ActivationSlice (..), + ActivationCell (..), + ActivationStage (..), + ActivationZigzagError (..), + ActivationComplex, + activationComplexStage, + activationComplexCells, + activationComplexBasisAt, + activationComplexChainComplex, + AdjacentUnionWitness, + adjacentUnionStage, + adjacentCommonCells, + adjacentUnionComplex, + adjacentLeftInclusion, + adjacentRightInclusion, + ActivationZigzag, + activationZigzagStages, + activationZigzagComplexes, + activationZigzagCorrespondences, + activationZigzagDiagram, + ZigzagInterval (..), + ActivationInterval, + activationAlphaZigzag, + activationZigzagIntervals, + activationAlphaPersistence, + ) +where + +import Data.Bifunctor (first) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.List.NonEmpty qualified as NonEmpty +import Data.Set (Set) +import Data.Set qualified as Set +import Data.Vector (Vector) +import Data.Vector qualified as Vector +import Moonlight.Core (firstDuplicate) +import Moonlight.Homology.Boundary + ( BoundaryIncidence, + FiniteChainComplex, + emptyBoundaryIncidence, + emptyBoundaryIncidenceOf, + materializeIncidenceBoundary, + mkFiniteChainComplexChecked, + overlapBoundaryIncidence, + ) +import Moonlight.Homology.Chain + ( HomologicalDegree (..), + HomologyFailure, + ) +import Moonlight.Homology.Persistence + ( FiniteChainMap, + FiniteChainZigzag, + ZigzagArrow (..), + ZigzagFailure, + ZigzagInterval (..), + mkFiniteChainMapChecked, + mkFiniteChainZigzag, + rationalZigzagIntervals, + ) +import Moonlight.Homology.Topology qualified as CellComplex +import Moonlight.Triangulation.Alpha + ( AlphaFiltrationError, + alphaComplexAtRadius, + alphaFiltration, + ) +import Moonlight.Triangulation.BulkLoad + ( DuplicatePayloadPolicy (KeepFirstPayload), + delaunayFromCoordinates, + ) +import Moonlight.Triangulation.CellSet (CellSelectionError) +import Moonlight.Triangulation.CellComplex + ( DCELComplex, + fromExactCellSet, + ) +import Moonlight.Triangulation.Dcel qualified as Dcel +import Moonlight.Triangulation.Handles.HandleDefs + ( FaceId, + UndirectedEdgeId, + ) +import Moonlight.Triangulation.Types + ( BuildError, + BuildResult (..), + BuildStats (..), + DelaunayTriangulation, + Point, + RadiusSquared, + unitElementDefaults, + ) + +-- | One stable observation identity and its two-dimensional embedding. The +-- coordinates may change at every depth; the label is the correspondence. +data ActivationPoint label = ActivationPoint + { activationPointLabel :: !label, + activationPointCoordinates :: !Point + } + deriving stock (Eq, Show) + +-- | One independently sampled depth and the exact squared-radius alpha +-- threshold to observe there. +data ActivationSlice depth label = ActivationSlice + { activationSliceDepth :: !depth, + activationSliceRadiusSquared :: !RadiusSquared, + activationSlicePoints :: !(Vector (ActivationPoint label)) + } + deriving stock (Eq, Show) + +-- | Canonical abstract simplex identity induced by stable vertex labels. +-- Edge and face labels are stored in ascending order. +data ActivationCell label + = ActivationVertex !label + | ActivationEdge !label !label + | ActivationFace !label !label !label + deriving stock (Eq, Ord, Show) + +-- | Vertices of the expanded zigzag alternate between observed depths and +-- their adjacent common ambient unions. +data ActivationStage depth + = ObservedDepth !depth + | AdjacentDepthUnion !depth !depth + deriving stock (Eq, Ord, Show) + +data ActivationZigzagError depth label + = ActivationDuplicateDepth !depth + | ActivationDuplicateLabel !depth !label + | ActivationCoordinateCollapse !depth !Int !Int + | ActivationBuildFailed !depth !BuildError + | ActivationFiltrationFailed !depth !AlphaFiltrationError + | ActivationSelectionFailed !depth !CellSelectionError + | ActivationInnerFaceInvalid !(ActivationStage depth) !FaceId + | ActivationChainComplexFailed !(ActivationStage depth) !HomologyFailure + | ActivationZigzagFailed !ZigzagFailure + | ActivationStageIndexMissing !Int + deriving stock (Eq, Show) + +data ActivationBasis label = ActivationBasis + { activationVertexBasis :: ![ActivationCell label], + activationEdgeBasis :: ![ActivationCell label], + activationFaceBasis :: ![ActivationCell label] + } + +-- | A checked, canonically labelled simplicial interpretation of one observed +-- alpha complex or adjacent union. +data ActivationComplex depth label = ActivationComplex + { activationComplexStage :: !(ActivationStage depth), + activationComplexCells :: !(Set (ActivationCell label)), + activationComplexBasis :: !(ActivationBasis label), + activationComplexChainComplex :: !(FiniteChainComplex Int) + } + +-- | The canonical labelled basis corresponding to the numeric basis of +-- 'activationComplexChainComplex' at one degree. +activationComplexBasisAt :: + ActivationComplex depth label -> + HomologicalDegree -> + [ActivationCell label] +activationComplexBasisAt complexValue degreeValue = + activationBasisAt degreeValue (activationComplexBasis complexValue) + +-- | The two checked inclusion legs proving how adjacent observations meet in +-- their union. The common-cell set is a derived inspection surface. +data AdjacentUnionWitness depth label = AdjacentUnionWitness + { adjacentCommonCells :: !(Set (ActivationCell label)), + adjacentUnionComplex :: !(ActivationComplex depth label), + adjacentLeftInclusion :: !(FiniteChainMap Int), + adjacentRightInclusion :: !(FiniteChainMap Int) + } + +adjacentUnionStage :: AdjacentUnionWitness depth label -> ActivationStage depth +adjacentUnionStage = activationComplexStage . adjacentUnionComplex + +-- | The expanded stages, admitted observations, correspondence witnesses, and +-- authoritative Homology diagram travel together. +data ActivationZigzag depth label = ActivationZigzag + { activationZigzagComplexes :: !(NonEmpty (ActivationComplex depth label)), + activationZigzagCorrespondences :: !(Vector (AdjacentUnionWitness depth label)), + activationZigzagDiagram :: !(FiniteChainZigzag Int) + } + +-- | The labelled view of the Homology diagram. It is derived from the +-- admitted observations and their union witnesses rather than stored as a +-- second sequence that could disagree with them. +activationZigzagStages :: ActivationZigzag depth label -> Vector (ActivationStage depth) +activationZigzagStages zigzag = + let firstComplex :| remainingComplexes = activationZigzagComplexes zigzag + in Vector.fromList + ( activationComplexStage firstComplex + : concat + ( zipWith + (\witness rightComplex -> + [adjacentUnionStage witness, activationComplexStage rightComplex] + ) + (Vector.toList (activationZigzagCorrespondences zigzag)) + remainingComplexes + ) + ) + +-- | The Homology interval carrier with endpoints resolved into the activation +-- stage vocabulary. This is a specialization, not a parallel record. +type ActivationInterval depth = ZigzagInterval (ActivationStage depth) + +activationAlphaZigzag :: + (Ord depth, Ord label) => + NonEmpty (ActivationSlice depth label) -> + Either (ActivationZigzagError depth label) (ActivationZigzag depth label) +activationAlphaZigzag slices = do + case firstDuplicate (fmap activationSliceDepth (NonEmpty.toList slices)) of + Just duplicateDepth -> Left (ActivationDuplicateDepth duplicateDepth) + Nothing -> Right () + observedComplexes <- traverse activationComplexFromSlice slices + buildActivationZigzag + (NonEmpty.zip (fmap activationSliceDepth slices) observedComplexes) + +activationZigzagIntervals :: + ActivationZigzag depth label -> + Either (ActivationZigzagError depth label) [ActivationInterval depth] +activationZigzagIntervals zigzag = do + intervals <- + first ActivationZigzagFailed + (rationalZigzagIntervals (activationZigzagDiagram zigzag)) + traverse (traverse (requireStage (activationZigzagStages zigzag))) intervals + +activationAlphaPersistence :: + (Ord depth, Ord label) => + NonEmpty (ActivationSlice depth label) -> + Either (ActivationZigzagError depth label) [ActivationInterval depth] +activationAlphaPersistence slices = + activationAlphaZigzag slices >>= activationZigzagIntervals + +activationComplexFromSlice :: + Ord label => + ActivationSlice depth label -> + Either (ActivationZigzagError depth label) (ActivationComplex depth label) +activationComplexFromSlice slice = do + let depthValue = activationSliceDepth slice + points = activationSlicePoints slice + labels = fmap activationPointLabel points + case firstDuplicate (Vector.toList labels) of + Just duplicateLabel -> Left (ActivationDuplicateLabel depthValue duplicateLabel) + Nothing -> Right () + buildResult <- + first (ActivationBuildFailed depthValue) + ( delaunayFromCoordinates + unitElementDefaults + (fmap activationPointCoordinates points) + labels + KeepFirstPayload + ) + let inputCount = Vector.length points + uniqueCount = statUniquePoints (buildStats buildResult) + if uniqueCount /= inputCount + then Left (ActivationCoordinateCollapse depthValue inputCount uniqueCount) + else do + let triangulation = buildTriangulation buildResult + filtration <- + first (ActivationFiltrationFailed depthValue) (alphaFiltration triangulation) + selectedCells <- + first (ActivationSelectionFailed depthValue) + (alphaComplexAtRadius (activationSliceRadiusSquared slice) filtration) + let stage = ObservedDepth depthValue + cellSet <- activationCellsFromDcel stage triangulation (fromExactCellSet selectedCells) + compileActivationComplex stage cellSet + +activationCellsFromDcel :: + Ord label => + ActivationStage depth -> + DelaunayTriangulation label -> + DCELComplex -> + Either (ActivationZigzagError depth label) (Set (ActivationCell label)) +activationCellsFromDcel stage triangulation complexValue = do + let vertexCells = + fmap + (ActivationVertex . Dcel.vertexData triangulation) + (CellComplex.vertices complexValue) + edgeCells = + fmap + (activationEdgeFromDcel triangulation complexValue) + (CellComplex.edges complexValue) + faceCells <- + traverse + (activationFaceFromDcel stage triangulation) + (CellComplex.faces complexValue) + pure (Set.fromList (vertexCells <> edgeCells <> faceCells)) + +activationEdgeFromDcel :: + Ord label => + DelaunayTriangulation label -> + DCELComplex -> + UndirectedEdgeId -> + ActivationCell label +activationEdgeFromDcel triangulation complexValue edgeValue = + let (firstVertex, secondVertex) = CellComplex.edgeBoundary complexValue edgeValue + in orderedActivationEdge + (Dcel.vertexData triangulation firstVertex) + (Dcel.vertexData triangulation secondVertex) + +activationFaceFromDcel :: + Ord label => + ActivationStage depth -> + DelaunayTriangulation label -> + FaceId -> + Either (ActivationZigzagError depth label) (ActivationCell label) +activationFaceFromDcel stage triangulation faceValue = + case Dcel.innerFaceVertices triangulation faceValue of + Nothing -> Left (ActivationInnerFaceInvalid stage faceValue) + Just (firstVertex, secondVertex, thirdVertex) -> + Right + ( orderedActivationFace + (Dcel.vertexData triangulation firstVertex) + (Dcel.vertexData triangulation secondVertex) + (Dcel.vertexData triangulation thirdVertex) + ) + +orderedActivationEdge :: Ord label => label -> label -> ActivationCell label +orderedActivationEdge firstLabel secondLabel = + uncurry ActivationEdge (ascendingPair firstLabel secondLabel) + +orderedActivationFace :: Ord label => label -> label -> label -> ActivationCell label +orderedActivationFace firstLabel secondLabel thirdLabel = + let (firstLow, firstHigh) = ascendingPair firstLabel secondLabel + (secondLow, finalHigh) = ascendingPair firstHigh thirdLabel + (finalLow, finalMiddle) = ascendingPair firstLow secondLow + in ActivationFace finalLow finalMiddle finalHigh + +ascendingPair :: Ord value => value -> value -> (value, value) +ascendingPair firstValue secondValue = + if firstValue <= secondValue + then (firstValue, secondValue) + else (secondValue, firstValue) + +compileActivationComplex :: + Ord label => + ActivationStage depth -> + Set (ActivationCell label) -> + Either (ActivationZigzagError depth label) (ActivationComplex depth label) +compileActivationComplex stage cells = do + let basis = activationBasisFromCells cells + degreeOneBoundary <- + first (ActivationChainComplexFailed stage) + ( materializeIncidenceBoundary + activationCellBoundary + (activationEdgeBasis basis) + (activationVertexBasis basis) + ) + degreeTwoBoundary <- + first (ActivationChainComplexFailed stage) + ( materializeIncidenceBoundary + activationCellBoundary + (activationFaceBasis basis) + (activationEdgeBasis basis) + ) + let degreeZeroBoundary :: BoundaryIncidence Int + degreeZeroBoundary = + emptyBoundaryIncidenceOf + (fromIntegral (length (activationVertexBasis basis))) + 0 + boundaryAt :: HomologicalDegree -> BoundaryIncidence Int + boundaryAt (HomologicalDegree degreeIndex) = + case degreeIndex of + 0 -> degreeZeroBoundary + 1 -> degreeOneBoundary + 2 -> degreeTwoBoundary + _ -> emptyBoundaryIncidence + chainComplex <- + first (ActivationChainComplexFailed stage) + (mkFiniteChainComplexChecked (HomologicalDegree 2) boundaryAt) + pure + ActivationComplex + { activationComplexStage = stage, + activationComplexCells = cells, + activationComplexBasis = basis, + activationComplexChainComplex = chainComplex + } + +activationBasisFromCells :: Set (ActivationCell label) -> ActivationBasis label +activationBasisFromCells cells = + foldr insertCell (ActivationBasis [] [] []) (Set.toAscList cells) + where + insertCell :: ActivationCell label -> ActivationBasis label -> ActivationBasis label + insertCell cellValue basis = + case cellValue of + ActivationVertex _ -> basis{activationVertexBasis = cellValue : activationVertexBasis basis} + ActivationEdge _ _ -> basis{activationEdgeBasis = cellValue : activationEdgeBasis basis} + ActivationFace _ _ _ -> basis{activationFaceBasis = cellValue : activationFaceBasis basis} + +activationCellBoundary :: Num coefficient => ActivationCell label -> [(coefficient, ActivationCell label)] +activationCellBoundary cellValue = + case cellValue of + ActivationVertex _ -> [] + ActivationEdge firstLabel secondLabel -> + [ (-1, ActivationVertex firstLabel), + (1, ActivationVertex secondLabel) + ] + ActivationFace firstLabel secondLabel thirdLabel -> + [ (1, ActivationEdge secondLabel thirdLabel), + (-1, ActivationEdge firstLabel thirdLabel), + (1, ActivationEdge firstLabel secondLabel) + ] + +buildActivationZigzag :: + Ord label => + NonEmpty (depth, ActivationComplex depth label) -> + Either (ActivationZigzagError depth label) (ActivationZigzag depth label) +buildActivationZigzag observedEntries@((_, firstComplex) :| remainingEntries) = do + correspondences <- + traverse + ( \((leftDepth, leftComplex), (rightDepth, rightComplex)) -> + adjacentUnionWitness leftDepth rightDepth leftComplex rightComplex + ) + (zip (NonEmpty.toList observedEntries) remainingEntries) + let arrows = + correspondences + >>= ( \witness -> + [ ForwardArrow (adjacentLeftInclusion witness), + BackwardArrow (adjacentRightInclusion witness) + ] + ) + diagram <- + first ActivationZigzagFailed + ( mkFiniteChainZigzag + (activationComplexChainComplex firstComplex) + arrows + ) + pure + ActivationZigzag + { activationZigzagComplexes = fmap snd observedEntries, + activationZigzagCorrespondences = Vector.fromList correspondences, + activationZigzagDiagram = diagram + } + +adjacentUnionWitness :: + Ord label => + depth -> + depth -> + ActivationComplex depth label -> + ActivationComplex depth label -> + Either (ActivationZigzagError depth label) (AdjacentUnionWitness depth label) +adjacentUnionWitness leftDepth rightDepth leftComplex rightComplex = do + let unionStage = + AdjacentDepthUnion leftDepth rightDepth + unionCells = + Set.union + (activationComplexCells leftComplex) + (activationComplexCells rightComplex) + unionComplex <- compileActivationComplex unionStage unionCells + leftInclusion <- activationInclusion leftComplex unionComplex + rightInclusion <- activationInclusion rightComplex unionComplex + pure + AdjacentUnionWitness + { adjacentCommonCells = + Set.intersection + (activationComplexCells leftComplex) + (activationComplexCells rightComplex), + adjacentUnionComplex = unionComplex, + adjacentLeftInclusion = leftInclusion, + adjacentRightInclusion = rightInclusion + } + +activationInclusion :: + Ord label => + ActivationComplex depth label -> + ActivationComplex depth label -> + Either (ActivationZigzagError depth label) (FiniteChainMap Int) +activationInclusion sourceComplex targetComplex = + first ActivationZigzagFailed + ( mkFiniteChainMapChecked + (activationComplexChainComplex sourceComplex) + (activationComplexChainComplex targetComplex) + (inclusionAtDegree sourceComplex targetComplex) + ) + +inclusionAtDegree :: + Ord label => + ActivationComplex depth label -> + ActivationComplex depth label -> + HomologicalDegree -> + BoundaryIncidence Int +inclusionAtDegree sourceComplex targetComplex degreeValue = + overlapBoundaryIncidence + (1 :: Int) + (activationComplexBasisAt sourceComplex degreeValue) + (activationComplexBasisAt targetComplex degreeValue) + +activationBasisAt :: HomologicalDegree -> ActivationBasis label -> [ActivationCell label] +activationBasisAt (HomologicalDegree degreeIndex) basis = + case degreeIndex of + 0 -> activationVertexBasis basis + 1 -> activationEdgeBasis basis + 2 -> activationFaceBasis basis + _ -> [] + +requireStage :: + Vector (ActivationStage depth) -> + Int -> + Either (ActivationZigzagError depth label) (ActivationStage depth) +requireStage stages stageIndex = + maybe + (Left (ActivationStageIndexMissing stageIndex)) + Right + (stages Vector.!? stageIndex) diff --git a/test/zigzag/Main.hs b/test/zigzag/Main.hs new file mode 100644 --- /dev/null +++ b/test/zigzag/Main.hs @@ -0,0 +1,232 @@ +module Main (main) where + +import Data.Bifunctor (first) +import Data.Foldable (traverse_) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.List.NonEmpty qualified as NonEmpty +import Data.Set qualified as Set +import Data.Vector qualified as Vector +import Moonlight.Homology.Chain (HomologicalDegree (..)) +import Moonlight.Triangulation.Example.ActivationZigzag + ( squareLoopAcrossDepths + ) +import Moonlight.Triangulation.Types + ( Point (..) + , RadiusSquared + , mkRadiusSquared + ) +import Moonlight.Triangulation.Zigzag + ( ActivationComplex + , ActivationInterval + , ActivationPoint (..) + , ActivationSlice (..) + , ActivationStage (..) + , ActivationZigzagError (..) + , ZigzagInterval (..) + , activationAlphaPersistence + , activationAlphaZigzag + , activationComplexCells + , activationZigzagComplexes + , activationZigzagCorrespondences + , activationZigzagIntervals + , activationZigzagStages + , adjacentCommonCells + , adjacentUnionComplex + ) +import Test.Tasty (TestTree, defaultMain, testGroup) +import Test.Tasty.HUnit + ( Assertion + , assertFailure + , testCase + , (@?=) + ) + +main :: IO () +main = defaultMain tests + +tests :: TestTree +tests = + testGroup + "activation alpha zigzag" + [ testCase "tracks a loop born and filled across depth" loopAcrossDepths + , testCase "compiled documentation example returns the same loop" compiledExample + , testCase "accepts genuinely non-nested adjacent complexes" nonNestedCorrespondence + , testCase "is invariant under point input permutation" permutationInvariant + , testCase "retains exact common and union cell witnesses" correspondenceCells + , testCase "rejects duplicate depth keys" rejectDuplicateDepths + , testCase "rejects duplicate labels within a depth" rejectDuplicateLabels + , testCase "rejects distinct labels collapsed onto one coordinate" rejectCoordinateCollapse + ] + +loopAcrossDepths :: Assertion +loopAcrossDepths = do + slices <- squareSlices squarePoints + intervals <- requireRight "square loop barcode" (activationAlphaPersistence slices) + degreeOneIntervals intervals + @?= [ ZigzagInterval + { zigzagIntervalDegree = HomologicalDegree 1 + , zigzagIntervalFirst = AdjacentDepthUnion 0 1 + , zigzagIntervalLast = ObservedDepth 1 + , zigzagIntervalMultiplicity = 1 + } + ] + +compiledExample :: Assertion +compiledExample = do + intervals <- requireRight "compiled activation example" squareLoopAcrossDepths + fmap zigzagIntervalMultiplicity intervals @?= [1] + +nonNestedCorrespondence :: Assertion +nonNestedCorrespondence = do + threshold <- requireRadius 10 + let slices :: NonEmpty (ActivationSlice Int String) + slices = + ActivationSlice + 0 + threshold + ( Vector.fromList + [ ActivationPoint "a" (Point 0 0) + , ActivationPoint "b" (Point 2 0) + , ActivationPoint "c" (Point 0 2) + ] + ) + :| [ ActivationSlice + 1 + threshold + ( Vector.fromList + [ ActivationPoint "b" (Point 2 0) + , ActivationPoint "c" (Point 0 2) + , ActivationPoint "d" (Point 2 2) + ] + ) + ] + zigzag <- + requireRight + "non-nested triangle zigzag" + (activationAlphaZigzag slices) + intervals <- requireRight "non-nested triangle barcode" (activationZigzagIntervals zigzag) + filter ((== HomologicalDegree 0) . zigzagIntervalDegree) intervals + @?= [ZigzagInterval (HomologicalDegree 0) (ObservedDepth 0) (ObservedDepth 1) 1] + +permutationInvariant :: Assertion +permutationInvariant = do + forwardSlices <- squareSlices squarePoints + reverseSlices <- squareSlices (Vector.reverse squarePoints) + forwardIntervals <- requireRight "forward square barcode" (activationAlphaPersistence forwardSlices) + reverseIntervals <- requireRight "reversed square barcode" (activationAlphaPersistence reverseSlices) + reverseIntervals @?= forwardIntervals + +correspondenceCells :: Assertion +correspondenceCells = do + slices <- squareSlices squarePoints + zigzag <- requireRight "square correspondence" (activationAlphaZigzag slices) + activationZigzagStages zigzag + @?= Vector.fromList + [ ObservedDepth 0 + , AdjacentDepthUnion 0 1 + , ObservedDepth 1 + , AdjacentDepthUnion 1 2 + , ObservedDepth 2 + ] + let complexes = NonEmpty.toList (activationZigzagComplexes zigzag) + witnesses = Vector.toList (activationZigzagCorrespondences zigzag) + length witnesses @?= 2 + traverse_ + ( \(leftComplex, rightComplex, witness) -> do + adjacentCommonCells witness + @?= Set.intersection + (activationComplexCells leftComplex) + (activationComplexCells rightComplex) + activationComplexCells (adjacentUnionComplex witness) + @?= Set.union + (activationComplexCells leftComplex) + (activationComplexCells rightComplex) + ) + (adjacentTriples complexes witnesses) + +rejectDuplicateDepths :: Assertion +rejectDuplicateDepths = do + threshold <- requireRadius 0 + let slices :: NonEmpty (ActivationSlice Int String) + slices = + ActivationSlice 4 threshold (Vector.singleton (ActivationPoint "a" (Point 0 0))) + :| [ActivationSlice 4 threshold (Vector.singleton (ActivationPoint "a" (Point 1 0)))] + activationAlphaPersistence slices @?= Left (ActivationDuplicateDepth 4) + +rejectDuplicateLabels :: Assertion +rejectDuplicateLabels = do + threshold <- requireRadius 0 + let result :: Either (ActivationZigzagError Int String) [ActivationInterval Int] + result = + activationAlphaPersistence + ( ActivationSlice + 7 + threshold + ( Vector.fromList + [ ActivationPoint "same" (Point 0 0) + , ActivationPoint "same" (Point 1 0) + ] + ) + :| [] + ) + result @?= Left (ActivationDuplicateLabel 7 "same") + +rejectCoordinateCollapse :: Assertion +rejectCoordinateCollapse = do + threshold <- requireRadius 0 + let result :: Either (ActivationZigzagError Int String) [ActivationInterval Int] + result = + activationAlphaPersistence + ( ActivationSlice + 9 + threshold + ( Vector.fromList + [ ActivationPoint "first" (Point 0 0) + , ActivationPoint "second" (Point 0 0) + ] + ) + :| [] + ) + result @?= Left (ActivationCoordinateCollapse 9 2 1) + +degreeOneIntervals :: [ActivationInterval depth] -> [ActivationInterval depth] +degreeOneIntervals = + filter ((== HomologicalDegree 1) . zigzagIntervalDegree) + +squareSlices :: + Vector.Vector (ActivationPoint String) -> + IO (NonEmpty (ActivationSlice Int String)) +squareSlices points = do + let depths :: NonEmpty Int + depths = 0 :| [1, 2] + thresholds <- traverse (requireRadius . fromIntegral) depths + pure + ( NonEmpty.zipWith + (\depthValue threshold -> ActivationSlice depthValue threshold points) + depths + thresholds + ) + +squarePoints :: Vector.Vector (ActivationPoint String) +squarePoints = + Vector.fromList + [ ActivationPoint "south-west" (Point (-1) (-1)) + , ActivationPoint "south-east" (Point 1 (-1)) + , ActivationPoint "north-east" (Point 1 1) + , ActivationPoint "north-west" (Point (-1) 1) + ] + +adjacentTriples :: + [ActivationComplex depth label] -> + [witness] -> + [(ActivationComplex depth label, ActivationComplex depth label, witness)] +adjacentTriples complexes witnesses = + zipWith3 (,,) complexes (drop 1 complexes) witnesses + +requireRadius :: Double -> IO RadiusSquared +requireRadius value = + requireRight "radius squared" (first show (mkRadiusSquared value)) + +requireRight :: Show failure => String -> Either failure value -> IO value +requireRight context = + either (assertFailure . ((context <> ": ") <>) . show) pure diff --git a/weeder.toml b/weeder.toml --- a/weeder.toml +++ b/weeder.toml @@ -14,6 +14,7 @@ '^Moonlight\.Triangulation\.Exact$', '^Moonlight\.Triangulation\.CellSet$', '^Moonlight\.Triangulation\.CellComplex$', + '^Moonlight\.Triangulation\.Zigzag$', '^Moonlight\.Triangulation\.Region$', '^Moonlight\.Triangulation\.Valuation$', '^Moonlight\.Triangulation\.Interop$',