{-# LANGUAGE RecordWildCards #-} -------------------------------------------------------------------------------- -- | -- Module : Data.PlanarGraph.Immutable -- Copyright : (C) David Himmelstrup -- License : see the LICENSE file -- Maintainer : David Himmelstrup -- -- A graph is planar if it can be drawn on a flat piece of -- paper without any crossing edges. More theory is explained on wikipedia: -- -- -- This module describes the connectivity of planar graphs without knowing -- the 2D coordinates of each vertex. Algorithms that require the vertex -- positions (such as planar point locators or mesh smoothers) have to store -- that information somewhere else. Vertices are identified by dense, consecutive -- integers and can be efficiently used with arrays or finite maps. -- -- A planar graph consists of directed edges (also called half-edges or darts), -- vertices, and faces. If a face lies on the outside of a set of vertices, this -- face is called a boundary. -- -- The simplest planar graph has just three vertices and three edges: -- -- @'pgFromFaces' [[0,1,2]]@ -- -- <> -- -- The above pictures shows three vertices (named @'0'@, @'1'@, and @'2'@), a single face -- (named @'0'@ with an underscore), and 6 half-edges (named @'0'@ through @'5'@). -- Vertices, faces, and half-edges can be efficiently queried and traversed. -- -- >>> let pg = pgFromFaces [[0,1,2]] -- >>> pgFaces pg -- [Face 0] -- >>> faceBoundary (Face 0) pg -- [Vertex 1,Vertex 2,Vertex 0] -- -- -- == Planar graph examples: -- -- Faces in planar graphs do not have to be triangular: -- -- @'pgFromFaces' [[0,1,2,3]]@ -- -- <> -- -- Vertices may be interior or lie on a boundary: -- -- @'pgFromFaces' [[0,1,2,3],[4,3,2,1]]@ -- -- <> -- -- >>> let pg = pgFromFaces [[0,1,2,3],[4,3,2,1]] -- >>> pgFaces pg -- [Face 0,Face 1] -- >>> vertexIsBoundary (Vertex 0) pg -- True -- >>> vertexIsBoundary (Vertex 2) pg -- False -- -- Planar graphs may have multiple boundaries. Notice how the area between vertices -- @'1'@, @'2'@ and @'3'@ does not have a face ID: -- -- @'pgFromFaces' [[0,4,1],[0,1,2],[4,3,1],[4,5,3],[3,5,2],[2,5,0]]@ -- -- <> -- -- >>> let pg = pgFromFaces [[0,4,1],[0,1,2],[4,3,1],[4,5,3],[3,5,2],[2,5,0]] -- >>> pgFaces pg -- [Face 0,Face 1,Face 2,Face 3,Face 4,Face 5] -- >>> pgBoundaries pg -- [Boundary 0,Boundary 1] -- >>> faceBoundary (Boundary 0) pg {- Outer boundary -} -- [Vertex 0,Vertex 4,Vertex 5] -- >>> faceBoundary (Boundary 1) pg {- Inner boundary -} -- [Vertex 1,Vertex 2,Vertex 3] -- -- Planar graphs may also have multiple unconnected components but they cannot be -- automatically rendered: -- -- >>> let pg = pgFromFaces [[0,1,2], [3,4,5]] -- >>> pgFaces pg -- [Face 0,Face 1] -- >>> pgBoundaries pg -- [Boundary 0,Boundary 1] -- >>> faceBoundary (Boundary 0) pg -- [Vertex 0,Vertex 1,Vertex 2] -- >>> faceBoundary (Boundary 1) pg -- [Vertex 3,Vertex 4,Vertex 5] -- -- == Big-O Notation -- -- When describing runtime complexity, @n@ refers to the size of the graph -- (vertices, half-edges, faces, etcs). Some functions are output-sensitive -- and use @k@ to indicate the amount of data consumed. For example, -- 'vertexNeighbours' runs in \( O(k) \) and taking the first neighbour is therefore -- an \( O(1) \) operation (because k=1). -------------------------------------------------------------------------------- module Data.PlanarGraph.Immutable ( -- * Planar graphs PlanarGraph , pgFromFaces -- :: [[VertexId]] -> PlanarGraph , pgFromFacesCV -- :: [CircularVector VertexId] -> PlanarGraph , pgVertices -- :: PlanarGraph -> [Vertex] , pgEdges -- :: PlanarGraph -> [Edge] , pgHalfEdges -- :: PlanarGraph -> [HalfEdge] , pgFaces -- :: PlanarGraph -> [Face] , pgBoundaries -- :: PlanarGraph -> [Face] -- * Elements -- ** Vertices , Vertex(..) , vertexHalfEdge -- :: Vertex -> PlanarGraph -> HalfEdge , vertexIsInterior -- :: Vertex -> PlanarGraph -> Bool , vertexIsBoundary -- :: Vertex -> PlanarGraph -> Bool , vertexOutgoingHalfEdges -- :: Vertex -> PlanarGraph -> [HalfEdge] , vertexIncomingHalfEdges -- :: Vertex -> PlanarGraph -> [HalfEdge] , vertexNeighbours -- :: Vertex -> PlanarGraph -> [Vertex] -- ** Edges , Edge(..) , edgeHalfEdges -- :: Edge -> (HalfEdge, HalfEdge) -- ** Half-edges , HalfEdge(..) , halfEdgeNext -- :: HalfEdge -> PlanarGraph -> HalfEdge , halfEdgePrev -- :: HalfEdge -> PlanarGraph -> HalfEdge , halfEdgeTwin -- :: HalfEdge -> HalfEdge , halfEdgeNextOutgoing -- :: HalfEdge -> PlanarGraph -> HalfEdge , halfEdgeNextIncoming -- :: HalfEdge -> PlanarGraph -> HalfEdge , halfEdgeVertex -- :: HalfEdge -> PlanarGraph -> Vertex , halfEdgeTailVertex -- :: HalfEdge -> PlanarGraph -> Vertex , halfEdgeTipVertex -- :: HalfEdge -> PlanarGraph -> Vertex , halfEdgeFace -- :: HalfEdge -> PlanarGraph -> Face , halfEdgeIsInterior -- :: HalfEdge -> PlanarGraph -> Bool , halfEdgeIsBoundary -- :: HalfEdge -> PlanarGraph -> Bool -- ** Faces , Face(..), FaceId , faceMember -- :: Face -> PlanarGraph -> Bool , faceId -- :: Face -> FaceId , faceHalfEdge -- :: Face -> PlanarGraph -> HalfEdge , faceIsInterior -- :: Face -> Bool , faceIsBoundary -- :: Face -> Bool , faceHalfEdges -- :: Face -> PlanarGraph -> CircularVector HalfEdge , faceBoundary -- :: Face -> PlanarGraph -> CircularVector Vertex -- * Mutation , pgMutate -- :: PlanarGraph -> (forall s. Mut.PlanarGraph s -> ST s ()) -> PlanarGraph , pgCreate -- :: (forall s. ST s (Mut.PlanarGraph s)) -> PlanarGraph , pgThaw -- :: PlanarGraph -> ST s (Mut.PlanarGraph s) , pgFreeze -- :: Mut.PlanarGraph s -> ST s PlanarGraph , pgUnsafeThaw -- :: PlanarGraph -> ST s (Mut.PlanarGraph s) , pgUnsafeFreeze -- :: Mut.PlanarGraph s -> ST s PlanarGraph -- * Misc , tutteEmbedding -- :: PlanarGraph -> Vector.Vector (V2 Double) ) where import Control.Monad import Control.Monad.ST import Data.Bits import Data.Coerce import Data.Hashable import Data.PlanarGraph.Internal (FaceId, HalfEdgeId, VertexId) import qualified Data.PlanarGraph.Internal as Mut import qualified Data.PlanarGraph.Mutable as Mut import Data.Proxy import Data.STRef import Data.Vector (Vector) import qualified Data.Vector as Vector import Data.Vector.Circular (CircularVector) import qualified Data.Vector.Circular as CV import qualified Data.Vector.Mutable as V import GHC.Exts import Linear.Matrix (luSolve) import Linear.V import Linear.V2 -- import Debug.Trace ------------------------------------------------------------------------------- -- Elements: Half-edges, vertices, faces. -- | Half-edges are directed edges between vertices. All Half-edge have a twin -- in the opposite direction. Half-edges have individual identity but are always -- created in pairs. newtype HalfEdge = HalfEdge {halfEdgeId :: Int} deriving (Eq, Hashable) instance Show HalfEdge where showsPrec d (HalfEdge v) = showParen (d > 10) $ showString "HalfEdge " . shows v instance Read HalfEdge where readsPrec d = readParen (d > app_prec) $ \r -> [ (HalfEdge v, t) | ("HalfEdge", s) <- lex r, (v, t) <- reads s ] where app_prec = 10 -- | Edges are bidirectional and connect two vertices. No two edges are allowed -- to cross. newtype Edge = Edge {edgeId :: Int} deriving (Eq, Hashable) instance Show Edge where showsPrec d (Edge v) = showParen (d > 10) $ showString "Edge " . shows v instance Read Edge where readsPrec d = readParen (d > app_prec) $ \r -> [ (Edge v, t) | ("Edge", s) <- lex r, (v, t) <- reads s ] where app_prec = 10 -- | Graph vertices. For best performance, make sure to use consecutive numbers. newtype Vertex = Vertex {vertexId :: Int} deriving (Eq, Hashable) instance Show Vertex where showsPrec d (Vertex v) = showParen (d > 10) $ showString "Vertex " . shows v instance Read Vertex where readsPrec d = readParen (d > app_prec) $ \r -> [ (Vertex v, t) | ("Vertex", s) <- lex r, (v, t) <- reads s ] where app_prec = 10 -- | Faces are the areas divided by edges. If a face is not surrounded by a set of vertices, -- it is called a boundary. data Face = Face FaceId | Boundary FaceId deriving (Eq, Read, Show) ------------------------------------------------------------------------------- -- Planar graph -- PlanarGraphs have vertices, edges, and faces. -- Invariant: The half-edge of a boundary vertex is interior, twin is exterior. -- FIXME: Use STRefU ? -- PlanarGraph with 0 vertices: No edges, no vertices, no faces. -- PlanarGraph with 1 vertex: No edges, no interior faces. -- PlanarGraph with 2 vertices: One edge, no interior faces. -- PlanarGraph with 3+ vertices: Usual properties hold. -- | Immutable planar graph. data PlanarGraph = PlanarGraph { pgHalfEdgeNext :: !(Vector HalfEdgeId) -- HalfEdge indexed , pgHalfEdgePrev :: !(Vector HalfEdgeId) -- HalfEdge indexed , pgHalfEdgeVertex :: !(Vector VertexId) -- HalfEdge indexed , pgHalfEdgeFace :: !(Vector FaceId) -- HalfEdge indexed , pgVertexEdges :: !(Vector HalfEdgeId) -- Vertex indexed , pgFaceEdges :: !(Vector HalfEdgeId) -- Face indexed , pgBoundaryEdges :: !(Vector HalfEdgeId) -- Boundary faces } deriving Eq panic :: String -> String -> a panic tag msg = error $ "Data.PlanarGraph.Immutable." ++ tag ++ ": " ++ msg -- Disabled since hashes are not stable across different versions of hashable. -- // $setup -- -- >>> hash $ pgFromFaces [[0,1,2]] -- 2959979592048325618 -- >>> hash $ pgFromFaces [[1,2,3]] -- 2486673127436488352 -- >>> hash $ pgFromFaces [[0,1,2,3]] -- 2506803680640023584 -- >>> hash $ pgFromFaces [[0,1,2,3],[4,3,2,1]] -- 1711135548958680232 -- -- | \( O(n \log n) \) -- -- Construct a planar graph from a list of faces. Vertices are assumed to be dense -- (ie without gaps) but this only affects performance, not correctness. Memory -- usage is defined by the largest vertex ID. That means @'pgFromFaces' [[0,1,2]]@ -- has the same connectivity as @'pgFromFaces' [[7,8,9]]@ but uses three times less -- memory. -- -- ==== __Examples:__ -- @ -- 'pgFromFaces' [[0,1,2]] -- @ -- <> -- -- @ -- 'pgFromFaces' [[0,1,2,3]] -- @ -- <> -- -- @ -- 'pgFromFaces' [[1,2,3]] -- @ -- <> -- -- @since 0.12.0.0 pgFromFaces :: [[VertexId]] -> PlanarGraph pgFromFaces = pgFromFacesCV . map CV.unsafeFromList -- | \( O(n \log n) \) -- -- Construct a planar graph from a list of faces. This is a slightly more -- efficient version of 'pgFromFacesCV'. -- -- @since 0.12.0.0 pgFromFacesCV :: [CircularVector VertexId] -> PlanarGraph pgFromFacesCV faces = pgCreate $ Mut.pgFromFacesCV faces -- fromFaces' :: Int -> Int -> Int -> [CircularVector VertexId] -> ST s (PlanarGraph) -- fromFaces' nFaces nHalfEdges maxVertexId faces = do -- undefined -- dualTree :: Face -> ST s (Tree Face) -- dualTree = undefined instance Hashable PlanarGraph where hashWithSalt salt = hashWithSalt salt . pgHash hash = pgHash -- | O(n) -- -- @since 0.12.0.0 pgHash :: PlanarGraph -> Int pgHash pg = let loop [] salt = salt loop (edgeId:rest) salt = let he = HalfEdge (edgeId*2) vTail = halfEdgeTailVertex he pg vTip = halfEdgeTipVertex he pg in loop rest (hashWithSalt salt (vTail, vTip)) in abs $ loop [0..Vector.length (pgHalfEdgeNext pg)`div`2-1] 0 ------------------------------------------------------------------------------- -- Vertices -- | O(1) vertexCheck :: String -> Vertex -> PlanarGraph -> a -> a vertexCheck tag (Vertex vId) pg _val | vId >= Vector.length (pgVertexEdges pg) || vId < 0 = panic tag ("Out-of-bounds vertex access: " ++ show vId) | not (halfEdgeIsValid (HalfEdge (pgVertexEdges pg Vector.! vId))) = panic tag ("Tried to access deleted vertex: " ++ show vId) vertexCheck _tag _face _pg val = val -- | \( O(k) \) -- -- List all vertices in a graph. -- -- ==== __Examples:__ -- -- >>> let pg = pgFromFaces [[0,1,2]] -- -- <> -- -- >>> pgVertices pg -- [Vertex 0,Vertex 1,Vertex 2] -- -- @since 0.12.0.0 pgVertices :: PlanarGraph -> [Vertex] pgVertices pg = [ Vertex v | v <- [0 .. Vector.length (pgVertexEdges pg)-1 ] , halfEdgeIsValid (HalfEdge $ pgVertexEdges pg Vector.! v) ] -- -- | \( O(1) \) -- vertexFromId :: VertexId -> Vertex -- vertexFromId vId = Vertex vId -- -- | \( O(1) \) -- vertexId :: Vertex -> VertexId -- vertexId (Vertex vId) = vId -- Disabled since hashes are not stable across different versions of hashable. -- // $hidden -- -- >>> hash $ pgFromFaces [[0,1,2]] -- 2959979592048325618 -- | \( O(1) \) -- -- Each vertex has an assigned half-edge with the following properties: -- -- @'halfEdgeVertex' ('vertexHalfEdge' vertex pg) pg = vertex@ -- -- @'faceIsInterior' ('halfEdgeFace' ('vertexHalfEdge' vertex pg) pg) = True@ -- -- ==== __Examples:__ -- >>> let pg = pgFromFaces [[0,1,2]] -- -- <> -- -- >>> vertexHalfEdge (Vertex 0) pg -- HalfEdge 4 -- -- >>> vertexHalfEdge (Vertex 1) pg -- HalfEdge 0 -- -- >>> vertexHalfEdge (Vertex 6) pg -- ... Exception: Data.PlanarGraph.Immutable.vertexHalfEdge: Out-of-bounds vertex access: 6 -- ... -- -- >>> vertexHalfEdge (Vertex (-10)) pg -- ... Exception: Data.PlanarGraph.Immutable.vertexHalfEdge: Out-of-bounds vertex access: -10 -- ... -- -- >>> halfEdgeVertex (vertexHalfEdge (Vertex 2) pg) pg -- Vertex 2 -- -- >>> halfEdgeFace (vertexHalfEdge (Vertex 0) pg) pg -- Face 0 -- -- @since 0.12.0.0 vertexHalfEdge :: Vertex -> PlanarGraph -> HalfEdge vertexHalfEdge vertex pg | vertexCheck "vertexHalfEdge" vertex pg False = undefined vertexHalfEdge (Vertex vId) pg = HalfEdge $ pgVertexEdges pg Vector.! vId -- Disabled since hashes are not stable across different versions of hashable. -- // $hidden -- -- >>> hash $ pgFromFaces [[0,1,2,3],[4,3,2,1]] -- 1711135548958680232 -- | \( O(1) \) -- -- Returns @True@ iff the vertex lies on a boundary. -- -- ==== __Examples:__ -- >>> let pg = pgFromFaces [[0,1,2,3],[4,3,2,1]] -- -- <> -- -- >>> vertexIsBoundary (Vertex 0) pg -- True -- -- >>> vertexIsBoundary (Vertex 2) pg -- False -- -- >>> vertexIsBoundary (Vertex 4) pg -- True -- -- >>> vertexIsBoundary (Vertex 12) pg -- ... Exception: Data.PlanarGraph.Immutable.vertexIsBoundary: Out-of-bounds vertex access: 12 -- ... -- -- @since 0.12.0.0 vertexIsBoundary :: Vertex -> PlanarGraph -> Bool vertexIsBoundary vertex pg | vertexCheck "vertexIsBoundary" vertex pg False = undefined vertexIsBoundary vertex pg = faceIsBoundary $ halfEdgeFace (halfEdgeTwin $ vertexHalfEdge vertex pg) pg -- | \( O(1) \) -- -- Returns @True@ iff the vertex is interior, ie. does not lie on a boundary. -- -- ==== __Examples:__ -- >>> let pg = pgFromFaces [[0,1,2,3],[4,3,2,1]] -- -- <> -- -- >>> vertexIsInterior (Vertex 0) pg -- False -- -- >>> vertexIsInterior (Vertex 2) pg -- True -- -- >>> vertexIsInterior (Vertex 4) pg -- False -- -- >>> vertexIsInterior (Vertex 12) pg -- ... Exception: Data.PlanarGraph.Immutable.vertexIsInterior: Out-of-bounds vertex access: 12 -- ... -- -- @since 0.12.0.0 vertexIsInterior :: Vertex -> PlanarGraph -> Bool vertexIsInterior vertex pg | vertexCheck "vertexIsInterior" vertex pg False = undefined vertexIsInterior vertex pg = not $ vertexIsBoundary vertex pg -- | \( O(k) \) -- -- Query outgoing half-edges from a given vertex in counter-clockwise order. -- -- ==== __Examples:__ -- >>> let pg = pgFromFaces [[0,1,2,3],[4,3,2,1]] -- -- <> -- -- >>> vertexOutgoingHalfEdges (Vertex 1) pg -- [HalfEdge 0,HalfEdge 11,HalfEdge 3] -- -- Each half-edge will point out from the origin vertex: -- -- >>> map (`halfEdgeVertex` pg) $ vertexOutgoingHalfEdges (Vertex 1) pg -- [Vertex 1,Vertex 1,Vertex 1] -- -- >>> map (`halfEdgeTipVertex` pg) $ vertexOutgoingHalfEdges (Vertex 1) pg -- [Vertex 0,Vertex 4,Vertex 2] -- -- >>> vertexOutgoingHalfEdges (Vertex 2) pg -- [HalfEdge 2,HalfEdge 5] -- -- >>> vertexOutgoingHalfEdges (Vertex 12) pg -- ... Exception: Data.PlanarGraph.Immutable.vertexOutgoingHalfEdges: Out-of-bounds vertex access: 12 -- ... -- -- @since 0.12.0.0 vertexOutgoingHalfEdges :: Vertex -> PlanarGraph -> [HalfEdge] vertexOutgoingHalfEdges vertex pg | vertexCheck "vertexOutgoingHalfEdges" vertex pg False = undefined vertexOutgoingHalfEdges vertex pg = first : build (g (advance first)) where advance he = halfEdgeNext (halfEdgeTwin he) pg first = vertexHalfEdge vertex pg g :: HalfEdge -> (HalfEdge -> b -> b) -> b -> b g he cons nil | he == first = nil | otherwise = cons he (g (advance he) cons nil) -- Disabled since hashes are not stable across different versions of hashable. -- // $hidden -- -- >>> hash $ pgFromFaces [[0,1,2,3],[4,3,2,1]] -- 1711135548958680232 -- | \( O(k) \) -- -- Query incoming half-edges from a given vertex in counter-clockwise order. -- -- ==== __Examples:__ -- >>> let pg = pgFromFaces [[0,1,2,3],[4,3,2,1]] -- -- <> -- -- >>> vertexIncomingHalfEdges (Vertex 1) pg -- [HalfEdge 1,HalfEdge 10,HalfEdge 2] -- -- >>> map (`halfEdgeVertex` pg) $ vertexIncomingHalfEdges (Vertex 1) pg -- [Vertex 0,Vertex 4,Vertex 2] -- -- >>> map (`halfEdgeTipVertex` pg) $ vertexIncomingHalfEdges (Vertex 1) pg -- [Vertex 1,Vertex 1,Vertex 1] -- -- >>> vertexIncomingHalfEdges (Vertex 2) pg -- [HalfEdge 3,HalfEdge 4] -- -- >>> vertexIncomingHalfEdges (Vertex 12) pg -- ... Exception: Data.PlanarGraph.Immutable.vertexIncomingHalfEdges: Out-of-bounds vertex access: 12 -- ... -- -- @since 0.12.0.0 vertexIncomingHalfEdges :: Vertex -> PlanarGraph -> [HalfEdge] vertexIncomingHalfEdges vertex pg | vertexCheck "vertexIncomingHalfEdges" vertex pg False = undefined vertexIncomingHalfEdges vertex pg = map halfEdgeTwin $ vertexOutgoingHalfEdges vertex pg -- | \( O(k) \) -- -- Query vertex neighbours in counter-clockwise order. -- -- ==== __Examples:__ -- >>> let pg = pgFromFaces [[0,1,2,3],[4,3,2,1]] -- -- <> -- -- >>> vertexNeighbours (Vertex 0) pg -- [Vertex 3,Vertex 1] -- -- >>> vertexNeighbours (Vertex 1) pg -- [Vertex 0,Vertex 4,Vertex 2] -- -- >>> vertexNeighbours (Vertex 2) pg -- [Vertex 1,Vertex 3] -- -- >>> vertexNeighbours (Vertex 12) pg -- ... Exception: Data.PlanarGraph.Immutable.vertexNeighbours: Out-of-bounds vertex access: 12 -- ... -- -- @since 0.12.0.0 vertexNeighbours :: Vertex -> PlanarGraph -> [Vertex] vertexNeighbours vertex pg | vertexCheck "vertexNeighbours" vertex pg False = undefined vertexNeighbours vertex pg = map (`halfEdgeVertex` pg) $ vertexIncomingHalfEdges vertex pg -- vertexAdjacentVertices :: Vertex -> PlanarGraph -> [Vertex] -- vertexAdjacentFaces :: Vertex -> PlanarGraph -> [Face] ------------------------------------------------------------------------------- -- Edges -- | \( O(k) \) -- -- List all edges in a graph. -- -- ==== __Examples:__ -- -- >>> let pg = pgFromFaces [[0,1,2]] -- -- <> -- -- >>> pgEdges pg -- [Edge 0,Edge 1,Edge 2] -- -- >>> map edgeHalfEdges $ pgEdges pg -- [(HalfEdge 0,HalfEdge 1),(HalfEdge 2,HalfEdge 3),(HalfEdge 4,HalfEdge 5)] -- -- @since 0.12.0.0 pgEdges :: PlanarGraph -> [Edge] pgEdges pg = [ Edge e | e <- [0 .. Vector.length (pgHalfEdgeNext pg) `div` 2 -1] , let he = e*2 , halfEdgeIsValid (HalfEdge he) ] -- | \( O(1) \) -- -- Split a bidirectional edge into directed half-edges. -- -- @since 0.12.0.0 edgeHalfEdges :: Edge -> (HalfEdge, HalfEdge) edgeHalfEdges (Edge e) = (HalfEdge $ e*2, HalfEdge $ e*2+1) ------------------------------------------------------------------------------- -- Half-edges -- | O(1) halfEdgeCheck :: String -> HalfEdgeId -> PlanarGraph -> a -> a halfEdgeCheck tag eId pg _val | eId >= Vector.length (pgHalfEdgeVertex pg) || eId < 0 = panic tag ("Out-of-bounds half-edge access: " ++ show eId) | pgHalfEdgeVertex pg Vector.! eId < 0 = panic tag ("Tried to access deleted half-edge: " ++ show eId) halfEdgeCheck _tag _face _pg val = val -- | \( O(k) \) -- -- List all half-edges in a graph. -- -- ==== __Examples:__ -- -- >>> let pg = pgFromFaces [[0,1,2]] -- -- <> -- -- >>> pgHalfEdges pg -- [HalfEdge 0,HalfEdge 1,HalfEdge 2,HalfEdge 3,HalfEdge 4,HalfEdge 5] -- -- @since 0.12.0.0 pgHalfEdges :: PlanarGraph -> [HalfEdge] pgHalfEdges pg = [ he | he <- map HalfEdge [0 .. Vector.length (pgHalfEdgeNext pg)-1 ] , halfEdgeIsValid he ] -- | O(1) -- -- @since 0.12.0.0 halfEdgeIsValid :: HalfEdge -> Bool halfEdgeIsValid (HalfEdge eId) = eId >= 0 -- -- | O(1) -- halfEdgeFromId :: HalfEdgeId -> HalfEdge -- halfEdgeFromId eId = HalfEdge eId -- -- | O(1) -- halfEdgeId :: HalfEdge -> HalfEdgeId -- halfEdgeId (HalfEdge eId) = eId -- Disabled since hashes are not stable across different versions of hashable. -- // $hidden -- -- >>> hash $ pgFromFaces [[0,1,2,3],[4,3,2,1]] -- 1711135548958680232 -- | \( O(1) \) -- -- Query the half-edge in the pointed direction. Internal half-edges -- are arranged clockwise and external half-edges go counter-clockwise. -- -- ==== __Examples:__ -- >>> let pg = pgFromFaces [[0,1,2,3],[4,3,2,1]] -- -- <> -- -- >>> halfEdgeNext (HalfEdge 4) pg {- clockwise -} -- HalfEdge 2 -- -- >>> halfEdgeNext (HalfEdge 3) pg {- clockwise -} -- HalfEdge 5 -- -- >>> halfEdgeNext (HalfEdge 1) pg {- counter-clockwise -} -- HalfEdge 11 -- -- >>> halfEdgeNext (HalfEdge 12) pg -- ... Exception: Data.PlanarGraph.Immutable.halfEdgeNext: Out-of-bounds half-edge access: 12 -- ... -- -- @since 0.12.0.0 halfEdgeNext :: HalfEdge -> PlanarGraph -> HalfEdge halfEdgeNext (HalfEdge eId) pg = halfEdgeCheck "halfEdgeNext" eId pg $ HalfEdge $ pgHalfEdgeNext pg Vector.! eId -- | \( O(1) \) -- -- Query the half-edge opposite the pointed direction. This means counter-clockwise -- for internal half-edges and clockwise for external half-edges. -- -- ==== __Examples:__ -- >>> let pg = pgFromFaces [[0,1,2,3],[4,3,2,1]] -- -- <> -- -- >>> halfEdgePrev (HalfEdge 4) pg {- counter-clockwise -} -- HalfEdge 6 -- -- >>> halfEdgePrev (HalfEdge 3) pg {- counter-clockwise -} -- HalfEdge 10 -- -- >>> halfEdgePrev (HalfEdge 1) pg {- clockwise -} -- HalfEdge 7 -- -- >>> halfEdgePrev (HalfEdge 12) pg -- ... Exception: Data.PlanarGraph.Immutable.halfEdgePrev: Out-of-bounds half-edge access: 12 -- ... -- -- @since 0.12.0.0 halfEdgePrev :: HalfEdge -> PlanarGraph -> HalfEdge halfEdgePrev (HalfEdge eId) pg = halfEdgeCheck "halfEdgePrev" eId pg $ HalfEdge $ pgHalfEdgePrev pg Vector.! eId -- | \( O(1) \) -- -- Next half-edge with the same vertex in counter-clockwise order. -- -- ==== __Examples:__ -- >>> let pg = pgFromFaces [[0,1,2,3],[4,3,2,1]] -- -- <> -- -- @HalfEdge 0@ is poiting out from @Vertex 1@. Moving counter-clockwise -- around @Vertex 1@ yields @HalfEdge 11@ and @HalfEdge 3@. -- -- >>> halfEdgeNextOutgoing (HalfEdge 0) pg -- HalfEdge 11 -- -- >>> halfEdgeNextOutgoing (HalfEdge 11) pg -- HalfEdge 3 -- -- >>> halfEdgeNextOutgoing (HalfEdge 3) pg -- HalfEdge 0 -- -- >>> halfEdgeNextOutgoing (HalfEdge 12) pg -- ... Exception: Data.PlanarGraph.Immutable.halfEdgeNextOutgoing: Out-of-bounds half-edge access: 12 -- ... -- -- @since 0.12.0.0 halfEdgeNextOutgoing :: HalfEdge -> PlanarGraph -> HalfEdge halfEdgeNextOutgoing e pg = halfEdgeCheck "halfEdgeNextOutgoing" (halfEdgeId e) pg $ halfEdgeNext (halfEdgeTwin e) pg -- | \( O(1) \) -- -- Next half-edge with the same vertex in counter-clockwise order. -- -- ==== __Examples:__ -- >>> let pg = pgFromFaces [[0,1,2,3],[4,3,2,1]] -- -- <> -- -- @HalfEdge 6@ is poiting towards @Vertex 3@. Moving clockwise -- around @Vertex 3@ yields @HalfEdge 11@ and @HalfEdge 3@. -- -- >>> halfEdgeNextIncoming (HalfEdge 6) pg -- HalfEdge 5 -- -- >>> halfEdgeNextIncoming (HalfEdge 5) pg -- HalfEdge 9 -- -- >>> halfEdgeNextIncoming (HalfEdge 9) pg -- HalfEdge 6 -- -- >>> halfEdgeNextIncoming (HalfEdge 12) pg -- ... Exception: Data.PlanarGraph.Immutable.halfEdgeNextIncoming: Out-of-bounds half-edge access: 12 -- ... -- -- @since 0.12.0.0 halfEdgeNextIncoming :: HalfEdge -> PlanarGraph -> HalfEdge halfEdgeNextIncoming e pg = halfEdgeCheck "halfEdgeNextIncoming" (halfEdgeId e) pg $ halfEdgeTwin (halfEdgeNext e pg) -- | \( O(1) \) -- -- @ -- 'halfEdgeTwin' . 'halfEdgeTwin' == id -- @ -- -- @since 0.12.0.0 halfEdgeTwin :: HalfEdge -> HalfEdge halfEdgeTwin (HalfEdge idx) = HalfEdge (idx `xor` 1) -- | \( O(1) \) -- -- Tail-end of a half-edge. Synonym of 'halfEdgeTailVertex'. -- -- ==== __Examples:__ -- -- >>> let pg = pgFromFaces [[0,1,2]] -- -- <> -- -- >>> halfEdgeVertex (HalfEdge 1) pg -- Vertex 0 -- -- >>> halfEdgeVertex (HalfEdge 2) pg -- Vertex 2 -- -- >>> halfEdgeVertex (HalfEdge 6) pg -- ... Exception: Data.PlanarGraph.Immutable.halfEdgeVertex: Out-of-bounds half-edge access: 6 -- ... -- -- @since 0.12.0.0 halfEdgeVertex :: HalfEdge -> PlanarGraph -> Vertex halfEdgeVertex (HalfEdge idx) pg = halfEdgeCheck "halfEdgeVertex" idx pg $ Vertex $ pgHalfEdgeVertex pg Vector.! idx -- | O(1) -- -- Tail-end of a half-edge. Synonym of 'halfEdgeVertex'. -- -- ==== __Examples:__ -- -- >>> let pg = pgFromFaces [[0,1,2]] -- -- <> -- -- >>> halfEdgeTailVertex (HalfEdge 1) pg -- Vertex 0 -- -- >>> halfEdgeTailVertex (HalfEdge 2) pg -- Vertex 2 -- -- @since 0.12.0.0 halfEdgeTailVertex :: HalfEdge -> PlanarGraph -> Vertex halfEdgeTailVertex e pg = halfEdgeVertex e pg -- | O(1) -- -- Tip-end of a half-edge. This is the tail-end vertex of the twin half-edge. -- -- ==== __Examples:__ -- -- >>> let pg = pgFromFaces [[0,1,2]] -- -- <> -- -- >>> halfEdgeTipVertex (HalfEdge 1) pg -- Vertex 1 -- -- >>> halfEdgeTipVertex (HalfEdge 5) pg -- Vertex 0 -- -- @since 0.12.0.0 halfEdgeTipVertex :: HalfEdge -> PlanarGraph -> Vertex halfEdgeTipVertex e pg = halfEdgeVertex (halfEdgeTwin e) pg -- Disabled since hashes are not stable across different versions of hashable. -- // $hidden -- -- >>> hash $ pgFromFaces [[0,1,2]] -- 2959979592048325618 -- | \( O(1) \) -- -- Query the face of a half-edge. -- -- ==== __Examples:__ -- >>> let pg = pgFromFaces [[0,1,2]] -- -- <> -- -- >>> halfEdgeFace (HalfEdge 0) pg -- Face 0 -- -- >>> halfEdgeFace (HalfEdge 1) pg -- Boundary 0 -- -- >>> halfEdgeFace (HalfEdge 6) pg -- ... Exception: Data.PlanarGraph.Immutable.halfEdgeFace: Out-of-bounds half-edge access: 6 -- ... -- -- @since 0.12.0.0 halfEdgeFace :: HalfEdge -> PlanarGraph -> Face halfEdgeFace (HalfEdge eId) pg = halfEdgeCheck "halfEdgeFace" eId pg $ faceFromId $ pgHalfEdgeFace pg Vector.! eId -- | \( O(1) \) -- -- Check if a half-edge's face is on a boundary. -- -- ==== __Examples:__ -- -- >>> let pg = pgFromFaces [[0,1,2]] -- -- <> -- -- >>> halfEdgeIsBoundary (HalfEdge 0) pg -- False -- -- >>> halfEdgeIsBoundary (HalfEdge 1) pg -- True -- -- >>> halfEdgeIsBoundary (HalfEdge 2) pg -- False -- -- >>> halfEdgeIsBoundary (HalfEdge 3) pg -- True -- -- >>> halfEdgeIsBoundary (HalfEdge 6) pg -- ... Exception: Data.PlanarGraph.Immutable.halfEdgeIsBoundary: Out-of-bounds half-edge access: 6 -- ... -- -- @since 0.12.0.0 halfEdgeIsBoundary :: HalfEdge -> PlanarGraph -> Bool halfEdgeIsBoundary edge pg = halfEdgeCheck "halfEdgeIsBoundary" (halfEdgeId edge) pg $ faceIsBoundary $ halfEdgeFace edge pg -- | \( O(1) \) -- -- Check if a half-edge's face is interior. -- -- ==== __Examples:__ -- -- >>> let pg = pgFromFaces [[0,1,2]] -- -- <> -- -- >>> halfEdgeIsInterior (HalfEdge 0) pg -- True -- -- >>> halfEdgeIsInterior (HalfEdge 1) pg -- False -- -- >>> halfEdgeIsInterior (HalfEdge 2) pg -- True -- -- >>> halfEdgeIsInterior (HalfEdge 3) pg -- False -- -- >>> halfEdgeIsInterior (HalfEdge 6) pg -- ... Exception: Data.PlanarGraph.Immutable.halfEdgeIsInterior: Out-of-bounds half-edge access: 6 -- ... -- -- @since 0.12.0.0 halfEdgeIsInterior :: HalfEdge -> PlanarGraph -> Bool halfEdgeIsInterior edge pg = halfEdgeCheck "halfEdgeIsInterior" (halfEdgeId edge) pg $ faceIsInterior $ halfEdgeFace edge pg ------------------------------------------------------------------------------- -- Faces -- | \( O(k) \) -- -- List all faces in a graph. -- -- ==== __Examples:__ -- -- >>> let pg = pgFromFaces [[0,4,1],[0,1,2],[4,3,1],[4,5,3],[3,5,2],[2,5,0]] -- -- <> -- -- >>> pgFaces pg -- [Face 0,Face 1,Face 2,Face 3,Face 4,Face 5] -- -- @since 0.12.0.0 pgFaces :: PlanarGraph -> [Face] pgFaces pg = [ Face fId | fId <- [0 .. Vector.length (pgFaceEdges pg)-1 ] , halfEdgeIsValid (faceHalfEdge (Face fId) pg) ] -- | \( O(k) \) -- -- List all boundaries (ie external faces) in a graph. There may be -- multiple boundaries and they may or may not be reachable from each other. -- -- ==== __Examples:__ -- -- >>> let pg = pgFromFaces [[0,4,1],[0,1,2],[4,3,1],[4,5,3],[3,5,2],[2,5,0]] -- -- <> -- -- >>> pgBoundaries pg -- [Boundary 0,Boundary 1] -- -- >>> faceBoundary (Boundary 0) pg -- [Vertex 0,Vertex 4,Vertex 5] -- -- >>> faceBoundary (Boundary 1) pg -- [Vertex 1,Vertex 2,Vertex 3] -- -- @since 0.12.0.0 pgBoundaries :: PlanarGraph -> [Face] pgBoundaries pg = [ Boundary fId | fId <- [0 .. Vector.length (pgBoundaryEdges pg)-1 ] , halfEdgeIsValid (faceHalfEdge (Boundary fId) pg) ] -- | O(1) faceCheck :: String -> Face -> PlanarGraph -> a -> a faceCheck tag (Face fId) pg _val | fId >= Vector.length (pgFaceEdges pg) || fId < 0 = panic tag ("Out-of-bounds face access: " ++ show fId) | pgFaceEdges pg Vector.! fId < 0 = panic tag ("Tried to access deleted face: " ++ show fId) faceCheck tag (Boundary fId) pg _val | fId >= Vector.length (pgBoundaryEdges pg) || fId < 0 = panic tag ("Out-of-bounds boundary access: " ++ show fId) | pgBoundaryEdges pg Vector.! fId < 0 = panic tag ("Tried to access deleted boundary: " ++ show fId) faceCheck _tag _face _pg val = val -- | \( O(1) \) -- -- Returns @True@ iff a face or boundary is part of the planar graph. -- -- ==== __Examples:__ -- -- >>> let pg = pgFromFaces [[0,1,2]] -- -- <> -- -- >>> faceMember (Face 0) pg -- True -- -- >>> faceMember (Face 1) pg -- False -- -- >>> faceMember (Face 100) pg -- False -- -- >>> faceMember (Face (-100)) pg -- False -- -- >>> faceMember (Boundary 0) pg -- True -- -- >>> faceMember (Boundary 1) pg -- False -- -- @since 0.12.0.0 faceMember :: Face -> PlanarGraph -> Bool faceMember face@(Face fId) pg = fId < Vector.length (pgFaceEdges pg) && fId >= 0 && halfEdgeIsValid (faceHalfEdge face pg) faceMember face@(Boundary fId) pg = fId < Vector.length (pgFaceEdges pg) && fId >= 0 && halfEdgeIsValid (faceHalfEdge face pg) -- -- | O(1) -- faceInvalid :: Face -- faceInvalid = faceFromId maxBound -- -- | O(1) -- faceIsValid :: Face -> Bool -- faceIsValid = not . faceIsInvalid -- -- | O(1) -- faceIsInvalid :: Face -> Bool -- faceIsInvalid (Face fId) = fId == maxBound -- faceIsInvalid (Boundary fId) = fId == maxBound -- | O(1) -- -- @since 0.12.0.0 faceFromId :: FaceId -> Face faceFromId fId | fId < 0 = Boundary (negate fId - 1) faceFromId fId = Face fId -- | \( O(1) \) -- -- Maps interior faces to positive integers and boundary faces to negative integers. -- -- ==== __Examples:__ -- -- >>> faceId (Face 0) -- 0 -- -- >>> faceId (Face 10) -- 10 -- -- >>> faceId (Boundary 0) -- -1 -- -- >>> faceId (Boundary 10) -- -11 -- -- @since 0.12.0.0 faceId :: Face -> FaceId faceId (Face fId) = fId faceId (Boundary fId) = negate fId - 1 -- | \( O(1) \) -- -- Query the half-edge associated with a face or boundary. -- -- ==== __Examples:__ -- -- >>> let pg = pgFromFaces [[0,1,2,3],[4,3,2,1]] -- -- <> -- -- >>> faceHalfEdge (Face 0) pg -- HalfEdge 0 -- -- >>> faceHalfEdge (Face 1) pg -- HalfEdge 8 -- -- >>> faceHalfEdge (Boundary 0) pg -- HalfEdge 1 -- -- >>> faceHalfEdge (Face 10) pg {- Invalid face -} -- ... Exception: Data.PlanarGraph.Immutable.faceHalfEdge: Out-of-bounds face access: 10 -- ... -- -- @since 0.12.0.0 faceHalfEdge :: Face -> PlanarGraph -> HalfEdge faceHalfEdge face pg = faceCheck "faceHalfEdge" face pg $ case face of Face fId -> HalfEdge $ pgFaceEdges pg Vector.! fId Boundary fId -> HalfEdge $ pgBoundaryEdges pg Vector.! fId -- | \( O(1) \) -- -- Returns @True@ iff a face is interior. Does not check if the face actually exists. -- -- ==== __Examples:__ -- -- >>> faceIsInterior (Face 0) -- True -- -- >>> faceIsInterior (Face 10000) -- True -- -- >>> faceIsInterior (Boundary 0) -- False -- -- @since 0.12.0.0 faceIsInterior :: Face -> Bool faceIsInterior = not . faceIsBoundary -- | \( O(1) \) -- -- Returns @True@ iff a face is a boundary. Does not check if the face actually exists. -- -- ==== __Examples:__ -- -- >>> faceIsBoundary (Face 0) -- False -- -- >>> faceIsBoundary (Face 10000) -- False -- -- >>> faceIsBoundary (Boundary 0) -- True -- -- @since 0.12.0.0 faceIsBoundary :: Face -> Bool faceIsBoundary Face{} = False faceIsBoundary Boundary{} = True -- faceVertices :: Face -> ST s (CircularVector Vertex) -- | \( O(k) \) -- -- Query the half-edges around a face in counter-clockwise order. -- -- ==== __Examples:__ -- >>> let pg = pgFromFaces [[0,1,2,3],[4,3,2,1]] -- -- <> -- -- >>> faceHalfEdges (Face 0) pg -- [HalfEdge 0,HalfEdge 2,HalfEdge 4,HalfEdge 6] -- -- >>> faceHalfEdges (Face 1) pg -- [HalfEdge 8,HalfEdge 5,HalfEdge 3,HalfEdge 10] -- -- >>> faceHalfEdges (Boundary 0) pg -- [HalfEdge 1,HalfEdge 11,HalfEdge 9,HalfEdge 7] -- -- >>> faceHalfEdges (Face 10) pg -- ... Exception: Data.PlanarGraph.Immutable.faceHalfEdges: Out-of-bounds face access: 10 -- ... -- -- @since 0.12.0.0 faceHalfEdges :: Face -> PlanarGraph -> [HalfEdge] faceHalfEdges face pg | faceCheck "faceHalfEdges" face pg False = undefined faceHalfEdges face pg | faceIsBoundary face = first : build (worker halfEdgeNext (halfEdgeNext first pg)) | otherwise = first : build (worker halfEdgePrev (halfEdgePrev first pg)) where first = faceHalfEdge face pg worker :: (HalfEdge -> PlanarGraph -> HalfEdge) -> HalfEdge -> (HalfEdge -> b -> b) -> b -> b worker advance he cons nil | he == first = nil | otherwise = cons he (worker advance (advance he pg) cons nil) -- | \( O(k) \) -- -- Query the vertices of a face in counter-clockwise order. -- -- ==== __Examples:__ -- >>> let pg = pgFromFaces [[0,1,2,3],[4,3,2,1]] -- -- <> -- -- >>> faceBoundary (Face 0) pg -- [Vertex 1,Vertex 2,Vertex 3,Vertex 0] -- -- >>> faceBoundary (Face 1) pg -- [Vertex 3,Vertex 2,Vertex 1,Vertex 4] -- -- >>> faceBoundary (Boundary 0) pg -- [Vertex 0,Vertex 1,Vertex 4,Vertex 3] -- -- >>> faceBoundary (Face 10) pg -- ... Exception: Data.PlanarGraph.Immutable.faceBoundary: Out-of-bounds face access: 10 -- ... -- -- @since 0.12.0.0 faceBoundary :: Face -> PlanarGraph -> [Vertex] faceBoundary face pg = faceCheck "faceBoundary" face pg $ map (`halfEdgeVertex` pg) $ faceHalfEdges face pg -- faceAdjacentFaces :: Face -> ST s (CircularVector Face) ------------------------------------------------------------------------------- -- Mutation -- | \( O(n) \) -- -- @since 0.12.0.0 pgMutate :: PlanarGraph -> (forall s. Mut.PlanarGraph s -> ST s ()) -> PlanarGraph pgMutate pg action = runST $ do mutPG <- pgThaw pg action mutPG pgUnsafeFreeze mutPG -- | \( O(1) \) -- -- @since 0.12.0.0 pgCreate :: (forall s. ST s (Mut.PlanarGraph s)) -> PlanarGraph pgCreate action = runST (action >>= pgUnsafeFreeze) -- | \( O(n) \) -- -- @since 0.12.0.0 pgThaw :: PlanarGraph -> ST s (Mut.PlanarGraph s) pgThaw pg = do pgNextHalfEdgeId <- newSTRef $ Vector.length (pgHalfEdgeNext pg) `div` 2 pgNextVertexId <- newSTRef $ Vector.length $ pgVertexEdges pg pgNextFaceId <- newSTRef $ Vector.length $ pgFaceEdges pg pgNextBoundaryId <- newSTRef $ Vector.length $ pgBoundaryEdges pg pgHalfEdgeNext <- Mut.thawVector $ pgHalfEdgeNext pg pgHalfEdgePrev <- Mut.thawVector $ pgHalfEdgePrev pg pgHalfEdgeFace <- Mut.thawVector $ pgHalfEdgeFace pg pgHalfEdgeVertex <- Mut.thawVector $ pgHalfEdgeVertex pg pgVertexEdges <- Mut.thawVector $ pgVertexEdges pg pgFaceEdges <- Mut.thawVector $ pgFaceEdges pg pgBoundaryEdges <- Mut.thawVector $ pgBoundaryEdges pg pure Mut.PlanarGraph {..} -- | \( O(1) \) -- -- @since 0.12.0.0 pgUnsafeThaw :: PlanarGraph -> ST s (Mut.PlanarGraph s) pgUnsafeThaw pg = do pgNextHalfEdgeId <- newSTRef $ Vector.length $ pgHalfEdgeNext pg pgNextVertexId <- newSTRef $ Vector.length $ pgVertexEdges pg pgNextFaceId <- newSTRef $ Vector.length $ pgFaceEdges pg pgNextBoundaryId <- newSTRef $ Vector.length $ pgBoundaryEdges pg pgHalfEdgeNext <- Mut.unsafeThawVector $ pgHalfEdgeNext pg pgHalfEdgePrev <- Mut.unsafeThawVector $ pgHalfEdgePrev pg pgHalfEdgeFace <- Mut.unsafeThawVector $ pgHalfEdgeFace pg pgHalfEdgeVertex <- Mut.unsafeThawVector $ pgHalfEdgeVertex pg pgVertexEdges <- Mut.unsafeThawVector $ pgVertexEdges pg pgFaceEdges <- Mut.unsafeThawVector $ pgFaceEdges pg pgBoundaryEdges <- Mut.unsafeThawVector $ pgBoundaryEdges pg pure Mut.PlanarGraph {..} -- | \( O(n) \) -- -- @since 0.12.0.0 pgFreeze :: Mut.PlanarGraph s -> ST s PlanarGraph pgFreeze pg = do maxEdgeId <- readSTRef (Mut.pgNextHalfEdgeId pg) maxVertexId <- readSTRef (Mut.pgNextVertexId pg) maxFaceId <- readSTRef (Mut.pgNextFaceId pg) maxBoundaryId <- readSTRef (Mut.pgNextBoundaryId pg) pgHalfEdgeNext <- Vector.take (maxEdgeId*2) <$> Mut.freezeVector (Mut.pgHalfEdgeNext pg) pgHalfEdgePrev <- Vector.take (maxEdgeId*2) <$> Mut.freezeVector (Mut.pgHalfEdgePrev pg) pgHalfEdgeFace <- Vector.take (maxEdgeId*2) <$> Mut.freezeVector (Mut.pgHalfEdgeFace pg) pgHalfEdgeVertex <- Vector.take (maxEdgeId*2) <$> Mut.freezeVector (Mut.pgHalfEdgeVertex pg) pgVertexEdges <- Vector.take maxVertexId <$> Mut.freezeVector (Mut.pgVertexEdges pg) pgFaceEdges <- Vector.take maxFaceId <$> Mut.freezeVector (Mut.pgFaceEdges pg) pgBoundaryEdges <- Vector.take maxBoundaryId <$> Mut.freezeVector (Mut.pgBoundaryEdges pg) pure PlanarGraph { .. } -- | \( O(1) \) -- -- @since 0.12.0.0 pgUnsafeFreeze :: Mut.PlanarGraph s -> ST s PlanarGraph pgUnsafeFreeze pg = do maxEdgeId <- readSTRef (Mut.pgNextHalfEdgeId pg) maxVertexId <- readSTRef (Mut.pgNextVertexId pg) maxFaceId <- readSTRef (Mut.pgNextFaceId pg) maxBoundaryId <- readSTRef (Mut.pgNextBoundaryId pg) pgHalfEdgeNext <- Vector.take (maxEdgeId*2) <$> Mut.unsafeFreezeVector (Mut.pgHalfEdgeNext pg) pgHalfEdgePrev <- Vector.take (maxEdgeId*2) <$> Mut.unsafeFreezeVector (Mut.pgHalfEdgePrev pg) pgHalfEdgeFace <- Vector.take (maxEdgeId*2) <$> Mut.unsafeFreezeVector (Mut.pgHalfEdgeFace pg) pgHalfEdgeVertex <- Vector.take (maxEdgeId*2) <$> Mut.unsafeFreezeVector (Mut.pgHalfEdgeVertex pg) pgVertexEdges <- Vector.take maxVertexId <$> Mut.unsafeFreezeVector (Mut.pgVertexEdges pg) pgFaceEdges <- Vector.take maxFaceId <$> Mut.unsafeFreezeVector (Mut.pgFaceEdges pg) pgBoundaryEdges <- Vector.take maxBoundaryId <$> Mut.unsafeFreezeVector (Mut.pgBoundaryEdges pg) pure PlanarGraph { .. } ------------------------------------------------------------------------------- -- Tutte embedding -- | \( O(n^3) \) -- -- @since 0.12.0.0 tutteEmbedding :: PlanarGraph -> Vector.Vector (V2 Double) tutteEmbedding pg = runST $ do let nVertices = Vector.length (pgVertexEdges pg) -- trace ("nVertices: " ++ show nVertices) $ return () m <- Vector.replicateM nVertices (V.replicate nVertices 0) vx <- V.replicate nVertices 0 vy <- V.replicate nVertices 0 let boundary = faceBoundary (Boundary 0) pg let nBoundary = length boundary -- trace ("Vectors: " ++ show boundary) $ forM_ (zip boundary (regularPolygon nBoundary)) $ \(vertex,(x,y)) -> do let valid = halfEdgeIsValid $ vertexHalfEdge vertex pg when valid $ do V.write (m Vector.! vertexId vertex) (vertexId vertex) (1::Double) V.write vx (vertexId vertex) x V.write vy (vertexId vertex) y forM_ [0..nVertices-1] $ \vId -> -- trace ("Vertex: " ++ show vId) $ do let valid = halfEdgeIsValid $ vertexHalfEdge (Vertex vId) pg unless valid $ do V.write (m Vector.! vId) vId (1::Double) when valid $ do let onOuterBoundary = Boundary 0 == halfEdgeFace (halfEdgeTwin $ vertexHalfEdge (Vertex vId) pg) pg unless onOuterBoundary $ do let vertex = Vertex vId let neighbours = vertexNeighbours vertex pg forM_ neighbours $ \neighbour -> V.write (m Vector.! vId) (vertexId neighbour) (1::Double) V.write (m Vector.! vId) vId (negate $ fromIntegral $ length neighbours) mi <- mapM Vector.freeze m vxi <- Vector.freeze vx vyi <- Vector.freeze vy let xPos = reifyMatrix mi vxi luSolve yPos = reifyMatrix mi vyi luSolve pure $ Vector.zipWith V2 xPos yPos reifyMatrix :: forall a. Vector.Vector (Vector.Vector a) -> Vector.Vector a -> (forall (n :: *). Dim n => V n (V n a) -> V n a -> V n a) -> Vector.Vector a reifyMatrix m v f = reifyDim (Vector.length m) $ \(Proxy :: Proxy n) -> toVector (f (coerce m :: (V n (V n a))) (coerce v)) regularPolygon :: Int -> [(Double, Double)] regularPolygon n = [ (cos ang, sin ang) | i <- [0 .. n-1] , let ang = fromIntegral i * frac + pi/2] where frac = 2*pi / fromIntegral n