diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,7 +6,23 @@ The serialization format carries its own version tag, independent of the package version; any change to it is recorded here explicitly. +## 1.0.0.0 + +* Specialize the public geometry surface to binary64 and remove the ornamental + scalar parameter from points, queries, triangulations, sessions, hierarchy + hints, interpolation workspaces, and result types. +* Add dense coordinate and inner-face vertex projections to the existing DCEL + surface. +* Add exact support relations and finite-set operations over triangulations, + with local publication for sparse differences, intersections, and symmetric + differences. +* Schedule singleton insertion and constrained extension between dense and + locality-preserving transactions from measured workload evidence. +* Resolve dense coordinate-removal batches through one mutable identity index, + retaining geometric descent for sparse removals. +* Strengthen constrained extension, refinement, serialization, algebra, and + hostile-boundary validation. + ## 0.1.0.0 -* Initial release with an honest binary64 geometry surface, dense DCEL - projections, coverage-guided boundary targets, and PVP-bounded dependencies. +* Initial release. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -77,15 +77,13 @@ | `refineWithinDomain` | Dense publication. The local transaction candidate preserved semantics but did not improve wall time, so it was removed. | On the retained one-million-site / five-thousand-site witnesses, raw -`difference` fell from 4.997 s to 0.169 s. Near-full `intersection` now takes -0.116 s from a cold persistent-index context and 0.100 s after that cache has -already been forced, down from 3.475 s before indexed descent. A -five-thousand-site `symmetricDifference` result fell from 4.022 s / 2.19 GB -allocated to 0.121 s / 244 MB. Exact `siteRelation` now takes 0.083 s cold and -0.115 s after forcing the persistent cache, down from 3.417 s before indexed -descent. Singleton insertion remains 5.326 ms from 48.037 ms. These are raw -publication measurements; paying for `canonicalize` afterward is deliberately -reported separately rather than smuggled into the local-operation claim. +`difference` takes 0.169 s. Near-full `intersection` takes 0.116 s and 0.100 s +across the cold and pre-forced contexts. A five-thousand-site +`symmetricDifference` result takes 0.121 s and allocates 244 MB. Exact +`siteRelation` takes 0.083 s and 0.115 s across those contexts. Singleton +insertion takes 5.326 ms. These are raw publication measurements; +`canonicalize` is measured separately when construction-independent numbering +is required. ```haskell union :: JoinSemilattice annotation diff --git a/docs/ARCHITECTURE.md b/docs/ARCHITECTURE.md deleted file mode 100644 --- a/docs/ARCHITECTURE.md +++ /dev/null @@ -1,170 +0,0 @@ -# moonlight-triangulation architecture laws - -`moonlight-triangulation.cabal` is the authoritative component, module, and -dependency graph. Duplicating that inventory here only manufactures a stale -second owner. This document records the laws the manifest cannot express. - -## Geometry has one owner - -The coordinate pages `triPointX` and `triPointY` own vertex geometry. Vertex -payloads are independent annotations: `setVertexData` and `mapVertices` may -change them without moving a vertex. `triPointIndex` is a derived lookup over -the coordinate pages. - -Construction may read a position from an incoming payload through -`HasPosition`; no operation may later reconstruct geometry from that payload. -The versioned serialization boundary therefore persists coordinate pages and -payloads independently, then derives only the point index on decode. - -## Topology is finite and mutation is sealed - -The half-edge DCEL is a structure of arrays. Twin half-edges are arithmetic -complements (`e xor 1`), and every inner face has a three-edge cycle. Persistent -operations thaw into `MutableDcel` in `ST`, perform a bounded local rewrite, and -freeze the result; mutable references never escape. - -Validation descends in two stages. Structural cardinality, range, link, face, -vertex, point-index, and Euler obligations must glue first. Geometric -orientation and Delaunay checks run only after that structural section is -valid, because reading geometry through malformed links would turn a reported -obstruction into an indexing crash. - -## Constrained regions descend by barrier parity - -For a constrained triangulation, a face's region is determined by the minimum -number of constrained edges crossed from the outer face. Even depths are -outside: depth zero is the exterior, depth one the first bounded domain, depth -two a hole, and so on. A dangling constraint can be walked around at depth -zero. - -`FloodFillIterator.facesAtEvenBarrierDepth` owns this derived classification. -CDT queries and refinement import it; neither maintains a second definition of -"outside." - -## Component cuts justify dependencies - -Sublibraries are proof boundaries, not size buckets. In particular, -`serialize` alone owns the `binary` and `bytestring` dependencies. Modules named -`Internal` may be exposed only where Cabal sublibraries must cross them; that -exposure does not make them a supported public API. - -## The surface states a theory - -`Moonlight.Triangulation` is one export list read as the statement of a theory, -in eight sections: the object, generation, the annotation functor, the -finite-set algebra and its normal form, the constraint layer, refinement, -observations, discharge. A name reaches the surface because a law mentions it. - -The headline law is a homomorphism from finite site sets to canonical -observations of triangulations, - - publish (A ∪ B) = canonicalize (union (publish A) (publish B)) - -where `publish` sends a site set through `delaunay` and then through -`canonicalize . mapVertices (const ())`. A raw build or local union may retain -the schedule that produced it, so structural `Eq` compares resident -representations while the finite-set laws compare their canonical, -payload-free images. `canonicalize` is that explicit physical normal form, and -`mapVertices (const ())` is the arrow onto the carrier used by the -geometry-only laws. Annotated `union` and `unions` glue equal-site payloads -through `JoinSemilattice` without allowing payloads to author geometry. - -The exact support order is observed by `siteRelation`: equality, either proper -subset direction, disjointness, or a positive partial-overlap count. Restriction -descends through the same private site-set owner. `intersectionWith` combines -the left and right annotations only where both supports contain the coordinate; -`difference` preserves the left annotation; `symmetricDifference` preserves -the annotation of whichever exclusive support contains the coordinate. All -three publish through the same canonical rebuild boundary as the geometry-only -operations. - -The generator is named `delaunay` because the equation is false of -triangulations in general and true of Delaunay triangulations. The name has to -make the law true. - -The topology arena is finite, so union is not total. `union` and `unions` -therefore return `Either BuildError`; arena exhaustion is a typed obstruction, -not a lawful `Semigroup` instance with a trapdoor beneath it. - -The constrained layer is not a total semilattice and does not pretend to be -one. Its -extension is the pair lattice of site sets and segment sets under componentwise -union, on which `constrainedDelaunay` is a partial homomorphism restricted to -the realizable sublattice: partiality kills `Semigroup`, and greedy -totalization kills associativity. `unionConstrained` is therefore surfaced as -an explicit operation returning `ConstrainedUnionError`, never as a typeclass -instance. - -## Tiers govern names at their export site - -Four tiers, and a name's tier is where it is exported rather than where it is -defined — a surface name may be defined below without lowering its tier. - -The facade is the surface, and a subtraction there is a major version. The -sublibrary components are a partition: no manifest outside this package names -one, the in-repo spade referent excepted, since it ships with the package it -measures. Non-`Internal` sublibrary modules are the machine room, semi-stable -and reached by consumers who accept that. `Internal` modules promise nothing. - -## Results are values, not histories - -`BuildResult` and `RefinementResult` are abstract, reached through named -projections; `buildStats` and the rest of the telemetry stay below the wall. -Neither derives `Eq` or `Show`, because a derived instance observes through a -facade that hides — equality would consult counters the surface does not admit -exist. - -## One concept has one owner - -`isConstraintEdge` is owned by `Dcel`, polymorphic in the constraint mode; -`Cdt` does not restate it, and no alias survives. `innerFaceVertices` remains a -genuine collision — `Dcel`'s takes raw identifiers and answers `Maybe`, while -`Handles.Dynamic`'s takes and answers handles. Neither is surfaced, so the -collision stays in the machine room and callers name the module they mean. - -## Vocabulary precedes representation - -`Internal.Types` holds the vocabulary the surface names, none of which mentions -the stored mesh. `Internal.Representation` holds the structure of arrays, the -payload traversals, and the records that carry a built mesh beside its -telemetry. Representation imports vocabulary; the reverse import does not -exist. A type whose definition mentions the `Triangulation` record belongs to -Representation, which is why the result records live there. - -## Mechanical acceptance - -The native suite checks geometry and topology laws without depending on -`serialize`; the serialization suite checks the binary boundary separately. The -algebra suite is three slices with three dependency sets: fixtures, the laws -stated against the facade alone, and the agreement between the seam schedule -and the reference rebuild, which names an internal schedule and travels with -it. The parallel suite owns tournament behavior. The separate coherence test -imports every slice against the union of their dependencies at `-O0`; it detects -module and instance collisions but does not execute the behavioral suites a -second time. -The package's `warnings-as-errors` flag and `weeder.toml` turn compiler warnings -and unreachable internal declarations into refusals. The dedicated GitHub -workflow selects all library components from Cabal's generated plan rather than -restating build directories by hand. - -## Published documentation is assembled, not generated - -Cabal writes a Haddock interface for every sublibrary and hands none of them to -the siblings. The facade re-exports names it therefore cannot resolve, and -renders them as text. Cabal also writes one documentation tarball per -component, each under the same name, so the components overwrite one another -and only the last to run survives. - -Hackage adds conditions of its own. A module on the package page links to its -documentation only when that page sits at the documentation root, so Cabal's -per-sublibrary subdirectories leave every module listed and unreachable. A -tarball is refused outright for a colon in any filename — which is how Cabal -names the sublibrary Hoogle databases — and for the extended attributes a macOS -`tar` attaches unbidden. - -None of this is a defect in the component cuts. The repair changes no module, -no export, and no dependency; it is entirely downstream of the manifest, which -is why the manifest cannot express it. `release/hackage-docs.sh` owns it: -regenerate the facade against every sibling interface, flatten the module pages -to one root, cut a portable tarball. A release that skips the script publishes -a surface of unlinked names. diff --git a/fuzz/README.md b/fuzz/README.md deleted file mode 100644 --- a/fuzz/README.md +++ /dev/null @@ -1,25 +0,0 @@ -# Coverage-guided fuzzing - -The fuzz executables are byte-oriented boundaries for an external coverage-guided engine. They are excluded from ordinary builds and add no dependency to any library component. - -```bash -cabal build -ffuzz-targets \ - exe:moonlight-triangulation-fuzz-decode \ - exe:moonlight-triangulation-fuzz-constraints \ - exe:moonlight-triangulation-fuzz-refinement -``` - -Each executable accepts one corpus path in `@@` form or reads the input from standard input. On Linux, AFL++ can guide an uninstrumented GHC executable through QEMU mode: - -```bash -afl-fuzz -Q -i fuzz/corpus/decode -o fuzz/artifacts/decode -- \ - "$(cabal list-bin -ffuzz-targets exe:moonlight-triangulation-fuzz-decode)" @@ - -afl-fuzz -Q -i fuzz/corpus/constraints -o fuzz/artifacts/constraints -- \ - "$(cabal list-bin -ffuzz-targets exe:moonlight-triangulation-fuzz-constraints)" @@ - -afl-fuzz -Q -i fuzz/corpus/refinement -o fuzz/artifacts/refinement -- \ - "$(cabal list-bin -ffuzz-targets exe:moonlight-triangulation-fuzz-refinement)" @@ -``` - -Decoder refusals, unrealizable constraint batches, invalid refinement parameters, and rejected domains are expected typed outcomes. A target fails only when an admitted result violates the DCEL laws or serialization round-trip. diff --git a/fuzz/constraints/Main.hs b/fuzz/constraints/Main.hs deleted file mode 100644 --- a/fuzz/constraints/Main.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Main (main) where - -import qualified Data.ByteString as BS -import Data.List.NonEmpty (NonEmpty (..)) -import qualified Data.Vector as V -import Moonlight.Triangulation -import Moonlight.Triangulation.Cdt -import Moonlight.Triangulation.Fuzz.Boundary (runFuzzTarget) -import Moonlight.Triangulation.Fuzz.Input (decodeConstraints, decodePoints) - -newtype ConstraintFuzzFailure = ConstraintInvariantFailure (NonEmpty InvariantViolation) - deriving stock (Show) - -main :: IO () -main = runFuzzTarget fuzzConstraintRecovery - -fuzzConstraintRecovery :: BS.ByteString -> Either ConstraintFuzzFailure () -fuzzConstraintRecovery bytes = - case constrainedDelaunayMaximal unitElementDefaults points constraints of - Left _ -> Right () - Right result -> - case validateTriangulation (cdtBuildTriangulation result) of - violation : violations -> Left (ConstraintInvariantFailure (violation :| violations)) - [] -> Right () - where - points = decodePoints bytes - constraints = decodeConstraints bytes (V.length points) diff --git a/fuzz/corpus/constraints/seed.bin b/fuzz/corpus/constraints/seed.bin deleted file mode 100644 Binary files a/fuzz/corpus/constraints/seed.bin and /dev/null differ diff --git a/fuzz/corpus/decode/seed.bin b/fuzz/corpus/decode/seed.bin deleted file mode 100644 Binary files a/fuzz/corpus/decode/seed.bin and /dev/null differ diff --git a/fuzz/corpus/refinement/seed.bin b/fuzz/corpus/refinement/seed.bin deleted file mode 100644 Binary files a/fuzz/corpus/refinement/seed.bin and /dev/null differ diff --git a/fuzz/decode/Main.hs b/fuzz/decode/Main.hs deleted file mode 100644 --- a/fuzz/decode/Main.hs +++ /dev/null @@ -1,49 +0,0 @@ -{-# LANGUAGE DataKinds #-} - -module Main (main) where - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as BL -import Data.List.NonEmpty (NonEmpty (..)) -import Moonlight.Triangulation -import Moonlight.Triangulation.Fuzz.Boundary (runFuzzTarget) -import Moonlight.Triangulation.Serialization -import Moonlight.Triangulation.Types (KnownConstraintMode) - -data DecodeFuzzFailure - = DecodeInvariantFailure !(NonEmpty InvariantViolation) - | DecodeRoundTripFailure - deriving stock (Show) - -main :: IO () -main = runFuzzTarget fuzzDecodeTriangulation - -fuzzDecodeTriangulation :: BS.ByteString -> Either DecodeFuzzFailure () -fuzzDecodeTriangulation bytes = - checkUnconstrained (decodeTriangulation lazyBytes) - *> checkConstrained (decodeTriangulation lazyBytes) - where - lazyBytes = BL.fromStrict bytes - -checkUnconstrained - :: Either SerializationError (Triangulation 'Unconstrained () () () ()) - -> Either DecodeFuzzFailure () -checkUnconstrained = either (const (Right ())) checkDecoded - -checkConstrained - :: Either SerializationError (Triangulation 'Constrained () () () ()) - -> Either DecodeFuzzFailure () -checkConstrained = either (const (Right ())) checkDecoded - -checkDecoded - :: KnownConstraintMode mode - => Triangulation mode () () () () - -> Either DecodeFuzzFailure () -checkDecoded triangulation = - case validateTriangulation triangulation of - violation : violations -> Left (DecodeInvariantFailure (violation :| violations)) - [] -> - case decodeTriangulation (encodeTriangulation triangulation) of - Right decoded - | decoded == triangulation -> Right () - _ -> Left DecodeRoundTripFailure diff --git a/fuzz/refinement/Main.hs b/fuzz/refinement/Main.hs deleted file mode 100644 --- a/fuzz/refinement/Main.hs +++ /dev/null @@ -1,117 +0,0 @@ -module Main (main) where - -import qualified Data.ByteString as BS -import qualified Data.Set as Set -import Data.List.NonEmpty (NonEmpty (..)) -import qualified Data.Vector as V -import Moonlight.Triangulation -import Moonlight.Triangulation.Cdt -import Moonlight.Triangulation.Fuzz.Boundary (runFuzzTarget) -import Moonlight.Triangulation.Fuzz.Input - ( decodeConstraints - , decodePoints - , decodeRefinementParameters - , inputByte - ) -import Moonlight.Triangulation.Handles.HandleDefs - ( FaceId (..) - , UndirectedEdgeId (..) - ) - -data RefinementFuzzFailure - = RefinementInvariantFailure !(NonEmpty InvariantViolation) - | RefinementFullDomainInvariantFailure !(NonEmpty InvariantViolation) - | RefinementDomainInvariantFailure !(NonEmpty InvariantViolation) - deriving stock (Show) - -main :: IO () -main = runFuzzTarget fuzzRefinementAdmission - -fuzzRefinementAdmission :: BS.ByteString -> Either RefinementFuzzFailure () -fuzzRefinementAdmission bytes = - case constrainedDelaunayMaximal unitElementDefaults points constraints of - Left _ -> Right () - Right buildResult -> - let triangulation = cdtBuildTriangulation buildResult - in checkOrdinary triangulation - *> checkFullDomain triangulation - *> checkHostileDomain triangulation - where - points = decodePoints bytes - constraints = decodeConstraints bytes (V.length points) - parameters = decodeRefinementParameters bytes - checkOrdinary triangulation = - case validateRefinementParameters parameters of - Left _ -> Right () - Right () -> - either - (const (Right ())) - (checkResult RefinementInvariantFailure) - (refine id parameters triangulation) - checkFullDomain triangulation = - either - (const (Right ())) - (checkResult RefinementFullDomainInvariantFailure . refinementDomainResult) - ( refineWithinDomain - id - domainParameters - (allInnerFaces triangulation) - Set.empty - triangulation - ) - checkHostileDomain triangulation = - either - (const (Right ())) - (checkResult RefinementDomainInvariantFailure . refinementDomainResult) - ( refineWithinDomain - id - domainParameters - (faceSelection triangulation) - (edgeSelection triangulation) - triangulation - ) - allInnerFaces - :: Triangulation mode vertex directed undirected face - -> Set.Set FaceId - allInnerFaces triangulation = - Set.fromDistinctAscList - (FaceId . fromIntegral <$> [1 .. numFaces triangulation - 1]) - domainParameters = - defaultRefinementParameters - { refineMaxAdditionalVertices = Just (fromIntegral (inputByte bytes 7) `mod` 9) - , refineMaxArea = Just (fromIntegral (inputByte bytes 8) / 8 + 1 / 8) - , refinePreserveConvexHull = True - , refineKeepConstraintEdges = True - , refineExcludeOuterFaces = False - } - faceSelection triangulation = - Set.fromList - ( V.toList - ( V.generate - (min 24 (fromIntegral (inputByte bytes 9))) - (FaceId . fromIntegral . selectedFace triangulation) - ) - ) - selectedFace triangulation index - | inputByte bytes (index + 10) `mod` 8 == 0 = numFaces triangulation + index - | otherwise = fromIntegral (inputByte bytes (index + 10)) `mod` max 1 (numFaces triangulation) - edgeSelection triangulation = - Set.fromList - ( V.toList - ( V.generate - (min 24 (fromIntegral (inputByte bytes 34))) - (UndirectedEdgeId . fromIntegral . selectedEdge triangulation) - ) - ) - selectedEdge triangulation index - | inputByte bytes (index + 35) `mod` 8 == 0 = numUndirectedEdges triangulation + index - | otherwise = fromIntegral (inputByte bytes (index + 35)) `mod` max 1 (numUndirectedEdges triangulation) - -checkResult - :: (NonEmpty InvariantViolation -> RefinementFuzzFailure) - -> RefinementResult mode vertex directed undirected face - -> Either RefinementFuzzFailure () -checkResult failure result = - case validateTriangulation (refinedTriangulation result) of - violation : violations -> Left (failure (violation :| violations)) - [] -> Right () diff --git a/fuzz/support/Moonlight/Triangulation/Fuzz/Boundary.hs b/fuzz/support/Moonlight/Triangulation/Fuzz/Boundary.hs deleted file mode 100644 --- a/fuzz/support/Moonlight/Triangulation/Fuzz/Boundary.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE LambdaCase #-} - -module Moonlight.Triangulation.Fuzz.Boundary - ( runFuzzTarget - ) where - -import qualified Data.ByteString as BS -import System.Environment (getArgs) -import System.Exit (die) - -runFuzzTarget :: Show failure => (BS.ByteString -> Either failure ()) -> IO () -runFuzzTarget target = - readInput >>= either (die . show) (const (pure ())) . target - -readInput :: IO BS.ByteString -readInput = - getArgs >>= \case - [] -> BS.getContents - [path] -> BS.readFile path - _ -> die "expected zero arguments for stdin or one input path" diff --git a/fuzz/support/Moonlight/Triangulation/Fuzz/Input.hs b/fuzz/support/Moonlight/Triangulation/Fuzz/Input.hs deleted file mode 100644 --- a/fuzz/support/Moonlight/Triangulation/Fuzz/Input.hs +++ /dev/null @@ -1,65 +0,0 @@ -module Moonlight.Triangulation.Fuzz.Input - ( decodeConstraints - , decodePoints - , decodeRefinementParameters - , inputByte - ) where - -import qualified Data.ByteString as BS -import qualified Data.Vector as V -import Data.Word (Word8) -import Moonlight.Triangulation - -decodePoints :: BS.ByteString -> V.Vector Point -decodePoints bytes = - V.generate pointCount $ \index -> - Point - (coordinate (inputByte bytes (2 * index)) + fromIntegral (index `mod` 3) / 1024) - (coordinate (inputByte bytes (2 * index + 1)) + fromIntegral ((index * index) `mod` 5) / 1024) - where - pointCount = max 3 (min 64 ((BS.length bytes + 1) `quot` 2)) - coordinate :: Word8 -> Double - coordinate value = (fromIntegral value - 127.5) / 4 - -decodeConstraints :: BS.ByteString -> Int -> V.Vector (Int, Int) -decodeConstraints bytes pointCount = - V.generate constraintCount $ \index -> - (endpoint (inputByte bytes (2 * index)), endpoint (inputByte bytes (2 * index + 1))) - where - constraintCount = max 1 (min 96 ((BS.length bytes + 1) `quot` 2)) - endpoint value - | value `mod` 8 == 0 = pointCount + fromIntegral (value `mod` 5) - | otherwise = fromIntegral value `mod` pointCount - -decodeRefinementParameters :: BS.ByteString -> RefinementParameters -decodeRefinementParameters bytes = - defaultRefinementParameters - { refineMaxAdditionalVertices = budget (inputByte bytes 0) - , refineMinArea = metric (inputByte bytes 1) - , refineMaxArea = metric (inputByte bytes 2) - , refineMaxRadiusEdgeRatio = metric (inputByte bytes 3) - , refinePreserveConvexHull = odd (inputByte bytes 4) - , refineKeepConstraintEdges = odd (inputByte bytes 5) - , refineExcludeOuterFaces = odd (inputByte bytes 6) - } - where - budget :: Word8 -> Maybe Int - budget value = - case value `mod` 5 of - 0 -> Nothing - 1 -> Just (-1) - _ -> Just (fromIntegral value `mod` 17) - metric :: Word8 -> Maybe Double - metric value = - case value `mod` 8 of - 0 -> Nothing - 1 -> Just (-1) - 2 -> Just 0 - 3 -> Just (0 / 0) - 4 -> Just (1 / 0) - _ -> Just (fromIntegral value / 8) - -inputByte :: BS.ByteString -> Int -> Word8 -inputByte bytes index - | BS.null bytes = fromIntegral index - | otherwise = BS.index bytes (index `mod` BS.length bytes) 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: 0.1.0.0 +version: 1.0.0.0 synopsis: Delaunay triangulations as a lawful finite-set algebra. description: Delaunay and constrained Delaunay triangulation as a lawful finite-set algebra: a mesh is a value of its site set, so @@ -32,13 +32,8 @@ extra-doc-files: README.md CHANGELOG.md - docs/ARCHITECTURE.md extra-source-files: weeder.toml - fuzz/README.md - fuzz/corpus/constraints/seed.bin - fuzz/corpus/decode/seed.bin - fuzz/corpus/refinement/seed.bin source-repository head type: git @@ -50,11 +45,6 @@ default: False manual: True -flag fuzz-targets - description: Build the external coverage-guided fuzz entrypoints. - default: False - manual: True - common shared-properties default-language: GHC2024 ghc-options: @@ -269,45 +259,6 @@ , moonlight-triangulation:build , moonlight-triangulation:dual ghc-options: -fexpose-all-unfoldings - -common triangulation-fuzz-properties - import: shared-properties - hs-source-dirs: fuzz/support - other-modules: - Moonlight.Triangulation.Fuzz.Boundary - Moonlight.Triangulation.Fuzz.Input - build-depends: - base >= 4.20 && < 5 - , bytestring >= 0.12 && < 0.13 - , containers >= 0.8 && < 0.9 - , vector >= 0.13 && < 0.14 - , moonlight-triangulation - , moonlight-triangulation:build - , moonlight-triangulation:dcel - -executable moonlight-triangulation-fuzz-decode - import: triangulation-fuzz-properties - if !flag(fuzz-targets) - buildable: False - main-is: Main.hs - hs-source-dirs: fuzz/decode - build-depends: - binary >= 0.8 && < 0.9 - , moonlight-triangulation:serialize - -executable moonlight-triangulation-fuzz-constraints - import: triangulation-fuzz-properties - if !flag(fuzz-targets) - buildable: False - main-is: Main.hs - hs-source-dirs: fuzz/constraints - -executable moonlight-triangulation-fuzz-refinement - import: triangulation-fuzz-properties - if !flag(fuzz-targets) - buildable: False - main-is: Main.hs - hs-source-dirs: fuzz/refinement -- ── test slices ────────────────────────────────────────────────────────────── diff --git a/src-build/Moonlight/Triangulation/Internal/Cdt/Query.hs b/src-build/Moonlight/Triangulation/Internal/Cdt/Query.hs --- a/src-build/Moonlight/Triangulation/Internal/Cdt/Query.hs +++ b/src-build/Moonlight/Triangulation/Internal/Cdt/Query.hs @@ -43,11 +43,13 @@ . triConstraintEdges {-# INLINE constraintEdges #-} +-- | Bytes occupied by the dense constraint marker plane. constraintStorageBytes :: Triangulation 'Constrained vertex directed undirected face -> Integer constraintStorageBytes = toInteger . pagedLength . triConstraint +-- | Whether a marked edge directly joins two admitted vertices. existsConstraint :: Triangulation 'Constrained vertex directed undirected face -> VertexId @@ -58,6 +60,7 @@ Just edge -> Dcel.isConstraintEdge triangulation (asUndirected edge) Nothing -> False +-- | Whether a segment can be admitted without crossing a resident constraint. canAddConstraint :: Triangulation 'Constrained vertex directed undirected face -> VertexId @@ -71,6 +74,7 @@ ConstraintBlocked _ -> False ConstraintAdmitted -> True +-- | Whether a query segment properly crosses a resident constraint. intersectsConstraint :: Triangulation 'Constrained vertex directed undirected face -> QueryPoint @@ -87,6 +91,7 @@ | Dcel.isConstraintEdge triangulation (asUndirected edge) = Left () firstBlocking _ _ = Right () +-- | Resident constrained edges properly crossed by a query segment. getConflictingEdgesBetweenPoints :: Triangulation 'Constrained vertex directed undirected face -> QueryPoint @@ -98,6 +103,7 @@ , Dcel.isConstraintEdge triangulation (asUndirected edge) ] +-- | Resident constrained edges crossed between two admitted vertices. getConflictingEdgesBetweenVertices :: Triangulation 'Constrained vertex directed undirected face -> VertexId @@ -111,12 +117,14 @@ , Dcel.isConstraintEdge triangulation (asUndirected edge) ] +-- | Find an oriented edge joining two admitted vertices. findDirectedEdge :: Triangulation 'Constrained vertex directed undirected face -> VertexId -> VertexId -> Maybe DirectedEdgeId findDirectedEdge triangulation from to = case filter ((== to) . Dcel.destination triangulation) (Dcel.vertexOutgoingEdges triangulation from) of edge : _ -> Just edge [] -> Nothing +-- | Find an oriented edge in a thawed triangulation. findMutableEdge :: MutableDcel s vertex directed undirected face -> Int -> Int -> ST s (Maybe Int) findMutableEdge mutable from to = do start <- readVertexOut mutable from @@ -136,11 +144,13 @@ previousEdge <- readPrevious mutable edge go (remaining - 1) start (previousEdge `xor` 1) True +-- | Validate that both constraint endpoints belong to the mesh. validateEndpoints :: Triangulation 'Constrained vertex directed undirected face -> VertexId -> VertexId -> Either (CdtError) () validateEndpoints triangulation from to | not (validVertex triangulation from) = Left (InvalidConstraintVertex from) | not (validVertex triangulation to) = Left (InvalidConstraintVertex to) | otherwise = Right () +-- | Whether a vertex handle is admitted by the triangulation. validVertex :: Triangulation 'Constrained vertex directed undirected face -> VertexId -> Bool validVertex triangulation (VertexId vertex) = fromIntegral vertex < Dcel.numVertices triangulation diff --git a/src-build/Moonlight/Triangulation/Internal/Cdt/Region.hs b/src-build/Moonlight/Triangulation/Internal/Cdt/Region.hs --- a/src-build/Moonlight/Triangulation/Internal/Cdt/Region.hs +++ b/src-build/Moonlight/Triangulation/Internal/Cdt/Region.hs @@ -15,6 +15,7 @@ import Moonlight.Triangulation.Internal.Representation import Moonlight.Triangulation.Internal.Types +-- | Inner faces at even minimum constraint-crossing depth from the outer face. outerRegionFaces :: Triangulation 'Constrained vertex directed undirected face -> [FaceId] @@ -26,6 +27,7 @@ outerRegionFaces triangulation = facesAtEvenBarrierDepth triangulation (Dcel.isConstraintEdge triangulation) +-- | Inner faces enclosed at odd constraint-crossing depth. boundedRegionFaces :: Triangulation 'Constrained vertex directed undirected face -> [FaceId] diff --git a/src-build/Moonlight/Triangulation/Internal/Cdt/Segment.hs b/src-build/Moonlight/Triangulation/Internal/Cdt/Segment.hs --- a/src-build/Moonlight/Triangulation/Internal/Cdt/Segment.hs +++ b/src-build/Moonlight/Triangulation/Internal/Cdt/Segment.hs @@ -161,6 +161,8 @@ , constraintAddedEdges = added } +-- | Insert a polyline's vertices and recover each adjacent segment as a +-- constraint, optionally closing the final segment back to the first. addConstraintEdges :: HasPosition vertex => Triangulation 'Constrained vertex directed undirected face @@ -201,6 +203,7 @@ let !mapping = buildInputVertices result pure (buildTriangulation result, V.generate (sizeofPrimArray mapping) (VertexId . indexPrimArray mapping)) +-- | Retire one constraint edge and restore local Delaunay legality. removeConstraintEdge :: Triangulation 'Constrained vertex directed undirected face -> UndirectedEdgeId diff --git a/src-build/Moonlight/Triangulation/Internal/Cdt/Types.hs b/src-build/Moonlight/Triangulation/Internal/Cdt/Types.hs --- a/src-build/Moonlight/Triangulation/Internal/Cdt/Types.hs +++ b/src-build/Moonlight/Triangulation/Internal/Cdt/Types.hs @@ -150,10 +150,15 @@ -- of local face rotation and handle numbering. data ConstrainedSeamFaceEvidence = ConstrainedSeamFaceEvidence { constrainedSeamSourceFace :: !FaceId + -- ^ Face handle in the source operand. , constrainedSeamTargetFace :: !FaceId + -- ^ Corresponding face handle in the published result. , constrainedSeamFaceFirstPoint :: !(Point) + -- ^ Least vertex position under canonical point order. , constrainedSeamFaceSecondPoint :: !(Point) + -- ^ Middle vertex position under canonical point order. , constrainedSeamFaceThirdPoint :: !(Point) + -- ^ Greatest vertex position under canonical point order. } deriving stock (Eq, Show, Generic) deriving anyclass (NFData) @@ -163,7 +168,9 @@ -- 'Just' records the corridor outcome when recovery was required. data ConstrainedSeamConstraintEvidence = ConstrainedSeamConstraintEvidence { constrainedSeamConstraintSegment :: !(CanonicalSegment) + -- ^ Canonical source segment preserved by the publication. , constrainedSeamConstraintRecovery :: !(Maybe ConstraintOutcome) + -- ^ Recovery work when copying alone did not preserve the segment. } deriving stock (Eq, Show, Generic) deriving anyclass (NFData) @@ -174,17 +181,25 @@ data ConstrainedSeamResult vertex = ConstrainedSeamResult { constrainedSeamResultTriangulation :: !(Triangulation 'Constrained vertex () () ()) + -- ^ Published constrained union. , constrainedSeamLeftFaceEvidence :: !(V.Vector (ConstrainedSeamFaceEvidence)) + -- ^ Transport evidence for every active left-source face. , constrainedSeamRightFaceEvidence :: !(V.Vector (ConstrainedSeamFaceEvidence)) + -- ^ Transport evidence for every active right-source face. , constrainedSeamNewFaces :: !(V.Vector FaceId) + -- ^ Faces created by the seam rather than transported from an operand. , constrainedSeamLeftConstraintEvidence :: !(V.Vector (ConstrainedSeamConstraintEvidence)) + -- ^ Preservation evidence for left-source constraints. , constrainedSeamRightConstraintEvidence :: !(V.Vector (ConstrainedSeamConstraintEvidence)) + -- ^ Preservation evidence for right-source constraints. , constrainedSeamConstraintStats :: !ConstraintBatchStats + -- ^ Constraint recovery work performed by the seam. , constrainedSeamBuildStats :: !BuildStats + -- ^ Topology work performed by the seam. } deriving stock (Generic) deriving anyclass (NFData) @@ -201,10 +216,14 @@ deriving stock (Eq, Show, Generic) deriving anyclass (NFData) +-- | Atomic result of admitting one constraint segment. data ConstraintResult vertex directed undirected face = ConstraintResult { constraintTriangulation :: !(Triangulation 'Constrained vertex directed undirected face) + -- ^ Published constrained triangulation. , constraintPath :: !(V.Vector DirectedEdgeId) + -- ^ Directed-edge path representing the segment at publication time. , constraintAddedEdges :: {-# UNPACK #-} !Int + -- ^ Edges created while recovering the path. } deriving stock (Generic) deriving anyclass (NFData) @@ -216,6 +235,7 @@ (Show vertex, Show directed, Show undirected, Show face) => Show (ConstraintResult vertex directed undirected face) +-- | Per-request outcome in a constraint batch. data ConstraintOutcome = ConstraintAccepted !(V.Vector DirectedEdgeId) @@ -225,21 +245,32 @@ deriving stock (Eq, Show, Generic) deriving anyclass (NFData) +-- | Aggregate work and disposition counts for a constraint batch. data ConstraintBatchStats = ConstraintBatchStats { constraintBatchRequests :: {-# UNPACK #-} !Int + -- ^ Requests interpreted. , constraintBatchAccepted :: {-# UNPACK #-} !Int + -- ^ Requests admitted. , constraintBatchRejected :: {-# UNPACK #-} !Int + -- ^ Requests refused by an existing constraint. , constraintBatchCorridors :: {-# UNPACK #-} !Int + -- ^ Recovery corridors opened. , constraintBatchReusedFaces :: {-# UNPACK #-} !Int + -- ^ Existing faces retained while recovering corridors. , constraintBatchCrossedEdges :: {-# UNPACK #-} !Int + -- ^ Edges crossed while tracing corridors. } deriving stock (Eq, Show, Read, Generic) deriving anyclass (NFData) +-- | Atomic publication of one constraint batch and its receipts. data ConstraintBatchResult vertex directed undirected face = ConstraintBatchResult { constraintBatchTriangulation :: !(Triangulation 'Constrained vertex directed undirected face) + -- ^ Published constrained triangulation. , constraintBatchOutcomes :: !(V.Vector ConstraintOutcome) + -- ^ Outcomes in request order. , constraintBatchStats :: !ConstraintBatchStats + -- ^ Aggregate work performed by the batch. } deriving stock (Generic) deriving anyclass (NFData) @@ -258,9 +289,13 @@ -- this immutable result, not a hidden continuation of this transaction. data ConstrainedExtensionResult vertex directed undirected face = ConstrainedExtensionResult { constrainedExtensionTriangulation :: !(Triangulation 'Constrained vertex directed undirected face) + -- ^ Published extension. , constrainedExtensionConstraintOutcomes :: !(V.Vector ConstraintOutcome) + -- ^ Outcomes for incoming constraints in request order. , constrainedExtensionConstraintStats :: !ConstraintBatchStats + -- ^ Constraint work performed by the extension. , constrainedExtensionBuildStats :: !BuildStats + -- ^ Topology work performed by the extension. } deriving stock (Generic) deriving anyclass (NFData) @@ -278,8 +313,11 @@ -- singleton path already carries. data ConstraintSplitBatchResult vertex directed undirected face = ConstraintSplitBatchResult { splitBatchTriangulation :: !(Triangulation 'Constrained vertex directed undirected face) + -- ^ Published constrained triangulation. , splitBatchPaths :: !(V.Vector (V.Vector DirectedEdgeId)) + -- ^ Recovered paths in request order. , splitBatchAddedEdges :: {-# UNPACK #-} !Int + -- ^ Edges created across all requested divisions. } deriving stock (Generic) deriving anyclass (NFData) @@ -346,11 +384,16 @@ , accumulatedProgramRequest :: !ConstraintRequestAccumulator } +-- | Result of maximal constrained construction, including rejected requests. data CdtBuildResult vertex directed undirected face = CdtBuildResult { cdtBuildTriangulation :: !(Triangulation 'Constrained vertex directed undirected face) + -- ^ Published constrained triangulation. , cdtBuildInputVertices :: !(PrimArray Word32) + -- ^ Input-to-vertex handle projection. , cdtBuildStats :: !BuildStats + -- ^ Topology work performed by construction. , cdtRejectedConstraints :: !(V.Vector (Int, Int)) + -- ^ Input-index pairs that could not be admitted. } deriving stock (Generic) deriving anyclass (NFData) diff --git a/src-build/Moonlight/Triangulation/Internal/Excision.hs b/src-build/Moonlight/Triangulation/Internal/Excision.hs --- a/src-build/Moonlight/Triangulation/Internal/Excision.hs +++ b/src-build/Moonlight/Triangulation/Internal/Excision.hs @@ -1,16 +1,11 @@ {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} -- | Excision of a vertex from a thawed mesh: the removal kernel, stated over -- the mutable arena and publishing nothing. module Moonlight.Triangulation.Internal.Excision - ( RemovalOutcome (..) - , removeMutable + ( removeMutable ) where -import Control.DeepSeq (NFData) import Control.Monad (forM, when) import Control.Monad.ST (ST) import Data.Bits (xor) @@ -28,69 +23,29 @@ ) import Moonlight.Triangulation.Internal.Types import Moonlight.Triangulation.Math (orient2d) -import GHC.Generics (Generic) --- | What a single removal produced: the position and payload of the removed --- vertex, and what swap compaction did — the slot it freed together with the --- position now standing in it, when it moved anything. All fixed handles are --- invalidated by removal, so the swap report is the only continuity the mesh --- offers a caller still holding one. --- --- Slot and position travel together because they are one fact. A caller told --- only the slot has to go back to the mesh to learn what landed there, and a --- caller that reconstructs the position from its own records reconstructs it --- from something the mesh never stored: the arena holds @canonicalPoint@ of --- what it was given, so a signed zero would differ in the last bit and every --- distance tie decided against it would answer a different vertex. --- --- It is not a location hint. A hint names a face; this names an arena slot, --- and the vertex that landed in it is the arena's last, which stands wherever --- it stands. The locator re-anchors on its own cached face, which --- 'Moonlight.Triangulation.Internal.Mutable.swapRemoveFace' follows through --- compaction. -data RemovalOutcome vertex = RemovalOutcome - { removalOutcomePoint :: !(Point) - , removalOutcomeData :: !vertex - , removalOutcomeSwap :: !(Maybe (VertexId, Point)) - } - deriving stock (Eq, Show, Generic) - deriving anyclass (NFData) - -- | The proved outgoing section of one ordinary removal. Its edges live in the -- operation scratch arena in counter-clockwise order; the record carries only -- the section's extent and the first outer-face incidence, if any. data RemovalStar = RemovalStar {-# UNPACK #-} !Int !(Maybe Int) --- | The swap-compaction primitive reports raw arena indices; the public --- concept carries the named handle. One conversion, one owner. -removalOutcomeOf - :: (Point, vertex, Maybe (Int, Point)) - -> RemovalOutcome vertex -removalOutcomeOf (point, payload, swapped) = - RemovalOutcome - { removalOutcomePoint = point - , removalOutcomeData = payload - , removalOutcomeSwap = - (\(slot, standing) -> (VertexId (fromIntegral slot), standing)) <$> swapped - } - removeMutable :: MutableDcel s vertex directed undirected face -> OperationState s -> Int - -> ST s (Either BuildError (RemovalOutcome vertex)) + -> ST s (Either BuildError (Point, vertex, Maybe (Int, Point))) removeMutable mutable operation vertex = do faces <- faceCount mutable if faces <= 1 - then fmap removalOutcomeOf <$> removeDegenerate mutable vertex + then removeDegenerate mutable vertex else do collected <- collectRemovalStar mutable operation vertex case collected of Left obstruction -> pure (Left obstruction) Right (RemovalStar degree outerOutgoing) -> do case outerOutgoing of - Nothing -> fmap removalOutcomeOf <$> removeInterior mutable operation vertex degree - Just hullEdge -> fmap removalOutcomeOf <$> removeHull mutable operation vertex hullEdge + Nothing -> removeInterior mutable operation vertex degree + Just hullEdge -> removeHull mutable operation vertex hullEdge removeDegenerate :: MutableDcel s vertex directed undirected face diff --git a/src-build/Moonlight/Triangulation/Internal/Join.hs b/src-build/Moonlight/Triangulation/Internal/Join.hs --- a/src-build/Moonlight/Triangulation/Internal/Join.hs +++ b/src-build/Moonlight/Triangulation/Internal/Join.hs @@ -42,7 +42,8 @@ -- Skewed operands descend through the existing local copy-on-write session, so -- the larger operand's vertex handles and untouched pages survive. Comparable -- operands may merge along a separating seam or rebuild from their combined --- site set. Every schedule returns valid topology; 'canonicalize' is the +-- site set. Every schedule returns valid topology; +-- 'Moonlight.Triangulation.Dcel.canonicalize' is the -- separate physical observation when construction-independent numbering is -- required. -- diff --git a/src-build/Moonlight/Triangulation/Internal/Join/Seam.hs b/src-build/Moonlight/Triangulation/Internal/Join/Seam.hs --- a/src-build/Moonlight/Triangulation/Internal/Join/Seam.hs +++ b/src-build/Moonlight/Triangulation/Internal/Join/Seam.hs @@ -75,7 +75,8 @@ Nothing -> Nothing -- | Execute a proved seam schedule. Numbering follows the schedule; --- 'canonicalize' remains the explicit construction-independent observation. +-- 'Moonlight.Triangulation.Dcel.canonicalize' remains the explicit +-- construction-independent observation. executeSeam :: forall vertex . SeamPlan @@ -350,7 +351,7 @@ _ <- addFaceBlock mutable (leftFaces + rightFaces - 2) copySource mutable left 0 0 0 copySource mutable right leftVertices leftDirected (leftFaces - 1) - traverse_ (uncurry (copySourceConstraints mutable)) constraintSections + traverse_ (uncurry (protectSourceEdges mutable)) constraintSections base <- spliceLowerTangent mutable leftDirected lowerLeft lowerRight operation <- newOperationState (halfEdgeCapacity mutable) stitched <- @@ -364,6 +365,7 @@ case stitched of Left obstruction -> pure (Left obstruction) Right () -> do + traverse_ (uncurry (restoreSourceConstraints mutable)) constraintSections statistics <- freezeBuildStats operation fmap (\triangulation -> (triangulation, statistics)) <$> freezeTriangulation mutable @@ -513,6 +515,32 @@ (directedEdgeOffset + 2 * fromIntegral edge) ) (constraintEdges source) + +-- Source faces are immutable sections of a separated join. Protect every +-- copied source edge while the seam is legalized, then restore the original +-- constraint plane before publication. The temporary flags prevent the +-- corridor legalization from escaping the overlap and flipping a solved +-- source face. +protectSourceEdges + :: MutableDcel s vertex () () () + -> Int + -> Triangulation 'Constrained vertex () () () + -> ST s () +protectSourceEdges mutable directedEdgeOffset source = + forRange 0 (numDirectedEdges source `quot` 2) $ \edge -> do + _ <- setConstraint mutable (directedEdgeOffset + 2 * edge) + pure () + +restoreSourceConstraints + :: MutableDcel s vertex () () () + -> Int + -> Triangulation 'Constrained vertex () () () + -> ST s () +restoreSourceConstraints mutable directedEdgeOffset source = do + forRange 0 (numDirectedEdges source `quot` 2) $ \edge -> do + _ <- clearConstraint mutable (directedEdgeOffset + 2 * edge) + pure () + copySourceConstraints mutable directedEdgeOffset source spliceLowerTangent :: MutableDcel s vertex () () () diff --git a/src-build/Moonlight/Triangulation/Removal.hs b/src-build/Moonlight/Triangulation/Removal.hs --- a/src-build/Moonlight/Triangulation/Removal.hs +++ b/src-build/Moonlight/Triangulation/Removal.hs @@ -12,12 +12,11 @@ import Control.DeepSeq (NFData) import Moonlight.Triangulation.Handles.HandleDefs (VertexId (..)) -import Moonlight.Triangulation.Internal.Excision (RemovalOutcome (..)) import Moonlight.Triangulation.Internal.PointIndex (lookupPointIndex) import Moonlight.Triangulation.Internal.Representation (Triangulation (..)) import Moonlight.Triangulation.Internal.Types (BuildError, BuildStats, Point, queryPointValue) import Moonlight.Triangulation.Math (validatePoint) -import Moonlight.Triangulation.Session (excise, withLocalSession) +import Moonlight.Triangulation.Session (RemovalOutcome (..), excise, withLocalSession) import GHC.Generics (Generic) -- | One removal and its publication: the frozen triangulation, the outcome diff --git a/src-build/Moonlight/Triangulation/Session.hs b/src-build/Moonlight/Triangulation/Session.hs --- a/src-build/Moonlight/Triangulation/Session.hs +++ b/src-build/Moonlight/Triangulation/Session.hs @@ -1,8 +1,12 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} -- | One owned editing transaction over a triangulation: thaw once, edit, publish once. module Moonlight.Triangulation.Session - ( Session + ( RemovalOutcome (..) + , Session , withSession , withLocalSession , insertVertex @@ -17,12 +21,13 @@ , refuse ) where +import Control.DeepSeq (NFData) import Control.Monad.ST (ST) import Data.Bits (xor) import qualified Data.Vector as V import Moonlight.Triangulation.Handles.HandleDefs import Moonlight.Triangulation.Insertion (insertPointCombining) -import Moonlight.Triangulation.Internal.Excision (RemovalOutcome, removeMutable) +import Moonlight.Triangulation.Internal.Excision (removeMutable) import Moonlight.Triangulation.Internal.Location (MutableLocation (..), locateMutable) import Moonlight.Triangulation.Internal.Mutable import Moonlight.Triangulation.Internal.OperationState (OperationState) @@ -31,7 +36,18 @@ import Moonlight.Triangulation.Internal.Representation import Moonlight.Triangulation.Internal.Transaction (runTransaction) import Moonlight.Triangulation.Internal.Types +import GHC.Generics (Generic) +-- | What a single removal produced: the removed position and payload, plus the +-- slot and position changed by swap compaction when another vertex moved. +data RemovalOutcome vertex = RemovalOutcome + { removalOutcomePoint :: !(Point) + , removalOutcomeData :: !vertex + , removalOutcomeSwap :: !(Maybe (VertexId, Point)) + } + deriving stock (Eq, Show, Generic) + deriving anyclass (NFData) + -- | An edit sequence against one thawed mesh. -- -- The two published entry points before this one — an insertion session and a @@ -174,7 +190,7 @@ removeIndexed mesh operation point = do located <- lookupPointVertex mesh point case located of - Just vertex -> fmap (fmap Just) (removeMutable mesh operation vertex) + Just vertex -> fmap (fmap Just) (removeMutableOutcome mesh operation vertex) Nothing -> pure (Right Nothing) -- | Remove the vertex standing at a point, starting from a caller-supplied @@ -199,7 +215,7 @@ else do stored <- pointAt mesh guess if stored == query - then fmap (fmap Just) (removeMutable mesh operation guess) + then fmap (fmap Just) (removeMutableOutcome mesh operation guess) else do outgoing <- readVertexOut mesh guess let interiorFace edge fallback = do @@ -222,7 +238,7 @@ case located of Left obstruction -> pure (Left obstruction) Right (MutableOnVertex vertex) -> - fmap (fmap Just) (removeMutable mesh operation vertex) + fmap (fmap Just) (removeMutableOutcome mesh operation vertex) Right _ -> pure (Right Nothing) -- | Remove the vertex standing at each point, answering per point in order. @@ -295,7 +311,26 @@ then pure (Left (RemovalVertexOutOfRange requested vertices)) else do activatePointIndex mesh - removeMutable mesh operation (fromIntegral raw) + removeMutableOutcome mesh operation (fromIntegral raw) + +removeMutableOutcome + :: MutableDcel s vertex directed undirected face + -> OperationState s + -> Int + -> ST s (Either BuildError (RemovalOutcome vertex)) +removeMutableOutcome mesh operation vertex = + fmap (fmap removalOutcomeOf) (removeMutable mesh operation vertex) + +removalOutcomeOf + :: (Point, vertex, Maybe (Int, Point)) + -> RemovalOutcome vertex +removalOutcomeOf (point, payload, swapped) = + RemovalOutcome + { removalOutcomePoint = point + , removalOutcomeData = payload + , removalOutcomeSwap = + (\(slot, standing) -> (VertexId (fromIntegral slot), standing)) <$> swapped + } -- | Run an edit sequence: thaw once, edit, freeze once, and publish the -- counters the whole transaction charged. diff --git a/src-build/Moonlight/Triangulation/SetAlgebra.hs b/src-build/Moonlight/Triangulation/SetAlgebra.hs --- a/src-build/Moonlight/Triangulation/SetAlgebra.hs +++ b/src-build/Moonlight/Triangulation/SetAlgebra.hs @@ -60,7 +60,8 @@ siteRelationFromTriangulations left right {-# INLINE siteRelation #-} --- | A valid Delaunay representative of both site sets. Use 'canonicalize' +-- | A valid Delaunay representative of both site sets. Use +-- 'Moonlight.Triangulation.Dcel.canonicalize' -- when construction-independent dense numbering is required. union :: JoinSemilattice annotation diff --git a/src-core/Moonlight/Triangulation/Scalar.hs b/src-core/Moonlight/Triangulation/Scalar.hs --- a/src-core/Moonlight/Triangulation/Scalar.hs +++ b/src-core/Moonlight/Triangulation/Scalar.hs @@ -29,19 +29,26 @@ | otherwise = value {-# INLINE canonicalScalarZero #-} +-- | Machine format of the coordinate scalar. data BinaryFormat = BinaryFormat { formatRadix :: !Integer + -- ^ Numeric base of the significand. , formatMantissaDigits :: !Int + -- ^ Number of base-'formatRadix' digits in the significand. , formatExponentRange :: !(Int, Int) + -- ^ Inclusive minimum and exclusive maximum exponent bounds. } deriving stock (Eq, Show) +-- | Stable name of the coordinate scalar. scalarName :: String scalarName = "binary64" +-- | Bytes occupied by one coordinate component. scalarByteSize :: Int scalarByteSize = 8 +-- | Runtime-confirmed binary format of 'Double'. scalarBinaryFormat :: BinaryFormat scalarBinaryFormat = BinaryFormat @@ -50,23 +57,29 @@ , formatExponentRange = floatRange (0 :: Double) } +-- | Difference between one and the next representable value above one. scalarEpsilon :: Double scalarEpsilon = 2.220446049250313e-16 +-- | Maximum relative rounding error of one binary64 operation. scalarUnitRoundoff :: Double scalarUnitRoundoff = 1.1102230246251565e-16 +-- | Error coefficient for the filtered orientation predicate. scalarCcwErrorBound :: Double scalarCcwErrorBound = 3.3306690738754716e-16 +-- | Error coefficient for the filtered in-circle predicate. scalarInCircleErrorBound :: Double scalarInCircleErrorBound = 1.1102230246251577e-15 +-- | Exact orientation ordering of three binary64 coordinate pairs. orient2dCoordinates :: Double -> Double -> Double -> Double -> Double -> Double -> Ordering orient2dCoordinates = filteredOrient2dDouble +-- | Exact in-circle ordering of four binary64 coordinate pairs. inCircleCoordinates :: Double -> Double -> Double -> Double -> Double -> Double -> Double -> Double diff --git a/src-dcel/Moonlight/Triangulation/Dcel.hs b/src-dcel/Moonlight/Triangulation/Dcel.hs --- a/src-dcel/Moonlight/Triangulation/Dcel.hs +++ b/src-dcel/Moonlight/Triangulation/Dcel.hs @@ -70,6 +70,7 @@ numVertices = pagedLength . triPointX {-# INLINE numVertices #-} +-- | Number of oriented half-edges in the mesh. numDirectedEdges :: Triangulation mode vertex directed undirected face -> Int numDirectedEdges = (`quot` 4) . pagedLength . triHalfTopology {-# INLINE numDirectedEdges #-} @@ -84,6 +85,7 @@ numFaces = pagedLength . triFaceEdge {-# INLINE numFaces #-} +-- | Number of bounded triangular faces. numInnerFaces :: Triangulation mode vertex directed undirected face -> Int numInnerFaces triangulation = max 0 (numFaces triangulation - 1) {-# INLINE numInnerFaces #-} @@ -95,6 +97,7 @@ in Point (pagedUnsafeIndex (triPointX triangulation) index) (pagedUnsafeIndex (triPointY triangulation) index) {-# INLINE vertexPoint #-} +-- | Dense vertex positions in handle order. vertexPoints :: Triangulation mode vertex directed undirected face -> V.Vector Point vertexPoints triangulation = V.generate (numVertices triangulation) (vertexPoint triangulation . VertexId . fromIntegral) @@ -106,16 +109,19 @@ boxedUnsafeIndex (triVertexData triangulation) (fromIntegral vertex) {-# INLINE vertexData #-} +-- | Annotation carried by an admitted directed edge. directedEdgeData :: Triangulation mode vertex directed undirected face -> DirectedEdgeId -> directed directedEdgeData triangulation (DirectedEdgeId edge) = boxedUnsafeIndex (triDirectedData triangulation) (fromIntegral edge) {-# INLINE directedEdgeData #-} +-- | Annotation carried by an admitted undirected edge. undirectedEdgeData :: Triangulation mode vertex directed undirected face -> UndirectedEdgeId -> undirected undirectedEdgeData triangulation (UndirectedEdgeId edge) = boxedUnsafeIndex (triUndirectedData triangulation) (fromIntegral edge) {-# INLINE undirectedEdgeData #-} +-- | Annotation carried by an admitted face. faceData :: Triangulation mode vertex directed undirected face -> FaceId -> face faceData triangulation (FaceId face) = boxedUnsafeIndex (triFaceData triangulation) (fromIntegral face) @@ -130,6 +136,7 @@ setVertexData triangulation (VertexId vertex) payload = triangulation{triVertexData = boxedUpdate (fromIntegral vertex) payload (triVertexData triangulation)} +-- | Replace one directed-edge annotation without changing geometry or topology. setDirectedEdgeData :: Triangulation mode vertex directed undirected face -> DirectedEdgeId @@ -138,6 +145,7 @@ setDirectedEdgeData triangulation (DirectedEdgeId edge) payload = triangulation{triDirectedData = boxedUpdate (fromIntegral edge) payload (triDirectedData triangulation)} +-- | Replace one undirected-edge annotation without changing geometry or topology. setUndirectedEdgeData :: Triangulation mode vertex directed undirected face -> UndirectedEdgeId @@ -146,6 +154,7 @@ setUndirectedEdgeData triangulation (UndirectedEdgeId edge) payload = triangulation{triUndirectedData = boxedUpdate (fromIntegral edge) payload (triUndirectedData triangulation)} +-- | Replace one face annotation without changing geometry or topology. setFaceData :: Triangulation mode vertex directed undirected face -> FaceId @@ -154,11 +163,13 @@ setFaceData triangulation (FaceId face) payload = triangulation{triFaceData = boxedUpdate (fromIntegral face) payload (triFaceData triangulation)} +-- | One outgoing directed edge, if the vertex is connected. vertexOutEdge :: Triangulation mode vertex directed undirected face -> VertexId -> Maybe DirectedEdgeId vertexOutEdge triangulation (VertexId vertex) = DirectedEdgeId . fromIntegral <$> unpackOptionalIndex (pagedUnsafeIndex (triVertexOut triangulation) (fromIntegral vertex)) {-# INLINE vertexOutEdge #-} +-- | One boundary edge of a face, if the face has a boundary. adjacentEdge :: Triangulation mode vertex directed undirected face -> FaceId -> Maybe DirectedEdgeId adjacentEdge triangulation (FaceId face) = DirectedEdgeId . fromIntegral <$> unpackOptionalIndex (pagedUnsafeIndex (triFaceEdge triangulation) (fromIntegral face)) @@ -175,11 +186,13 @@ destination triangulation = origin triangulation . reverseEdge {-# INLINE destination #-} +-- | Next directed edge around the incident face. next :: Triangulation mode vertex directed undirected face -> DirectedEdgeId -> DirectedEdgeId next triangulation (DirectedEdgeId edge) = DirectedEdgeId (pagedUnsafeIndex (triHalfTopology triangulation) (4 * fromIntegral edge + 1)) {-# INLINE next #-} +-- | Previous directed edge around the incident face. previous :: Triangulation mode vertex directed undirected face -> DirectedEdgeId -> DirectedEdgeId previous triangulation (DirectedEdgeId edge) = DirectedEdgeId (pagedUnsafeIndex (triHalfTopology triangulation) (4 * fromIntegral edge + 2)) @@ -191,6 +204,7 @@ FaceId (pagedUnsafeIndex (triHalfTopology triangulation) (4 * fromIntegral edge + 3)) {-# INLINE incidentFace #-} +-- | Whether the directed edge is incident to the unbounded face. isOuterDirectedEdge :: Triangulation mode vertex directed undirected face -> DirectedEdgeId -> Bool isOuterDirectedEdge triangulation edge = incidentFace triangulation edge == outerFace {-# INLINE isOuterDirectedEdge #-} @@ -208,6 +222,7 @@ pagedUnsafeIndex (triConstraint triangulation) (fromIntegral edge) /= (0 :: Word8) {-# INLINE isConstraintEdge #-} +-- | Number of constrained undirected edges. numConstraints :: Triangulation mode vertex directed undirected face -> Int numConstraints = triConstraintCount {-# INLINE numConstraints #-} @@ -232,6 +247,7 @@ faceVertices triangulation = map (origin triangulation) . faceDirectedEdges triangulation {-# INLINE faceVertices #-} +-- | The three directed edges of a bounded triangular face. innerFaceDirectedEdges :: Triangulation mode vertex directed undirected face -> FaceId -> Maybe (DirectedEdgeId, DirectedEdgeId, DirectedEdgeId) innerFaceDirectedEdges triangulation face | face == outerFace = Nothing @@ -244,12 +260,14 @@ else Nothing {-# INLINE innerFaceDirectedEdges #-} +-- | The three vertices of a bounded triangular face. innerFaceVertices :: Triangulation mode vertex directed undirected face -> FaceId -> Maybe (VertexId, VertexId, VertexId) innerFaceVertices triangulation face = do (e0, e1, e2) <- innerFaceDirectedEdges triangulation face pure (origin triangulation e0, origin triangulation e1, origin triangulation e2) {-# INLINE innerFaceVertices #-} +-- | Dense bounded-face vertex triples in face-handle order. innerFaceVertexTriples :: Triangulation mode vertex directed undirected face -> V.Vector (VertexId, VertexId, VertexId) @@ -275,14 +293,17 @@ Just start -> circularWalk triangulation start (counterClockwise triangulation) {-# INLINE vertexOutgoingEdges #-} +-- | Previous directed edge around its origin vertex. clockwise :: Triangulation mode vertex directed undirected face -> DirectedEdgeId -> DirectedEdgeId clockwise triangulation edge = next triangulation (reverseEdge edge) {-# INLINE clockwise #-} +-- | Next directed edge around its origin vertex. counterClockwise :: Triangulation mode vertex directed undirected face -> DirectedEdgeId -> DirectedEdgeId counterClockwise triangulation edge = reverseEdge (previous triangulation edge) {-# INLINE counterClockwise #-} +-- | Strict fold over the directed edges around a face. foldFaceDirectedEdges' :: Triangulation mode vertex directed undirected face -> FaceId -> (a -> DirectedEdgeId -> a) @@ -294,6 +315,7 @@ Just start -> circularFold triangulation start (next triangulation) step initial {-# INLINE foldFaceDirectedEdges' #-} +-- | Strict fold over the directed edges originating at a vertex. foldVertexOutgoingEdges' :: Triangulation mode vertex directed undirected face -> VertexId -> (a -> DirectedEdgeId -> a) @@ -306,6 +328,7 @@ {-# INLINE foldVertexOutgoingEdges' #-} -- Constraint bytes are intentionally reported separately by the CDT layer. +-- | Bytes occupied by vertex, half-edge, and face topology indices. topologyIndexBytes :: Triangulation mode vertex directed undirected face -> Integer topologyIndexBytes triangulation = 4 * toInteger @@ -314,6 +337,7 @@ + pagedLength (triFaceEdge triangulation) ) +-- | Bytes occupied by authoritative coordinates and topology indices. geometryTopologyBytes :: Triangulation mode vertex directed undirected face -> Integer geometryTopologyBytes triangulation = 2 * toInteger scalarByteSize * toInteger (numVertices triangulation) diff --git a/src-dcel/Moonlight/Triangulation/FloodFillIterator.hs b/src-dcel/Moonlight/Triangulation/FloodFillIterator.hs --- a/src-dcel/Moonlight/Triangulation/FloodFillIterator.hs +++ b/src-dcel/Moonlight/Triangulation/FloodFillIterator.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} +-- | Shape queries and face flood fills over immutable triangulations. module Moonlight.Triangulation.FloodFillIterator ( DistanceMetric (..) , CircleMetric @@ -26,23 +27,30 @@ import Moonlight.Triangulation.Math import Moonlight.Triangulation.PointLocation import Moonlight.Triangulation.Types + +-- | A query shape that can admit points, test edges, and supply a location +-- seed. class DistanceMetric metric where metricContainsPoint :: metric -> Point -> Bool metricIntersectsEdge :: metric -> Point -> Point -> Bool metricStartPoint :: metric -> QueryPoint +-- | An admitted center and squared radius. data CircleMetric = CircleMetric !(QueryPoint) !Double deriving stock (Eq, Ord, Show) +-- | Typed refusal for an invalid circle query. data CircleMetricError = InvalidCircleCenter !PointValidationError | NonFiniteRadiusSquared !NonFiniteValue | NegativeRadiusSquared !Double deriving stock (Eq, Ord, Show) +-- | Admitted lower corner, upper corner, and center of an axis-aligned box. data RectangleMetric = RectangleMetric !(QueryPoint) !(QueryPoint) !(QueryPoint) deriving stock (Eq, Ord, Show) +-- | Typed refusal for an invalid rectangle query. data RectangleMetricError = InvalidRectangleLower !PointValidationError | InvalidRectangleUpper !PointValidationError @@ -140,6 +148,7 @@ | numVertices triangulation == 1 = [VertexId 0] | otherwise = map (VertexId . fromIntegral) (IntSet.toAscList set) +-- | Reach inner faces from the supplied seeds by crossing only admitted edges. floodFillFaces :: Triangulation mode vertex directed undirected face -> [FaceId] -> (UndirectedEdgeId -> Bool) diff --git a/src-dcel/Moonlight/Triangulation/Handles/Dynamic.hs b/src-dcel/Moonlight/Triangulation/Handles/Dynamic.hs --- a/src-dcel/Moonlight/Triangulation/Handles/Dynamic.hs +++ b/src-dcel/Moonlight/Triangulation/Handles/Dynamic.hs @@ -5,6 +5,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RoleAnnotations #-} +-- | Owning handles that prevent identifiers from crossing mesh boundaries. module Moonlight.Triangulation.Handles.Dynamic ( InnerTag , PossiblyOuterTag @@ -76,30 +77,37 @@ data PossiblyOuterTag type role FixedFaceHandle nominal +-- | Fixed face identifier refined by whether it may denote the outer face. newtype FixedFaceHandle tag = FixedFaceHandle { unFixedFaceHandle :: FaceId } deriving stock (Show) deriving newtype (Eq, Ord) +-- | Forget the proof that a fixed face is bounded. asPossiblyOuter :: FixedFaceHandle InnerTag -> FixedFaceHandle PossiblyOuterTag asPossiblyOuter (FixedFaceHandle face) = FixedFaceHandle face {-# INLINE asPossiblyOuter #-} +-- | Recover the unrefined face identifier. fixedFaceId :: FixedFaceHandle tag -> FaceId fixedFaceId (FixedFaceHandle face) = face {-# INLINE fixedFaceId #-} +-- | Admitted vertex paired with its owning triangulation. data VertexHandle mode vertex directed undirected face = VertexHandle !(Triangulation mode vertex directed undirected face) !VertexId +-- | Admitted directed edge paired with its owning triangulation. data DirectedEdgeHandle mode vertex directed undirected face = DirectedEdgeHandle !(Triangulation mode vertex directed undirected face) !DirectedEdgeId +-- | Admitted undirected edge paired with its owning triangulation. data UndirectedEdgeHandle mode vertex directed undirected face = UndirectedEdgeHandle !(Triangulation mode vertex directed undirected face) !UndirectedEdgeId +-- | Admitted face paired with its owning triangulation and outer-face proof. data FaceHandle tag mode vertex directed undirected face = FaceHandle !(Triangulation mode vertex directed undirected face) !(FixedFaceHandle tag) @@ -116,6 +124,7 @@ instance Show (FaceHandle tag mode vertex directed undirected face) where showsPrec precedence = showsPrec precedence . fixFace +-- | Admit a vertex identifier into a triangulation. vertexHandle :: Triangulation mode vertex directed undirected face -> VertexId @@ -124,6 +133,7 @@ | fromIntegral raw < Dcel.numVertices triangulation = Just (VertexHandle triangulation vertex) | otherwise = Nothing +-- | Admit a directed-edge identifier into a triangulation. directedEdgeHandle :: Triangulation mode vertex directed undirected face -> DirectedEdgeId @@ -132,6 +142,7 @@ | fromIntegral raw < Dcel.numDirectedEdges triangulation = Just (DirectedEdgeHandle triangulation edge) | otherwise = Nothing +-- | Admit an undirected-edge identifier into a triangulation. undirectedEdgeHandle :: Triangulation mode vertex directed undirected face -> UndirectedEdgeId @@ -140,6 +151,7 @@ | fromIntegral raw < Dcel.numUndirectedEdges triangulation = Just (UndirectedEdgeHandle triangulation edge) | otherwise = Nothing +-- | Admit a face identifier that may denote the outer face. faceHandle :: Triangulation mode vertex directed undirected face -> FaceId @@ -148,6 +160,7 @@ | fromIntegral raw < Dcel.numFaces triangulation = Just (FaceHandle triangulation (FixedFaceHandle face)) | otherwise = Nothing +-- | Admit a face identifier while proving that it is bounded. innerFaceHandle :: Triangulation mode vertex directed undirected face -> FaceId @@ -158,103 +171,126 @@ FaceHandle _ (FixedFaceHandle valid) <- faceHandle triangulation face pure (FaceHandle triangulation (FixedFaceHandle valid)) +-- | Owning handle to the unique unbounded face. outerFaceHandle :: Triangulation mode vertex directed undirected face -> FaceHandle PossiblyOuterTag mode vertex directed undirected face outerFaceHandle triangulation = FaceHandle triangulation (FixedFaceHandle Dcel.outerFace) +-- | Forget ownership and recover the vertex identifier. fixVertex :: VertexHandle mode vertex directed undirected face -> VertexId fixVertex (VertexHandle _ vertex) = vertex {-# INLINE fixVertex #-} +-- | Forget ownership and recover the directed-edge identifier. fixDirectedEdge :: DirectedEdgeHandle mode vertex directed undirected face -> DirectedEdgeId fixDirectedEdge (DirectedEdgeHandle _ edge) = edge {-# INLINE fixDirectedEdge #-} +-- | Forget ownership and recover the undirected-edge identifier. fixUndirectedEdge :: UndirectedEdgeHandle mode vertex directed undirected face -> UndirectedEdgeId fixUndirectedEdge (UndirectedEdgeHandle _ edge) = edge {-# INLINE fixUndirectedEdge #-} +-- | Forget ownership while retaining the outer-face refinement. fixFace :: FaceHandle tag mode vertex directed undirected face -> FixedFaceHandle tag fixFace (FaceHandle _ face) = face {-# INLINE fixFace #-} +-- | Vertex annotation through an owning handle. vertexHandleData :: VertexHandle mode vertex directed undirected face -> vertex vertexHandleData (VertexHandle triangulation vertex) = Dcel.vertexData triangulation vertex {-# INLINE vertexHandleData #-} +-- | Authoritative vertex position through an owning handle. vertexHandlePosition :: VertexHandle mode vertex directed undirected face -> Point vertexHandlePosition (VertexHandle triangulation vertex) = (Dcel.vertexPoint triangulation vertex) {-# INLINE vertexHandlePosition #-} +-- | One outgoing edge of a connected vertex. vertexHandleOutEdge :: VertexHandle mode vertex directed undirected face -> Maybe (DirectedEdgeHandle mode vertex directed undirected face) vertexHandleOutEdge (VertexHandle triangulation vertex) = DirectedEdgeHandle triangulation <$> Dcel.vertexOutEdge triangulation vertex +-- | Directed edges leaving a vertex in ring order. vertexHandleOutEdges :: VertexHandle mode vertex directed undirected face -> [DirectedEdgeHandle mode vertex directed undirected face] vertexHandleOutEdges (VertexHandle triangulation vertex) = map (DirectedEdgeHandle triangulation) (Dcel.vertexOutgoingEdges triangulation vertex) +-- | Directed-edge annotation through an owning handle. directedEdgeDataH :: DirectedEdgeHandle mode vertex directed undirected face -> directed directedEdgeDataH (DirectedEdgeHandle triangulation edge) = Dcel.directedEdgeData triangulation edge {-# INLINE directedEdgeDataH #-} +-- | Origin vertex of an owning directed edge. directedEdgeFrom :: DirectedEdgeHandle mode vertex directed undirected face -> VertexHandle mode vertex directed undirected face directedEdgeFrom (DirectedEdgeHandle triangulation edge) = VertexHandle triangulation (Dcel.origin triangulation edge) {-# INLINE directedEdgeFrom #-} +-- | Destination vertex of an owning directed edge. directedEdgeTo :: DirectedEdgeHandle mode vertex directed undirected face -> VertexHandle mode vertex directed undirected face directedEdgeTo (DirectedEdgeHandle triangulation edge) = VertexHandle triangulation (Dcel.destination triangulation edge) {-# INLINE directedEdgeTo #-} +-- | Origin and destination of an owning directed edge. directedEdgeVertices :: DirectedEdgeHandle mode vertex directed undirected face -> (VertexHandle mode vertex directed undirected face, VertexHandle mode vertex directed undirected face) directedEdgeVertices edge = (directedEdgeFrom edge, directedEdgeTo edge) +-- | Origin and destination positions of an owning directed edge. directedEdgePositions :: DirectedEdgeHandle mode vertex directed undirected face -> (Point, Point) directedEdgePositions edge = (vertexHandlePosition (directedEdgeFrom edge), vertexHandlePosition (directedEdgeTo edge)) {-# INLINE directedEdgePositions #-} +-- | Reverse an owning directed edge. directedEdgeReverse :: DirectedEdgeHandle mode vertex directed undirected face -> DirectedEdgeHandle mode vertex directed undirected face directedEdgeReverse (DirectedEdgeHandle triangulation edge) = DirectedEdgeHandle triangulation (reverseEdge edge) {-# INLINE directedEdgeReverse #-} +-- | Next owning edge around the incident face. directedEdgeNext :: DirectedEdgeHandle mode vertex directed undirected face -> DirectedEdgeHandle mode vertex directed undirected face directedEdgeNext (DirectedEdgeHandle triangulation edge) = DirectedEdgeHandle triangulation (Dcel.next triangulation edge) {-# INLINE directedEdgeNext #-} +-- | Previous owning edge around the incident face. directedEdgePrevious :: DirectedEdgeHandle mode vertex directed undirected face -> DirectedEdgeHandle mode vertex directed undirected face directedEdgePrevious (DirectedEdgeHandle triangulation edge) = DirectedEdgeHandle triangulation (Dcel.previous triangulation edge) {-# INLINE directedEdgePrevious #-} +-- | Previous owning edge around its origin vertex. directedEdgeClockwise :: DirectedEdgeHandle mode vertex directed undirected face -> DirectedEdgeHandle mode vertex directed undirected face directedEdgeClockwise (DirectedEdgeHandle triangulation edge) = DirectedEdgeHandle triangulation (Dcel.clockwise triangulation edge) {-# INLINE directedEdgeClockwise #-} +-- | Next owning edge around its origin vertex. directedEdgeCounterClockwise :: DirectedEdgeHandle mode vertex directed undirected face -> DirectedEdgeHandle mode vertex directed undirected face directedEdgeCounterClockwise (DirectedEdgeHandle triangulation edge) = DirectedEdgeHandle triangulation (Dcel.counterClockwise triangulation edge) {-# INLINE directedEdgeCounterClockwise #-} +-- | Owning handle to the incident face. directedEdgeFace :: DirectedEdgeHandle mode vertex directed undirected face -> FaceHandle PossiblyOuterTag mode vertex directed undirected face directedEdgeFace (DirectedEdgeHandle triangulation edge) = FaceHandle triangulation (FixedFaceHandle (Dcel.incidentFace triangulation edge)) +-- | Forget the orientation of an owning edge. directedEdgeAsUndirected :: DirectedEdgeHandle mode vertex directed undirected face -> UndirectedEdgeHandle mode vertex directed undirected face directedEdgeAsUndirected (DirectedEdgeHandle triangulation edge) = UndirectedEdgeHandle triangulation (asUndirected edge) +-- | Whether the owning edge is incident to the outer face. directedEdgeIsOuter :: DirectedEdgeHandle mode vertex directed undirected face -> Bool directedEdgeIsOuter = faceIsOuter . directedEdgeFace +-- | Exact side of the owning edge's oriented line. directedEdgeSideQuery :: DirectedEdgeHandle mode vertex directed undirected face -> Point @@ -263,28 +299,34 @@ let (from, to) = directedEdgePositions edge in Math.sideQuery from to query +-- | Undirected-edge annotation through an owning handle. undirectedEdgeDataH :: UndirectedEdgeHandle mode vertex directed undirected face -> undirected undirectedEdgeDataH (UndirectedEdgeHandle triangulation edge) = Dcel.undirectedEdgeData triangulation edge {-# INLINE undirectedEdgeDataH #-} +-- | Normalized directed orientation of an owning undirected edge. undirectedEdgeAsDirected :: UndirectedEdgeHandle mode vertex directed undirected face -> DirectedEdgeHandle mode vertex directed undirected face undirectedEdgeAsDirected (UndirectedEdgeHandle triangulation edge) = DirectedEdgeHandle triangulation (normalizedDirected edge) +-- | Endpoints of an owning undirected edge. undirectedEdgeVertices :: UndirectedEdgeHandle mode vertex directed undirected face -> (VertexHandle mode vertex directed undirected face, VertexHandle mode vertex directed undirected face) undirectedEdgeVertices = directedEdgeVertices . undirectedEdgeAsDirected +-- | Face annotation through an owning handle. faceDataH :: FaceHandle tag mode vertex directed undirected face -> face faceDataH (FaceHandle triangulation (FixedFaceHandle face)) = Dcel.faceData triangulation face {-# INLINE faceDataH #-} +-- | Whether the owning face is the unique unbounded face. faceIsOuter :: FaceHandle tag mode vertex directed undirected face -> Bool faceIsOuter (FaceHandle _ (FixedFaceHandle face)) = face == Dcel.outerFace {-# INLINE faceIsOuter #-} +-- | Refine an owning face handle by excluding the outer face. faceAsInner :: FaceHandle PossiblyOuterTag mode vertex directed undirected face -> Maybe (FaceHandle InnerTag mode vertex directed undirected face) @@ -292,16 +334,19 @@ | faceIsOuter handle = Nothing | otherwise = Just (FaceHandle triangulation (FixedFaceHandle face)) +-- | One owning edge on the face boundary. faceAdjacentEdge :: FaceHandle tag mode vertex directed undirected face -> Maybe (DirectedEdgeHandle mode vertex directed undirected face) faceAdjacentEdge (FaceHandle triangulation (FixedFaceHandle face)) = DirectedEdgeHandle triangulation <$> Dcel.adjacentEdge triangulation face +-- | Owning directed boundary of a face. faceAdjacentEdges :: FaceHandle tag mode vertex directed undirected face -> [DirectedEdgeHandle mode vertex directed undirected face] faceAdjacentEdges (FaceHandle triangulation (FixedFaceHandle face)) = map (DirectedEdgeHandle triangulation) (Dcel.faceDirectedEdges triangulation face) +-- | Three owning vertices of a bounded face. innerFaceVertices :: FaceHandle InnerTag mode vertex directed undirected face -> Maybe @@ -313,6 +358,7 @@ (\(a, b, c) -> (VertexHandle triangulation a, VertexHandle triangulation b, VertexHandle triangulation c)) <$> Dcel.innerFaceVertices triangulation face +-- | Circumcenter of an owning bounded face. innerFaceCircumcenter :: FaceHandle InnerTag mode vertex directed undirected face -> Maybe (Point) @@ -320,6 +366,7 @@ (a, b, c) <- innerFaceVertices face Math.circumcenter (vertexHandlePosition a) (vertexHandlePosition b) (vertexHandlePosition c) +-- | Vertex opposite an owning directed edge in its bounded incident face. directedEdgeOppositeVertex :: DirectedEdgeHandle mode vertex directed undirected face -> Maybe (VertexHandle mode vertex directed undirected face) @@ -328,12 +375,14 @@ | otherwise = Just (VertexHandle triangulation (Dcel.destination triangulation (Dcel.next triangulation edge))) +-- | Position opposite an owning directed edge in its bounded incident face. directedEdgeOppositePosition :: DirectedEdgeHandle mode vertex directed undirected face -> Maybe (Point) directedEdgeOppositePosition = fmap vertexHandlePosition . directedEdgeOppositeVertex {-# INLINE directedEdgeOppositePosition #-} +-- | Projection parameter of a point onto an owning directed edge's line. directedEdgeProjectionFactor :: DirectedEdgeHandle mode vertex directed undirected face -> Point @@ -342,6 +391,7 @@ let (from, to) = directedEdgePositions edge in Math.projectionFactor from to query +-- | Nearest point on the closed owning directed edge. directedEdgeNearestPoint :: DirectedEdgeHandle mode vertex directed undirected face -> Point @@ -351,18 +401,21 @@ factor = max 0 (min 1 (Math.projectionFactor from to query)) in Point (ax + factor * (bx - ax)) (ay + factor * (by - ay)) +-- | Whether an owning undirected edge is constrained. undirectedEdgeIsConstraint :: UndirectedEdgeHandle mode vertex directed undirected face -> Bool undirectedEdgeIsConstraint (UndirectedEdgeHandle triangulation edge) = Dcel.isConstraintEdge triangulation edge +-- | Whether an owning undirected edge touches the outer face. undirectedEdgeIsBoundary :: UndirectedEdgeHandle mode vertex directed undirected face -> Bool undirectedEdgeIsBoundary (UndirectedEdgeHandle triangulation edge) = Dcel.isBoundaryEdge triangulation edge +-- | Positions of the three vertices of an owning bounded face. innerFacePositions :: FaceHandle InnerTag mode vertex directed undirected face -> Maybe (Point, Point, Point) @@ -371,6 +424,7 @@ pure (vertexHandlePosition a, vertexHandlePosition b, vertexHandlePosition c) {-# INLINE innerFacePositions #-} +-- | Barycentric coordinates in an owning bounded face. innerFaceBarycentric :: FaceHandle InnerTag mode vertex directed undirected face -> Point diff --git a/src-dcel/Moonlight/Triangulation/Handles/Iterators/CircularIterator.hs b/src-dcel/Moonlight/Triangulation/Handles/Iterators/CircularIterator.hs --- a/src-dcel/Moonlight/Triangulation/Handles/Iterators/CircularIterator.hs +++ b/src-dcel/Moonlight/Triangulation/Handles/Iterators/CircularIterator.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} +-- | Bounded traversal of a cyclic successor relation. module Moonlight.Triangulation.Handles.Iterators.CircularIterator ( circularList , foldCircular' @@ -24,6 +25,7 @@ ) {-# INLINE circularList #-} +-- | Strictly fold a bounded cycle in visit order. foldCircular' :: Eq a => Int -> (a -> a) -> a -> (b -> a -> b) -> b -> b foldCircular' limit advance start step = go limit start False where diff --git a/src-dcel/Moonlight/Triangulation/Handles/Iterators/DynamicIterators.hs b/src-dcel/Moonlight/Triangulation/Handles/Iterators/DynamicIterators.hs --- a/src-dcel/Moonlight/Triangulation/Handles/Iterators/DynamicIterators.hs +++ b/src-dcel/Moonlight/Triangulation/Handles/Iterators/DynamicIterators.hs @@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} +-- | Whole-mesh traversal through topology-bound dynamic handles. module Moonlight.Triangulation.Handles.Iterators.DynamicIterators ( vertexHandles , directedEdgeHandles @@ -31,42 +32,49 @@ vertexHandles triangulation = mapValid (vertexHandle triangulation) (Fixed.vertices triangulation) +-- | Every directed-edge handle in fixed-index order. directedEdgeHandles :: Triangulation mode vertex directed undirected face -> [DirectedEdgeHandle mode vertex directed undirected face] directedEdgeHandles triangulation = mapValid (directedEdgeHandle triangulation) (Fixed.directedEdges triangulation) +-- | Every undirected-edge handle in fixed-index order. undirectedEdgeHandles :: Triangulation mode vertex directed undirected face -> [UndirectedEdgeHandle mode vertex directed undirected face] undirectedEdgeHandles triangulation = mapValid (undirectedEdgeHandle triangulation) (Fixed.undirectedEdges triangulation) +-- | Every face handle, including the outer face. allFaceHandles :: Triangulation mode vertex directed undirected face -> [FaceHandle PossiblyOuterTag mode vertex directed undirected face] allFaceHandles triangulation = mapValid (faceHandle triangulation) (Fixed.allFaces triangulation) +-- | Every inner-face handle. innerFaceHandles :: Triangulation mode vertex directed undirected face -> [FaceHandle InnerTag mode vertex directed undirected face] innerFaceHandles triangulation = mapValid (innerFaceHandle triangulation) (Fixed.innerFaces triangulation) +-- | Hull directed-edge handles in boundary order. hullEdgeHandles :: Triangulation mode vertex directed undirected face -> [DirectedEdgeHandle mode vertex directed undirected face] hullEdgeHandles triangulation = mapValid (directedEdgeHandle triangulation) (Hull.hullEdges triangulation) +-- | Hull vertex handles in boundary order. hullVertexHandles :: Triangulation mode vertex directed undirected face -> [VertexHandle mode vertex directed undirected face] hullVertexHandles triangulation = map directedEdgeFrom (hullEdgeHandles triangulation) +-- | Strict fold over every vertex handle. foldVertexHandles' :: Triangulation mode vertex directed undirected face -> (accumulator -> VertexHandle mode vertex directed undirected face -> accumulator) @@ -75,6 +83,7 @@ foldVertexHandles' triangulation step = Fixed.foldVertices' triangulation (applyValid (vertexHandle triangulation) step) +-- | Strict fold over every directed-edge handle. foldDirectedEdgeHandles' :: Triangulation mode vertex directed undirected face -> (accumulator -> DirectedEdgeHandle mode vertex directed undirected face -> accumulator) @@ -83,6 +92,7 @@ foldDirectedEdgeHandles' triangulation step = Fixed.foldDirectedEdges' triangulation (applyValid (directedEdgeHandle triangulation) step) +-- | Strict fold over every undirected-edge handle. foldUndirectedEdgeHandles' :: Triangulation mode vertex directed undirected face -> (accumulator -> UndirectedEdgeHandle mode vertex directed undirected face -> accumulator) @@ -91,6 +101,7 @@ foldUndirectedEdgeHandles' triangulation step = Fixed.foldUndirectedEdges' triangulation (applyValid (undirectedEdgeHandle triangulation) step) +-- | Strict fold over every face handle, including the outer face. foldAllFaceHandles' :: Triangulation mode vertex directed undirected face -> (accumulator -> FaceHandle PossiblyOuterTag mode vertex directed undirected face -> accumulator) @@ -99,6 +110,7 @@ foldAllFaceHandles' triangulation step = Fixed.foldAllFaces' triangulation (applyValid (faceHandle triangulation) step) +-- | Strict fold over every inner-face handle. foldInnerFaceHandles' :: Triangulation mode vertex directed undirected face -> (accumulator -> FaceHandle InnerTag mode vertex directed undirected face -> accumulator) @@ -107,6 +119,7 @@ foldInnerFaceHandles' triangulation step = Fixed.foldInnerFaces' triangulation (applyValid (innerFaceHandle triangulation) step) +-- | Strict fold over hull directed-edge handles. foldHullEdgeHandles' :: Triangulation mode vertex directed undirected face -> (accumulator -> DirectedEdgeHandle mode vertex directed undirected face -> accumulator) @@ -115,6 +128,7 @@ foldHullEdgeHandles' triangulation step = Hull.foldHullEdges' triangulation (applyValid (directedEdgeHandle triangulation) step) +-- | Strict fold over hull vertex handles. foldHullVertexHandles' :: Triangulation mode vertex directed undirected face -> (accumulator -> VertexHandle mode vertex directed undirected face -> accumulator) diff --git a/src-dcel/Moonlight/Triangulation/Handles/Iterators/FixedIterators.hs b/src-dcel/Moonlight/Triangulation/Handles/Iterators/FixedIterators.hs --- a/src-dcel/Moonlight/Triangulation/Handles/Iterators/FixedIterators.hs +++ b/src-dcel/Moonlight/Triangulation/Handles/Iterators/FixedIterators.hs @@ -53,18 +53,22 @@ foldVertices' triangulation step = foldRange (numVertices triangulation) (VertexId . fromIntegral) step {-# INLINE foldVertices' #-} +-- | Strict fold over every directed-edge identifier. foldDirectedEdges' :: Triangulation mode vertex directed undirected face -> (a -> DirectedEdgeId -> a) -> a -> a foldDirectedEdges' triangulation step = foldRange (numDirectedEdges triangulation) (DirectedEdgeId . fromIntegral) step {-# INLINE foldDirectedEdges' #-} +-- | Strict fold over every undirected-edge identifier. foldUndirectedEdges' :: Triangulation mode vertex directed undirected face -> (a -> UndirectedEdgeId -> a) -> a -> a foldUndirectedEdges' triangulation step = foldRange (numUndirectedEdges triangulation) (UndirectedEdgeId . fromIntegral) step {-# INLINE foldUndirectedEdges' #-} +-- | Strict fold over every face, including the outer face. foldAllFaces' :: Triangulation mode vertex directed undirected face -> (a -> FaceId -> a) -> a -> a foldAllFaces' triangulation step = foldRange (numFaces triangulation) (FaceId . fromIntegral) step {-# INLINE foldAllFaces' #-} +-- | Strict fold over every inner face. foldInnerFaces' :: Triangulation mode vertex directed undirected face -> (a -> FaceId -> a) -> a -> a foldInnerFaces' triangulation step initial = go 1 initial where diff --git a/src-dcel/Moonlight/Triangulation/Internal/Representation.hs b/src-dcel/Moonlight/Triangulation/Internal/Representation.hs --- a/src-dcel/Moonlight/Triangulation/Internal/Representation.hs +++ b/src-dcel/Moonlight/Triangulation/Internal/Representation.hs @@ -256,6 +256,7 @@ where defaults = triElementDefaults triangulation +-- | Map every undirected-edge annotation and its future-element default. mapUndirectedEdges :: (undirected -> undirected') -> Triangulation mode vertex directed undirected face @@ -268,6 +269,7 @@ where defaults = triElementDefaults triangulation +-- | Map every face annotation and its future-element default. mapFaces :: (face -> face') -> Triangulation mode vertex directed undirected face @@ -311,6 +313,7 @@ deriving stock (Generic) deriving anyclass (NFData) +-- | Published insertion result, selected vertex, disposition, and work receipt. data InsertionResult mode vertex directed undirected face = InsertionResult { insertionTriangulation :: !(Triangulation mode vertex directed undirected face) , insertionVertex :: !VertexId diff --git a/src-dcel/Moonlight/Triangulation/Internal/Types.hs b/src-dcel/Moonlight/Triangulation/Internal/Types.hs --- a/src-dcel/Moonlight/Triangulation/Internal/Types.hs +++ b/src-dcel/Moonlight/Triangulation/Internal/Types.hs @@ -60,6 +60,7 @@ deriving stock (Eq, Ord, Show, Generic) deriving anyclass (NFData) +-- | Recover a type-level constraint mode as a value. class KnownConstraintMode (mode :: ConstraintMode) where constraintModeValue :: proxy mode -> ConstraintMode @@ -143,6 +144,7 @@ unitElementDefaults :: ElementDefaults () () () unitElementDefaults = ElementDefaults () () () +-- | Construction, location, legalization, and refinement work counters. data BuildStats = BuildStats { statInputPoints :: {-# UNPACK #-} !Int , statUniquePoints :: {-# UNPACK #-} !Int @@ -170,6 +172,7 @@ deriving stock (Eq, Show, Read, Generic) deriving anyclass (NFData) +-- | The additive identity for construction telemetry. emptyBuildStats :: BuildStats emptyBuildStats = BuildStats @@ -197,6 +200,7 @@ , statSweepSkippedPoints = 0 } +-- | Whether an insertion published a new site or selected an existing one. data InsertionDisposition = Inserted | AlreadyPresent deriving stock (Eq, Ord, Show, Generic) deriving anyclass (NFData) @@ -218,6 +222,7 @@ deriving stock (Eq, Ord, Show, Generic) deriving anyclass (NFData) +-- | Classify NaN and signed infinity, leaving finite values unclassified. classifyNonFinite :: Double -> Maybe NonFiniteValue classifyNonFinite value | isNaN value = Just ValueNaN @@ -300,6 +305,7 @@ deriving stock (Eq, Show, Generic) deriving anyclass (NFData) +-- | Exact position of a query relative to the finite triangulation. data Location = EmptyTriangulation | OnVertex !VertexId @@ -316,6 +322,7 @@ deriving stock (Eq, Ord, Show, Generic) deriving anyclass (NFData) +-- | Work performed by point-location descent. data LocationStats = LocationStats { locationWalkSteps :: {-# UNPACK #-} !Int , locationUsedFallback :: !Bool @@ -323,6 +330,7 @@ deriving stock (Eq, Ord, Show, Generic) deriving anyclass (NFData) +-- | Location telemetry for a query that required no descent. emptyLocationStats :: LocationStats emptyLocationStats = LocationStats 0 False diff --git a/src-dcel/Moonlight/Triangulation/Interop.hs b/src-dcel/Moonlight/Triangulation/Interop.hs --- a/src-dcel/Moonlight/Triangulation/Interop.hs +++ b/src-dcel/Moonlight/Triangulation/Interop.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} +-- | Boundary conversions between Moonlight points and common coordinate pairs. module Moonlight.Triangulation.Interop ( Coordinate2 (..) , mapCoordinate2 @@ -27,6 +28,7 @@ toPoint (x :+ y) = Point x y fromPoint (Point x y) = x :+ y +-- | Transform a coordinate through the canonical 'Point' representation. mapCoordinate2 :: (Coordinate2 input, Coordinate2 output) => (Point -> Point) diff --git a/src-dcel/Moonlight/Triangulation/IntersectionIterator.hs b/src-dcel/Moonlight/Triangulation/IntersectionIterator.hs --- a/src-dcel/Moonlight/Triangulation/IntersectionIterator.hs +++ b/src-dcel/Moonlight/Triangulation/IntersectionIterator.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} +-- | Ordered traversal of the mesh features met by a line segment. module Moonlight.Triangulation.IntersectionIterator ( Intersection (..) , lineIntersections diff --git a/src-dcel/Moonlight/Triangulation/Math.hs b/src-dcel/Moonlight/Triangulation/Math.hs --- a/src-dcel/Moonlight/Triangulation/Math.hs +++ b/src-dcel/Moonlight/Triangulation/Math.hs @@ -3,6 +3,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} +-- | Robust planar predicates and derived Euclidean constructions. module Moonlight.Triangulation.Math ( orient2d , sideQuery @@ -76,9 +77,11 @@ deriving stock (Bounded, Enum, Eq, Ord, Show, Generic) deriving anyclass (NFData) +-- | Every segment relation in constructor order. allSegmentRelations :: [SegmentRelation] allSegmentRelations = [minBound .. maxBound] +-- | Exact relation between two closed segments. segmentRelation :: Point -> Point @@ -114,6 +117,7 @@ opposite left right = (left == LT && right == GT) || (left == GT && right == LT) +-- | Whether two closed segments share any point. segmentsIntersect :: Point -> Point @@ -140,6 +144,7 @@ opposite GT LT = True opposite _ _ = False +-- | Classify a coordinate outside the exact-predicate input domain. validateCoordinate :: Double -> Maybe CoordinateError validateCoordinate value | isNaN value = Just CoordinateNaN @@ -155,6 +160,7 @@ maybe (Right ()) (Left . InvalidPointY) (validateCoordinate y) Right (QueryPoint (canonicalPoint point)) +-- | Validate a construction point while retaining its optional input slot. validatePoint :: Maybe Int -> Point -> Either BuildError (QueryPoint) validatePoint slot point@(Point x y) = case mkQueryPoint point of @@ -173,6 +179,7 @@ | value /= 0 && abs value < minimumAllowedCoordinate = 0 | otherwise = value +-- | Canonicalize both coordinate components for point identity. canonicalPoint :: Point -> Point canonicalPoint (Point x y) = Point (canonicalCoordinate x) (canonicalCoordinate y) {-# INLINE canonicalPoint #-} @@ -190,24 +197,29 @@ -- them per call. @value - value == 0@ is the same predicate in pure Double -- arithmetic: finite values subtract to zero, while NaN and the infinities -- subtract to NaN, which never compares equal. +-- | Whether a scalar is neither infinite nor NaN. isFinite :: Double -> Bool isFinite value = value - value == 0 {-# INLINE isFinite #-} +-- | Fast approximate signed orientation determinant. orientDetApprox :: Point -> Point -> Point -> Double orientDetApprox (Point ax ay) (Point bx by) (Point cx cy) = (ax - cx) * (by - cy) - (ay - cy) * (bx - cx) {-# INLINE orientDetApprox #-} +-- | Exact orientation ordering of three points. orient2d :: Point -> Point -> Point -> Ordering orient2d (Point ax ay) (Point bx by) (Point cx cy) = orient2dCoordinates ax ay bx by cx cy {-# INLINE orient2d #-} +-- | Exact side of an oriented line. sideQuery :: Point -> Point -> Point -> LineSideInfo sideQuery a b point = fromOrdering (orient2d a b point) {-# INLINE sideQuery #-} +-- | Fast approximate oriented in-circle determinant. inCircleDetApprox :: Point -> Point -> Point -> Point -> Double inCircleDetApprox @@ -243,6 +255,7 @@ inCircleCoordinates ax ay bx by cx cy dx dy {-# INLINE inCircle #-} +-- | Whether a point lies on a closed segment. onClosedSegment :: Point -> Point -> Point -> Bool onClosedSegment a@(Point ax ay) b@(Point bx by) query@(Point qx qy) = orient2d a b query == EQ @@ -252,6 +265,7 @@ && qy <= max ay by {-# INLINE onClosedSegment #-} +-- | Squared Euclidean distance. squaredDistance :: Point -> Point -> Double squaredDistance (Point ax ay) (Point bx by) = let !dx = ax - bx @@ -264,6 +278,7 @@ squaredDistanceWide = squaredDistance {-# INLINE squaredDistanceWide #-} +-- | Squared distance from a point to a closed segment. segmentDistanceSquared :: Point -> Point -> Point -> Double segmentDistanceSquared from@(Point ax ay) to@(Point bx by) point@(Point px py) @@ -285,23 +300,28 @@ segmentDistanceSquaredWide = segmentDistanceSquared {-# INLINE segmentDistanceSquaredWide #-} +-- | Euclidean distance. distance :: Point -> Point -> Double distance left right = sqrt (squaredDistance left right) {-# INLINE distance #-} +-- | Midpoint of two points. midpoint :: Point -> Point -> Point midpoint (Point ax ay) (Point bx by) = Point (0.5 * ax + 0.5 * bx) (0.5 * ay + 0.5 * by) {-# INLINE midpoint #-} +-- | Centroid of three points. centroid :: Point -> Point -> Point -> Point centroid (Point ax ay) (Point bx by) (Point cx cy) = Point (ax + (bx - ax) / 3 + (cx - ax) / 3) (ay + (by - ay) / 3 + (cy - ay) / 3) {-# INLINE centroid #-} +-- | Unsigned area of a triangle. triangleArea :: Point -> Point -> Point -> Double triangleArea a b c = 0.5 * abs (orientDetApprox a b c) {-# INLINE triangleArea #-} +-- | Circumradius divided by shortest edge length. triangleRadiusEdgeRatio :: Point -> Point -> Point -> Maybe Double triangleRadiusEdgeRatio p0 p1 p2 @@ -357,6 +377,7 @@ -- 1e183, five orders below the Double ceiling; the four divisions it cost -- are the circumcentre's hot-path price. Identical points answer through the -- denominator, which is exactly zero exactly when they are collinear. +-- | Circumcenter of a nondegenerate triangle. circumcenter :: Point -> Point -> Point -> Maybe (Point) circumcenter (Point ax ay) (Point bx by) (Point cx cy) @@ -376,6 +397,7 @@ !resultX = ax + offsetX !resultY = ay + offsetY +-- | Barycentric coordinates of a point in a nondegenerate triangle. barycentricCoordinates :: Point -> Point -> Point -> Point -> Maybe (Double, Double, Double) @@ -428,6 +450,7 @@ !dotSum = abs left + abs right {-# INLINE inDiametralCircle #-} +-- | Projection parameter of a point onto an oriented segment line. projectionFactor :: Point -> Point -> Point -> Double projectionFactor (Point ax ay) (Point bx by) (Point qx qy) | lengthSquared == 0 = 0 diff --git a/src-dcel/Moonlight/Triangulation/PointLocation.hs b/src-dcel/Moonlight/Triangulation/PointLocation.hs --- a/src-dcel/Moonlight/Triangulation/PointLocation.hs +++ b/src-dcel/Moonlight/Triangulation/PointLocation.hs @@ -15,9 +15,12 @@ import Moonlight.Triangulation.Math import Moonlight.Triangulation.Types +-- | Locate an admitted point without an initial topology hint. locatePoint :: Triangulation mode vertex directed undirected face -> QueryPoint -> Location locatePoint triangulation query = fst (locatePointWithHint triangulation Nothing query) +-- | Locate an admitted point from an optional starting cell and report the +-- descent work. locatePointWithHint :: Triangulation mode vertex directed undirected face -> Maybe LocationHint -> QueryPoint -> (Location, LocationStats) locatePointWithHint triangulation hint queryPoint | numVertices triangulation == 0 = (EmptyTriangulation, emptyLocationStats) @@ -124,4 +127,3 @@ [] -> FaceId 1 | otherwise -> FaceId 1 _ -> FaceId 1 - diff --git a/src-dual/Moonlight/Triangulation/HintGenerator.hs b/src-dual/Moonlight/Triangulation/HintGenerator.hs --- a/src-dual/Moonlight/Triangulation/HintGenerator.hs +++ b/src-dual/Moonlight/Triangulation/HintGenerator.hs @@ -6,6 +6,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NamedFieldPuns #-} +-- | Reusable point-location hints and their topology-preserving maintenance. module Moonlight.Triangulation.HintGenerator ( LastUsedHint , emptyLastUsedHint @@ -39,16 +40,20 @@ import Moonlight.Triangulation.Types import GHC.Generics (Generic) +-- | Most recently admitted vertex, suitable as the next descent seed. newtype LastUsedHint = LastUsedHint (Maybe VertexId) deriving stock (Show) deriving newtype (Eq, Ord) +-- | A last-used hint with no remembered vertex. emptyLastUsedHint :: LastUsedHint emptyLastUsedHint = LastUsedHint Nothing +-- | Project a remembered vertex into a location hint. lastUsedHint :: LastUsedHint -> Maybe LocationHint lastUsedHint (LastUsedHint vertex) = VertexHint <$> vertex +-- | Replace the remembered vertex. rememberVertex :: VertexId -> LastUsedHint -> LastUsedHint rememberVertex vertex _ = LastUsedHint (Just vertex) @@ -70,7 +75,9 @@ -- base this hierarchy describes, and is rebuilt for rather than patched. data HierarchyHint = HierarchyHint { hierarchyBranchFactor :: {-# UNPACK #-} !Int + -- ^ Sampling stride between adjacent hierarchy levels. , hierarchyBaseCount :: {-# UNPACK #-} !Int + -- ^ Cardinality of the base mesh described by the hierarchy. , hierarchyLevels :: !(V.Vector (Triangulation 'Unconstrained (Point) () () ())) } deriving stock (Generic) @@ -127,12 +134,15 @@ to = vertexPoint triangulation toVertex ] +-- | Default sampling stride between hierarchy levels. defaultHierarchyBranchFactor :: Int defaultHierarchyBranchFactor = 16 +-- | Number of stored sparse levels. hierarchyLevelCount :: HierarchyHint -> Int hierarchyLevelCount = V.length . hierarchyLevels +-- | Total vertices retained across every sparse level. hierarchyVertexCount :: HierarchyHint -> Int hierarchyVertexCount = V.foldl' (\total level -> total + numVertices level) 0 . hierarchyLevels diff --git a/src-dual/Moonlight/Triangulation/Internal/InterpolationWorkspace.hs b/src-dual/Moonlight/Triangulation/Internal/InterpolationWorkspace.hs --- a/src-dual/Moonlight/Triangulation/Internal/InterpolationWorkspace.hs +++ b/src-dual/Moonlight/Triangulation/Internal/InterpolationWorkspace.hs @@ -51,6 +51,7 @@ , nnWeightValue :: !(MUV.MVector state Double) } +-- | Allocate reusable interpolation storage sized to one triangulation. newNaturalNeighborWorkspace :: PrimMonad m => Triangulation mode vertex directed undirected face @@ -124,6 +125,7 @@ pure 1 else writeMutVar reference next >> pure next +-- | Bytes owned by the reusable numeric and index planes. workspaceBytes :: NaturalNeighborWorkspace state mode vertex directed undirected face -> Integer diff --git a/src-dual/Moonlight/Triangulation/Interpolation.hs b/src-dual/Moonlight/Triangulation/Interpolation.hs --- a/src-dual/Moonlight/Triangulation/Interpolation.hs +++ b/src-dual/Moonlight/Triangulation/Interpolation.hs @@ -89,10 +89,14 @@ deriving stock (Eq, Show, Generic) deriving anyclass (NFData) +-- | Work performed by one natural-neighbor query. data InterpolationStats = InterpolationStats { interpolationCavityFaces :: {-# UNPACK #-} !Int + -- ^ Faces in the query insertion cavity. , interpolationNaturalNeighbors :: {-# UNPACK #-} !Int + -- ^ Sites contributing nonzero Sibson weight. , interpolationFaceTests :: {-# UNPACK #-} !Int + -- ^ Faces tested while discovering the cavity. -- | 'True' exactly when the Sibson pipeline declined and the returned -- weights are the barycentric coordinates of the located face instead. -- A silent degradation from Sibson to barycentric is a defect that hides; @@ -102,10 +106,14 @@ deriving stock (Eq, Ord, Show, Generic) deriving anyclass (NFData) +-- | Weights and receipts produced by one natural-neighbor query. data NaturalNeighborResult = NaturalNeighborResult { naturalNeighborValues :: !(V.Vector (VertexId, Double)) + -- ^ Nonzero weights keyed by source vertex. , naturalNeighborLocationStats :: !LocationStats + -- ^ Work performed while locating the query. , naturalNeighborStats :: !InterpolationStats + -- ^ Work performed while constructing the Sibson coordinates. } deriving stock (Eq, Show, Generic) deriving anyclass (NFData) @@ -192,6 +200,7 @@ then (candidate, candidateDistance, tests + 1) else (best, bestDistance, tests + 1) +-- | Barycentric weights at a validated query, plus point-location work. barycentricWeights :: Triangulation mode vertex directed undirected face -> Maybe LocationHint @@ -706,6 +715,7 @@ TwoWeights a wa b wb -> Just (wa * sample a + wb * sample b) ThreeWeights a wa b wb c wc -> Just (wa * sample a + wb * sample b + wc * sample c) +-- | Interpolate from reusable Sibson weights. interpolateNaturalNeighbor :: (VertexId -> Double) -> NaturalNeighborWorkspace s mode vertex directed undirected face @@ -722,6 +732,7 @@ query pure (if interpolationNaturalNeighbors stats == 0 then Nothing else Just total, stats) +-- | Estimate one vertex gradient from its Delaunay neighbors. estimateGradient :: (VertexId -> Double) -> Triangulation mode vertex directed undirected face @@ -771,6 +782,7 @@ then (sumX + normalX, sumY + normalY, sumZ + normalZ) else (sumX, sumY, sumZ) +-- | Estimate gradients for every vertex in handle order. estimateGradients :: (VertexId -> Double) -> Triangulation mode vertex directed undirected face @@ -779,6 +791,7 @@ V.generate (numVertices triangulation) $ \index -> estimateGradient sample triangulation (VertexId (fromIntegral index)) +-- | Natural-neighbor interpolation with nodal-gradient correction. interpolateNaturalNeighborGradient :: (VertexId -> Double) -> (VertexId -> (Double, Double)) diff --git a/src-dual/Moonlight/Triangulation/Voronoi.hs b/src-dual/Moonlight/Triangulation/Voronoi.hs --- a/src-dual/Moonlight/Triangulation/Voronoi.hs +++ b/src-dual/Moonlight/Triangulation/Voronoi.hs @@ -38,65 +38,82 @@ import Moonlight.Triangulation.Math import Moonlight.Triangulation.Types +-- | A Voronoi face, identified by its primal site. +-- -- The dual uses the exact same fixed-index space as the primal DCEL. These -- newtypes add semantic separation without allocating or owning any dual mesh. newtype VoronoiFaceId = VoronoiFaceId { unVoronoiFaceId :: VertexId } deriving stock (Show) deriving newtype (Eq, Ord, NFData) +-- | An oriented Voronoi edge, identified by its primal directed edge. newtype DirectedVoronoiEdgeId = DirectedVoronoiEdgeId { unDirectedVoronoiEdgeId :: DirectedEdgeId } deriving stock (Show) deriving newtype (Eq, Ord, NFData) +-- | An unoriented Voronoi edge, identified by its primal undirected edge. newtype UndirectedVoronoiEdgeId = UndirectedVoronoiEdgeId { unUndirectedVoronoiEdgeId :: UndirectedEdgeId } deriving stock (Show) deriving newtype (Eq, Ord, NFData) +-- | A finite dual vertex or an ideal endpoint of an unbounded dual edge. data VoronoiVertexId = InnerVoronoiVertex !FaceId | OuterVoronoiVertex !DirectedVoronoiEdgeId deriving stock (Eq, Ord, Show) +-- | Finite segment, half-infinite ray, or infinite line in the dual. data VoronoiEdgeGeometry = VoronoiSegment !(Point) !(Point) | VoronoiRay !(Point) !(Point) | VoronoiLine !(Point) !(Point) deriving stock (Eq, Ord, Show) +-- | Voronoi faces in primal vertex-handle order. voronoiFaces :: Triangulation mode vertex directed undirected face -> [VoronoiFaceId] voronoiFaces triangulation = map VoronoiFaceId (vertices triangulation) {-# INLINE voronoiFaces #-} +-- | Directed Voronoi edges in primal directed-edge order. +-- -- Every primal directed edge is one directed edge in the dual. Boundary -- handles naturally represent half-infinite edges through OuterVoronoiVertex. directedVoronoiEdges :: Triangulation mode vertex directed undirected face -> [DirectedVoronoiEdgeId] directedVoronoiEdges triangulation = map DirectedVoronoiEdgeId (directedEdges triangulation) {-# INLINE directedVoronoiEdges #-} +-- | Undirected Voronoi edges in primal undirected-edge order. undirectedVoronoiEdges :: Triangulation mode vertex directed undirected face -> [UndirectedVoronoiEdgeId] undirectedVoronoiEdges triangulation = map UndirectedVoronoiEdgeId (undirectedEdges triangulation) {-# INLINE undirectedVoronoiEdges #-} +-- | Recover the primal directed edge. asDelaunayDirectedEdge :: DirectedVoronoiEdgeId -> DirectedEdgeId asDelaunayDirectedEdge = unDirectedVoronoiEdgeId {-# INLINE asDelaunayDirectedEdge #-} +-- | Recover the primal undirected edge. asDelaunayUndirectedEdge :: UndirectedVoronoiEdgeId -> UndirectedEdgeId asDelaunayUndirectedEdge = unUndirectedVoronoiEdgeId {-# INLINE asDelaunayUndirectedEdge #-} +-- | View a primal directed edge in the dual handle family. asDirectedVoronoiEdge :: DirectedEdgeId -> DirectedVoronoiEdgeId asDirectedVoronoiEdge = DirectedVoronoiEdgeId {-# INLINE asDirectedVoronoiEdge #-} +-- | View a primal undirected edge in the dual handle family. asUndirectedVoronoiEdge :: UndirectedEdgeId -> UndirectedVoronoiEdgeId asUndirectedVoronoiEdge = UndirectedVoronoiEdgeId {-# INLINE asUndirectedVoronoiEdge #-} +-- | Reverse a directed Voronoi edge. reverseVoronoiEdge :: DirectedVoronoiEdgeId -> DirectedVoronoiEdgeId reverseVoronoiEdge (DirectedVoronoiEdgeId edge) = DirectedVoronoiEdgeId (reverseEdge edge) {-# INLINE reverseVoronoiEdge #-} +-- | Next dual edge around the incident Voronoi face. +-- -- Dual next/previous rotate around the primal origin site. voronoiNext :: Triangulation mode vertex directed undirected face @@ -106,6 +123,7 @@ DirectedVoronoiEdgeId (counterClockwise triangulation edge) {-# INLINE voronoiNext #-} +-- | Previous dual edge around the incident Voronoi face. voronoiPrevious :: Triangulation mode vertex directed undirected face -> DirectedVoronoiEdgeId @@ -114,6 +132,7 @@ DirectedVoronoiEdgeId (clockwise triangulation edge) {-# INLINE voronoiPrevious #-} +-- | Origin dual vertex, including ideal endpoints on the hull. voronoiFrom :: Triangulation mode vertex directed undirected face -> DirectedVoronoiEdgeId @@ -125,6 +144,7 @@ face = incidentFace triangulation primal {-# INLINE voronoiFrom #-} +-- | Destination dual vertex, including ideal endpoints on the hull. voronoiTo :: Triangulation mode vertex directed undirected face -> DirectedVoronoiEdgeId @@ -132,6 +152,7 @@ voronoiTo triangulation = voronoiFrom triangulation . reverseVoronoiEdge {-# INLINE voronoiTo #-} +-- | Voronoi face to the left of a directed dual edge. voronoiIncidentFace :: Triangulation mode vertex directed undirected face -> DirectedVoronoiEdgeId @@ -140,10 +161,12 @@ VoronoiFaceId (origin triangulation edge) {-# INLINE voronoiIncidentFace #-} +-- | Primal site represented by a Voronoi face. voronoiFaceSite :: VoronoiFaceId -> VertexId voronoiFaceSite = unVoronoiFaceId {-# INLINE voronoiFaceSite #-} +-- | Directed boundary of a Voronoi face. voronoiFaceAdjacentEdges :: Triangulation mode vertex directed undirected face -> VoronoiFaceId @@ -152,6 +175,8 @@ map DirectedVoronoiEdgeId (vertexOutgoingEdges triangulation site) {-# INLINE voronoiFaceAdjacentEdges #-} +-- | Position of a finite dual vertex; ideal hull endpoints have no position. +-- -- A caller reaches this through 'voronoiFrom' or 'voronoiTo', which build the -- endpoint sum immediately before it is taken apart again. Only an unfolding at -- the consumer lets the two meet, so the constructor never reaches the heap. @@ -164,6 +189,7 @@ OuterVoronoiVertex _ -> Nothing {-# INLINE voronoiVertexPosition #-} +-- | Directed dual edges leaving a finite dual vertex. voronoiVertexOutgoingEdges :: Triangulation mode vertex directed undirected face -> VoronoiVertexId @@ -178,6 +204,7 @@ | otherwise = Just face {-# INLINE voronoiVertexOutgoingEdges #-} +-- | Unit direction of the dual edge orthogonal to a primal edge. voronoiDirectionVector :: Triangulation mode vertex directed undirected face -> DirectedVoronoiEdgeId @@ -187,6 +214,8 @@ Point ax ay -> case vertexPoint triangulation (destination triangulation edge) of Point bx by -> Point (ay - by) (bx - ax) +-- | Circumcenter of a bounded primal face. +-- -- The circumcentre stands on the absolute vertex positions, which is a -- different value from the query-relative one the Sibson pipeline caches: that -- one rescales the differences it was handed, so translating the inputs moves @@ -216,6 +245,8 @@ (vertexPoint triangulation (origin triangulation e2)) {-# INLINE faceCircumcenter #-} +-- | Geometric realization of one dual edge. +-- -- The endpoint classification 'voronoiFrom' and 'voronoiTo' publish is two face -- reads and two comparisons; taken through those observations it is also two -- sum values built and immediately scrutinized. The geometry reads the faces diff --git a/src-dual/Moonlight/Triangulation/Voronoi/Handles.hs b/src-dual/Moonlight/Triangulation/Voronoi/Handles.hs --- a/src-dual/Moonlight/Triangulation/Voronoi/Handles.hs +++ b/src-dual/Moonlight/Triangulation/Voronoi/Handles.hs @@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} +-- | Zero-copy Voronoi views that retain the owning triangulation. module Moonlight.Triangulation.Voronoi.Handles ( VoronoiFaceHandle , DirectedVoronoiEdgeHandle @@ -46,12 +47,15 @@ newtype VoronoiFaceHandle mode vertex directed undirected face = VoronoiFaceHandle (VertexHandle mode vertex directed undirected face) +-- | An owning handle to a directed dual edge. newtype DirectedVoronoiEdgeHandle mode vertex directed undirected face = DirectedVoronoiEdgeHandle (DirectedEdgeHandle mode vertex directed undirected face) +-- | An owning handle to an undirected dual edge. newtype UndirectedVoronoiEdgeHandle mode vertex directed undirected face = UndirectedVoronoiEdgeHandle (UndirectedEdgeHandle mode vertex directed undirected face) +-- | An owning handle to a finite or ideal dual vertex. data VoronoiVertexHandle mode vertex directed undirected face = InnerVoronoiVertexHandle !(FaceHandle InnerTag mode vertex directed undirected face) @@ -70,6 +74,7 @@ instance Show (VoronoiVertexHandle mode vertex directed undirected face) where showsPrec precedence = showsPrec precedence . fixVoronoiVertex +-- | Admit a fixed Voronoi face identifier into a triangulation. voronoiFaceHandle :: Triangulation mode vertex directed undirected face -> VoronoiFaceId @@ -77,11 +82,13 @@ voronoiFaceHandle triangulation (VoronoiFaceId site) = VoronoiFaceHandle <$> vertexHandle triangulation site +-- | View an admitted primal vertex as its Voronoi face. vertexAsVoronoiFaceH :: VertexHandle mode vertex directed undirected face -> VoronoiFaceHandle mode vertex directed undirected face vertexAsVoronoiFaceH = VoronoiFaceHandle +-- | Admit a fixed directed Voronoi edge identifier into a triangulation. directedVoronoiEdgeHandle :: Triangulation mode vertex directed undirected face -> DirectedVoronoiEdgeId @@ -89,11 +96,13 @@ directedVoronoiEdgeHandle triangulation (DirectedVoronoiEdgeId edge) = DirectedVoronoiEdgeHandle <$> directedEdgeHandle triangulation edge +-- | View an admitted primal directed edge in the dual handle family. directedEdgeAsVoronoiH :: DirectedEdgeHandle mode vertex directed undirected face -> DirectedVoronoiEdgeHandle mode vertex directed undirected face directedEdgeAsVoronoiH = DirectedVoronoiEdgeHandle +-- | Admit a fixed undirected Voronoi edge identifier into a triangulation. undirectedVoronoiEdgeHandle :: Triangulation mode vertex directed undirected face -> UndirectedVoronoiEdgeId @@ -101,20 +110,24 @@ undirectedVoronoiEdgeHandle triangulation (UndirectedVoronoiEdgeId edge) = UndirectedVoronoiEdgeHandle <$> undirectedEdgeHandle triangulation edge +-- | View an admitted primal undirected edge in the dual handle family. undirectedEdgeAsVoronoiH :: UndirectedEdgeHandle mode vertex directed undirected face -> UndirectedVoronoiEdgeHandle mode vertex directed undirected face undirectedEdgeAsVoronoiH = UndirectedVoronoiEdgeHandle +-- | View an admitted bounded primal face as a finite dual vertex. innerFaceAsVoronoiVertexH :: FaceHandle InnerTag mode vertex directed undirected face -> VoronoiVertexHandle mode vertex directed undirected face innerFaceAsVoronoiVertexH = InnerVoronoiVertexHandle +-- | Forget ownership and recover a fixed Voronoi face identifier. fixVoronoiFace :: VoronoiFaceHandle mode vertex directed undirected face -> VoronoiFaceId fixVoronoiFace (VoronoiFaceHandle site) = VoronoiFaceId (fixVertex site) {-# INLINE fixVoronoiFace #-} +-- | Forget ownership and recover a fixed directed dual edge identifier. fixDirectedVoronoiEdge :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> DirectedVoronoiEdgeId @@ -122,6 +135,7 @@ DirectedVoronoiEdgeId (fixDirectedEdge edge) {-# INLINE fixDirectedVoronoiEdge #-} +-- | Forget ownership and recover a fixed undirected dual edge identifier. fixUndirectedVoronoiEdge :: UndirectedVoronoiEdgeHandle mode vertex directed undirected face -> UndirectedVoronoiEdgeId @@ -129,6 +143,7 @@ UndirectedVoronoiEdgeId (fixUndirectedEdge edge) {-# INLINE fixUndirectedVoronoiEdge #-} +-- | Forget ownership and recover a fixed dual vertex identifier. fixVoronoiVertex :: VoronoiVertexHandle mode vertex directed undirected face -> VoronoiVertexId @@ -138,24 +153,28 @@ OuterVoronoiVertex (fixDirectedVoronoiEdge edge) {-# INLINE fixVoronoiVertex #-} +-- | Reverse an admitted directed dual edge. voronoiEdgeReverseH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> DirectedVoronoiEdgeHandle mode vertex directed undirected face voronoiEdgeReverseH (DirectedVoronoiEdgeHandle edge) = DirectedVoronoiEdgeHandle (directedEdgeReverse edge) +-- | Next admitted dual edge around its Voronoi face. voronoiEdgeNextH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> DirectedVoronoiEdgeHandle mode vertex directed undirected face voronoiEdgeNextH (DirectedVoronoiEdgeHandle edge) = DirectedVoronoiEdgeHandle (directedEdgeCounterClockwise edge) +-- | Previous admitted dual edge around its Voronoi face. voronoiEdgePreviousH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> DirectedVoronoiEdgeHandle mode vertex directed undirected face voronoiEdgePreviousH (DirectedVoronoiEdgeHandle edge) = DirectedVoronoiEdgeHandle (directedEdgeClockwise edge) +-- | Origin finite or ideal vertex of an admitted dual edge. voronoiEdgeFromH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> VoronoiVertexHandle mode vertex directed undirected face @@ -164,45 +183,53 @@ Just inner -> InnerVoronoiVertexHandle inner Nothing -> OuterVoronoiVertexHandle edge +-- | Destination finite or ideal vertex of an admitted dual edge. voronoiEdgeToH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> VoronoiVertexHandle mode vertex directed undirected face voronoiEdgeToH = voronoiEdgeFromH . voronoiEdgeReverseH +-- | Voronoi face to the left of an admitted directed dual edge. voronoiEdgeFaceH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> VoronoiFaceHandle mode vertex directed undirected face voronoiEdgeFaceH (DirectedVoronoiEdgeHandle edge) = VoronoiFaceHandle (directedEdgeFrom edge) +-- | Forget orientation while retaining ownership. voronoiEdgeAsUndirectedH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> UndirectedVoronoiEdgeHandle mode vertex directed undirected face voronoiEdgeAsUndirectedH (DirectedVoronoiEdgeHandle edge) = UndirectedVoronoiEdgeHandle (directedEdgeAsUndirected edge) +-- | Recover the owning primal directed-edge handle. voronoiEdgeAsDelaunayH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> DirectedEdgeHandle mode vertex directed undirected face voronoiEdgeAsDelaunayH (DirectedVoronoiEdgeHandle edge) = edge +-- | Recover the owning primal site handle. voronoiFaceSiteH :: VoronoiFaceHandle mode vertex directed undirected face -> VertexHandle mode vertex directed undirected face voronoiFaceSiteH (VoronoiFaceHandle site) = site +-- | Admitted directed boundary of a Voronoi face. voronoiFaceAdjacentEdgesH :: VoronoiFaceHandle mode vertex directed undirected face -> [DirectedVoronoiEdgeHandle mode vertex directed undirected face] voronoiFaceAdjacentEdgesH (VoronoiFaceHandle site) = map DirectedVoronoiEdgeHandle (vertexHandleOutEdges site) +-- | Position of a finite admitted dual vertex. voronoiVertexPositionH :: VoronoiVertexHandle mode vertex directed undirected face -> Maybe (Point) voronoiVertexPositionH (InnerVoronoiVertexHandle face) = innerFaceCircumcenter face voronoiVertexPositionH (OuterVoronoiVertexHandle _) = Nothing +-- | Directed dual edges leaving a finite admitted dual vertex. voronoiVertexOutEdgesH :: VoronoiVertexHandle mode vertex directed undirected face -> Maybe [DirectedVoronoiEdgeHandle mode vertex directed undirected face] @@ -210,18 +237,21 @@ Just (map DirectedVoronoiEdgeHandle (faceAdjacentEdges face)) voronoiVertexOutEdgesH (OuterVoronoiVertexHandle _) = Nothing +-- | Recover the primal bounded face underlying a finite dual vertex. voronoiVertexAsDelaunayFaceH :: VoronoiVertexHandle mode vertex directed undirected face -> Maybe (FaceHandle InnerTag mode vertex directed undirected face) voronoiVertexAsDelaunayFaceH (InnerVoronoiVertexHandle face) = Just face voronoiVertexAsDelaunayFaceH (OuterVoronoiVertexHandle _) = Nothing +-- | Recover the primal hull edge underlying an ideal dual vertex. voronoiVertexAsOuterEdgeH :: VoronoiVertexHandle mode vertex directed undirected face -> Maybe (DirectedVoronoiEdgeHandle mode vertex directed undirected face) voronoiVertexAsOuterEdgeH (InnerVoronoiVertexHandle _) = Nothing voronoiVertexAsOuterEdgeH (OuterVoronoiVertexHandle edge) = Just edge +-- | Unit direction of the dual edge orthogonal to the primal edge. voronoiEdgeDirectionH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> Point @@ -229,6 +259,7 @@ let (Point ax ay, Point bx by) = directedEdgePositions primal in Point (ay - by) (bx - ax) +-- | Geometric realization of an admitted dual edge. voronoiEdgeGeometryH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> Maybe (VoronoiEdgeGeometry) @@ -265,4 +296,3 @@ -- reaches its arithmetic through 'innerFaceCircumcenter', whose own worker -- publishes no unfolding, so it stops at that call until the dcel layer says -- otherwise. - diff --git a/src-public/Moonlight/Triangulation.hs b/src-public/Moonlight/Triangulation.hs --- a/src-public/Moonlight/Triangulation.hs +++ b/src-public/Moonlight/Triangulation.hs @@ -1,4 +1,20 @@ --- | The equational surface: a triangulation is a value of its site set. +-- | The public surface for Delaunay triangulations as values of finite +-- coordinate supports. Its exports are grouped by object, generation, +-- annotations, finite-set algebra, constraints, refinement, observations and +-- validation. +-- +-- Geometry-only set laws are observed after erasing vertex annotations with +-- @mapVertices (const ())@ and applying 'canonicalize'. Successful construction +-- may retain schedule-dependent resident numbering, so structural 'Eq' compares +-- stored representations rather than silently normalizing them. Annotations may +-- change independently through 'mapVertices' and 'setVertexData'; they never +-- determine geometry. +-- +-- The algebra is deliberately partial. Finite arena exhaustion is returned as +-- 'BuildError', while unrealizable constrained compositions return +-- 'ConstrainedUnionError'. These typed obstructions are why the surface exposes +-- explicit operations rather than total 'Semigroup' instances. Refinement then +-- composes over any admitted result without introducing a second mesh type. module Moonlight.Triangulation ( -- * The object — a triangulation is a value of its site set Triangulation