module Data.PlanarGraph.Mutable
  ( -- * Planar graphs
    PlanarGraph
  , pgFromFaces   -- :: [[VertexId]] -> ST s (PlanarGraph s)
  , pgFromFacesCV -- :: [CircularVector VertexId] -> ST s (PlanarGraph s)
  , pgClone       -- :: PlanarGraph s -> ST s (PlanarGraph s)
  , pgHash        -- :: PlanarGraph s -> ST s Int

    -- * Elements
    -- ** Vertices
  , Vertex, VertexId
  , vertexFromId                -- :: VertexId -> PlanarGraph s -> Vertex s
  , vertexToId                  -- :: Vertex s -> VertexId
  , vertexHalfEdge              -- :: Vertex s -> ST s (HalfEdge s)
  , vertexIsBoundary            -- :: Vertex s -> ST s Bool
  , vertexOutgoingHalfEdges     -- :: Vertex s -> ST s (CircularVector (HalfEdge s))
  , vertexWithOutgoingHalfEdges -- :: Vertex s -> (HalfEdge s -> ST s ()) -> ST s ()
  , vertexIncomingHalfEdges     -- :: Vertex s -> ST s (CircularVector (HalfEdge s))
  , vertexWithIncomingHalfEdges -- :: Vertex s -> (HalfEdge s -> ST s ()) -> ST s ()
  , vertexNeighbours            -- :: Vertex s -> ST s (CircularVector (Vertex s))
  -- , vertexNew -- :: PlanarGraph s -> ST s (Vertex s)
  -- , vertexSetHalfEdge -- :: Vertex s -> HalfEdge s -> ST s ()

    -- ** Edges
  , Edge, EdgeId
  , edgeFromId           -- :: EdgeId -> PlanarGraph s -> Edge s
  , edgeToId             -- :: Edge s -> EdgeId
  , edgeFromHalfEdge     -- :: HalfEdge s -> Edge s

    -- ** Half-edges
  , HalfEdge, HalfEdgeId
  , halfEdgeFromId       -- :: HalfEdgeId -> PlanarGraph s -> HalfEdge s
  , halfEdgeToId         -- :: HalfEdge s -> HalfEdgeId
  , halfEdgeNext         -- :: HalfEdge s -> ST s (HalfEdge s)
  , halfEdgePrev         -- :: HalfEdge s -> ST s (HalfEdge s)
  , halfEdgeNextOutgoing -- :: HalfEdge s -> ST s (HalfEdge s)
  , halfEdgeNextIncoming -- :: HalfEdge s -> ST s (HalfEdge s)
  , halfEdgeVertex       -- :: HalfEdge s -> ST s (Vertex s)
  , halfEdgeTwin         -- :: HalfEdge s -> HalfEdge s
  , halfEdgeTailVertex   -- :: HalfEdge s -> ST s (Vertex s)
  , halfEdgeTipVertex    -- :: HalfEdge s -> ST s (Vertex s)
  , halfEdgeFace         -- :: HalfEdge s -> ST s (Face s)
  , halfEdgeIsInterior   -- :: HalfEdge s -> ST s Bool
  -- , halfEdgeNew          -- :: PlanarGraph s -> ST s (HalfEdge s)
  -- , halfEdgeSetNext      -- :: HalfEdge s -> HalfEdge s -> ST s ()
  -- , halfEdgeSetPrev      -- :: HalfEdge s -> HalfEdge s -> ST s ()
  -- , halfEdgeSetFace      -- :: HalfEdge s -> Face s -> ST s ()
  -- , halfEdgeSetVertex    -- :: HalfEdge s -> Vertex s -> ST s ()

    -- ** Faces
  , Face, FaceId
  , faceInvalid    -- :: PlanarGraph s -> Face s
  , faceIsValid    -- :: Face s -> Bool
  , faceIsInvalid  -- :: Face s -> Bool
  , faceFromId     -- :: FaceId -> PlanarGraph s -> Face s
  , faceToId       -- :: Face s -> FaceId
  , faceHalfEdge   -- :: Face s -> ST s (HalfEdge s)
  , faceIsInterior -- :: Face s -> Bool
  , faceIsBoundary -- :: Face s -> Bool
  , faceHalfEdges  -- :: Face s -> ST s (CircularVector (HalfEdge s))
  , faceBoundary   -- :: Face s -> ST s (CircularVector (Vertex s))
  -- , faceNew :: PlanarGraph s -> ST s (Face s)
  -- , faceNewBoundary :: PlanarGraph s -> ST s (Face s)
  -- , faceSetHalfEdge :: Face s -> HalfEdge s -> ST s ()

    -- * Mutation
  , pgConnectVertices -- :: HalfEdge s -> HalfEdge s -> ST s (Edge s)
-- pgSplitHalfEdge :: HalfEdge s -> ST s (Vertex s)

-- pgRemoveFace :: Face s -> ST s ()
-- pgRemoveHalfEdge :: HalfEdge s -> ST s ()
-- pgRemoveVertex :: Vertex s -> ST s ()
    -- * Misc
  -- , tutteEmbedding -- :: PlanarGraph s -> ST s (Vector.Vector (Double, Double))
  )
  where

import           Control.Monad             (forM_, unless, when)
import           Control.Monad.ST          (ST)
import           Data.Bits                 (Bits (xor))
import qualified Data.HashMap.Strict       as HM
import           Data.Hashable             (Hashable (hashWithSalt))
import           Data.PlanarGraph.Internal
import           Data.STRef                (modifySTRef', newSTRef, readSTRef, writeSTRef)
import           Data.Vector.Circular      (CircularVector)
import qualified Data.Vector.Circular      as CV

import Debug.Trace

-------------------------------------------------------------------------------
-- Elements: Half-edges, vertices, faces.

data HalfEdge s = HalfEdge HalfEdgeId (PlanarGraph s)
  deriving HalfEdge s -> HalfEdge s -> Bool
(HalfEdge s -> HalfEdge s -> Bool)
-> (HalfEdge s -> HalfEdge s -> Bool) -> Eq (HalfEdge s)
forall s. HalfEdge s -> HalfEdge s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HalfEdge s -> HalfEdge s -> Bool
$c/= :: forall s. HalfEdge s -> HalfEdge s -> Bool
== :: HalfEdge s -> HalfEdge s -> Bool
$c== :: forall s. HalfEdge s -> HalfEdge s -> Bool
Eq
instance Show (HalfEdge s) where
  showsPrec :: Int -> HalfEdge s -> ShowS
showsPrec Int
d (HalfEdge Int
s PlanarGraph s
_) = Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d Int
s
instance Hashable (HalfEdge s) where
  hashWithSalt :: Int -> HalfEdge s -> Int
hashWithSalt Int
salt (HalfEdge Int
eId PlanarGraph s
_) = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Int
eId


data Edge s = Edge EdgeId (PlanarGraph s)
  deriving Edge s -> Edge s -> Bool
(Edge s -> Edge s -> Bool)
-> (Edge s -> Edge s -> Bool) -> Eq (Edge s)
forall s. Edge s -> Edge s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Edge s -> Edge s -> Bool
$c/= :: forall s. Edge s -> Edge s -> Bool
== :: Edge s -> Edge s -> Bool
$c== :: forall s. Edge s -> Edge s -> Bool
Eq

data Vertex s = Vertex VertexId (PlanarGraph s)
  deriving Vertex s -> Vertex s -> Bool
(Vertex s -> Vertex s -> Bool)
-> (Vertex s -> Vertex s -> Bool) -> Eq (Vertex s)
forall s. Vertex s -> Vertex s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vertex s -> Vertex s -> Bool
$c/= :: forall s. Vertex s -> Vertex s -> Bool
== :: Vertex s -> Vertex s -> Bool
$c== :: forall s. Vertex s -> Vertex s -> Bool
Eq
instance Show (Vertex s) where
  showsPrec :: Int -> Vertex s -> ShowS
showsPrec Int
d (Vertex Int
v PlanarGraph s
_) = Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d Int
v
instance Hashable (Vertex s) where
  hashWithSalt :: Int -> Vertex s -> Int
hashWithSalt Int
salt (Vertex Int
vId PlanarGraph s
_) = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Int
vId

data Face s = Face FaceId (PlanarGraph s) | Boundary FaceId (PlanarGraph s)
  deriving Face s -> Face s -> Bool
(Face s -> Face s -> Bool)
-> (Face s -> Face s -> Bool) -> Eq (Face s)
forall s. Face s -> Face s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Face s -> Face s -> Bool
$c/= :: forall s. Face s -> Face s -> Bool
== :: Face s -> Face s -> Bool
$c== :: forall s. Face s -> Face s -> Bool
Eq
instance Show (Face s) where
  showsPrec :: Int -> Face s -> ShowS
showsPrec Int
d (Face Int
fId PlanarGraph s
_)     = String -> ShowS
showString String
"Face " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
fId
  showsPrec Int
d (Boundary Int
fId PlanarGraph s
_) = String -> ShowS
showString String
"Boundary " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
fId

-------------------------------------------------------------------------------
-- Planar graph

panic :: String -> String -> a
panic :: String -> String -> a
panic String
tag String
msg = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Data.PlanarGraph.Mutable." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tag String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg

eqCheck :: String -> PlanarGraph s -> PlanarGraph s -> a -> a
eqCheck :: String -> PlanarGraph s -> PlanarGraph s -> a -> a
eqCheck String
tag PlanarGraph s
pg1 PlanarGraph s
pg2 a
v
  | PlanarGraph s
pg1 PlanarGraph s -> PlanarGraph s -> Bool
forall a. Eq a => a -> a -> Bool
== PlanarGraph s
pg2 = a
v
  | Bool
otherwise = String -> String -> a
forall a. String -> String -> a
panic String
tag String
"Invalid cross reference."

empty :: Int -> Int -> Int -> ST s (PlanarGraph s)
empty :: Int -> Int -> Int -> ST s (PlanarGraph s)
empty Int
nFaces Int
nVertices Int
nEdges = STRef s Int
-> STRef s Int
-> STRef s Int
-> STRef s Int
-> GrowVector s Int
-> GrowVector s Int
-> GrowVector s Int
-> GrowVector s Int
-> GrowVector s Int
-> GrowVector s Int
-> GrowVector s Int
-> PlanarGraph s
forall s.
STRef s Int
-> STRef s Int
-> STRef s Int
-> STRef s Int
-> GrowVector s Int
-> GrowVector s Int
-> GrowVector s Int
-> GrowVector s Int
-> GrowVector s Int
-> GrowVector s Int
-> GrowVector s Int
-> PlanarGraph s
PlanarGraph
  (STRef s Int
 -> STRef s Int
 -> STRef s Int
 -> STRef s Int
 -> GrowVector s Int
 -> GrowVector s Int
 -> GrowVector s Int
 -> GrowVector s Int
 -> GrowVector s Int
 -> GrowVector s Int
 -> GrowVector s Int
 -> PlanarGraph s)
-> ST s (STRef s Int)
-> ST
     s
     (STRef s Int
      -> STRef s Int
      -> STRef s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> PlanarGraph s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
0
  ST
  s
  (STRef s Int
   -> STRef s Int
   -> STRef s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> PlanarGraph s)
-> ST s (STRef s Int)
-> ST
     s
     (STRef s Int
      -> STRef s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> PlanarGraph s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
0
  ST
  s
  (STRef s Int
   -> STRef s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> PlanarGraph s)
-> ST s (STRef s Int)
-> ST
     s
     (STRef s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> PlanarGraph s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
0
  ST
  s
  (STRef s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> PlanarGraph s)
-> ST s (STRef s Int)
-> ST
     s
     (GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> PlanarGraph s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
0
  ST
  s
  (GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> PlanarGraph s)
-> ST s (GrowVector s Int)
-> ST
     s
     (GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> PlanarGraph s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ST s (GrowVector s Int)
forall s v. Int -> ST s (GrowVector s v)
newVector (Int
nEdgesInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2)
  ST
  s
  (GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> PlanarGraph s)
-> ST s (GrowVector s Int)
-> ST
     s
     (GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> PlanarGraph s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ST s (GrowVector s Int)
forall s v. Int -> ST s (GrowVector s v)
newVector (Int
nEdgesInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2)
  ST
  s
  (GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> PlanarGraph s)
-> ST s (GrowVector s Int)
-> ST
     s
     (GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> GrowVector s Int
      -> PlanarGraph s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ST s (GrowVector s Int)
forall s v. Int -> ST s (GrowVector s v)
newVector (Int
nEdgesInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2)
  ST
  s
  (GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> GrowVector s Int
   -> PlanarGraph s)
-> ST s (GrowVector s Int)
-> ST
     s
     (GrowVector s Int
      -> GrowVector s Int -> GrowVector s Int -> PlanarGraph s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ST s (GrowVector s Int)
forall s v. Int -> ST s (GrowVector s v)
newVector (Int
nEdgesInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2)
  ST
  s
  (GrowVector s Int
   -> GrowVector s Int -> GrowVector s Int -> PlanarGraph s)
-> ST s (GrowVector s Int)
-> ST s (GrowVector s Int -> GrowVector s Int -> PlanarGraph s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ST s (GrowVector s Int)
forall s v. Int -> ST s (GrowVector s v)
newVector Int
nVertices
  ST s (GrowVector s Int -> GrowVector s Int -> PlanarGraph s)
-> ST s (GrowVector s Int)
-> ST s (GrowVector s Int -> PlanarGraph s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ST s (GrowVector s Int)
forall s v. Int -> ST s (GrowVector s v)
newVector Int
nFaces
  ST s (GrowVector s Int -> PlanarGraph s)
-> ST s (GrowVector s Int) -> ST s (PlanarGraph s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ST s (GrowVector s Int)
forall s v. Int -> ST s (GrowVector s v)
newVector Int
0

{-
  For all boundary vertices:
    vertex.half-edge.face == interior
    vertex.half-edge.twin.face == exterior
  Boundary face: 0

  create N
-}
-- | O(n)
--   Create a planar graph with N boundary vertices.
new :: Int -> ST s (PlanarGraph s)
new :: Int -> ST s (PlanarGraph s)
new Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> String -> ST s (PlanarGraph s)
forall a. String -> String -> a
panic String
"new" String
"Cannot contain negative vertices."
new Int
0 = Int -> Int -> Int -> ST s (PlanarGraph s)
forall s. Int -> Int -> Int -> ST s (PlanarGraph s)
empty Int
0 Int
0 Int
0
new Int
1 = ST s (PlanarGraph s)
forall a. HasCallStack => a
undefined
new Int
2 = ST s (PlanarGraph s)
forall a. HasCallStack => a
undefined
new Int
n = [[Int]] -> ST s (PlanarGraph s)
forall s. [[Int]] -> ST s (PlanarGraph s)
pgFromFaces [[Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]

-- $setup
--
-- >>> import Control.Monad.ST
-- >>> runST $ pgFromFaces [[0,1,2]] >>= pgHash
-- 2959979592048325618
-- >>> runST $ pgFromFaces [[0,1,2,3]] >>= pgHash
-- 2506803680640023584
-- >>> runST $ pgFromFaces [[0,1,2,3],[4,3,2,1]] >>= pgHash
-- 1711135548958680232

-- | \( O(n \log n) \)
--
--
--
-- ==== __Examples:__
-- @
-- 'pgFromFaces' [[0,1,2]]
-- @
-- <<docs/Data/PlanarGraph/planargraph-2959979592048325618.svg>>
--
-- @
-- 'pgFromFaces' [[0,1,2,3]]
-- @
-- <<docs/Data/PlanarGraph/planargraph-2506803680640023584.svg>>
pgFromFaces :: [[VertexId]] -> ST s (PlanarGraph s)
pgFromFaces :: [[Int]] -> ST s (PlanarGraph s)
pgFromFaces = [CircularVector Int] -> ST s (PlanarGraph s)
forall s. [CircularVector Int] -> ST s (PlanarGraph s)
pgFromFacesCV ([CircularVector Int] -> ST s (PlanarGraph s))
-> ([[Int]] -> [CircularVector Int])
-> [[Int]]
-> ST s (PlanarGraph s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> CircularVector Int) -> [[Int]] -> [CircularVector Int]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> CircularVector Int
forall a. [a] -> CircularVector a
CV.unsafeFromList

pgFromFacesCV :: [CircularVector VertexId] -> ST s (PlanarGraph s)
pgFromFacesCV :: [CircularVector Int] -> ST s (PlanarGraph s)
pgFromFacesCV [] = Int -> Int -> Int -> ST s (PlanarGraph s)
forall s. Int -> Int -> Int -> ST s (PlanarGraph s)
empty Int
0 Int
0 Int
0
pgFromFacesCV [CircularVector Int]
faces = do
  let maxVertexId :: Int
maxVertexId = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((CircularVector Int -> Int) -> [CircularVector Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map CircularVector Int -> Int
forall a. Ord a => CircularVector a -> a
CV.maximum [CircularVector Int]
faces)
      nFaces :: Int
nFaces = [CircularVector Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CircularVector Int]
faces
      nHalfEdges :: Int
nHalfEdges = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((CircularVector Int -> Int) -> [CircularVector Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map CircularVector Int -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CircularVector Int]
faces)
  PlanarGraph s
pg <- Int -> Int -> Int -> ST s (PlanarGraph s)
forall s. Int -> Int -> Int -> ST s (PlanarGraph s)
empty Int
nFaces (Int
maxVertexIdInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
nHalfEdges Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
  GrowVector s Int -> Int -> ST s ()
forall s v. GrowVector s v -> v -> ST s ()
setVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
pgVertexEdges PlanarGraph s
pg) (-Int
1)
  STRef s Int -> Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (PlanarGraph s -> STRef s Int
forall s. PlanarGraph s -> STRef s Int
pgNextVertexId PlanarGraph s
pg) (Int
maxVertexIdInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  STRef s (HashMap (Int, Int) (HalfEdge s))
edgeMap <- HashMap (Int, Int) (HalfEdge s)
-> ST s (STRef s (HashMap (Int, Int) (HalfEdge s)))
forall a s. a -> ST s (STRef s a)
newSTRef HashMap (Int, Int) (HalfEdge s)
forall k v. HashMap k v
HM.empty
  let getHalfEdge :: (Int, Int) -> ST s (HalfEdge s)
getHalfEdge (Int
vTail, Int
vTip) = do
        HashMap (Int, Int) (HalfEdge s)
hm <- STRef s (HashMap (Int, Int) (HalfEdge s))
-> ST s (HashMap (Int, Int) (HalfEdge s))
forall s a. STRef s a -> ST s a
readSTRef STRef s (HashMap (Int, Int) (HalfEdge s))
edgeMap
        case (Int, Int) -> HashMap (Int, Int) (HalfEdge s) -> Maybe (HalfEdge s)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Int
vTail, Int
vTip) HashMap (Int, Int) (HalfEdge s)
hm of
          Just{} -> String -> String -> ST s (HalfEdge s)
forall a. String -> String -> a
panic String
"fromFaces" String
"Duplicate half-edge."
          Maybe (HalfEdge s)
Nothing ->
            case (Int, Int) -> HashMap (Int, Int) (HalfEdge s) -> Maybe (HalfEdge s)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Int
vTip, Int
vTail) HashMap (Int, Int) (HalfEdge s)
hm of
              Just HalfEdge s
twin -> HalfEdge s -> ST s (HalfEdge s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HalfEdge s -> HalfEdge s
forall s. HalfEdge s -> HalfEdge s
halfEdgeTwin HalfEdge s
twin)
              Maybe (HalfEdge s)
Nothing   -> {-trace ("Creating new half-edge: " ++ show (vTip, vTail)) $ -} do
                HalfEdge s
halfEdge <- PlanarGraph s -> ST s (HalfEdge s)
forall s. PlanarGraph s -> ST s (HalfEdge s)
halfEdgeNew PlanarGraph s
pg
                HalfEdge s -> Face s -> ST s ()
forall s. HalfEdge s -> Face s -> ST s ()
halfEdgeSetFace (HalfEdge s -> HalfEdge s
forall s. HalfEdge s -> HalfEdge s
halfEdgeTwin HalfEdge s
halfEdge) (PlanarGraph s -> Face s
forall s. PlanarGraph s -> Face s
faceInvalid PlanarGraph s
pg)
                Vertex s -> HalfEdge s -> ST s ()
forall s. Vertex s -> HalfEdge s -> ST s ()
vertexSetHalfEdge (Int -> PlanarGraph s -> Vertex s
forall s. Int -> PlanarGraph s -> Vertex s
vertexFromId Int
vTip PlanarGraph s
pg) HalfEdge s
halfEdge
                STRef s (HashMap (Int, Int) (HalfEdge s))
-> HashMap (Int, Int) (HalfEdge s) -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (HashMap (Int, Int) (HalfEdge s))
edgeMap (HashMap (Int, Int) (HalfEdge s) -> ST s ())
-> HashMap (Int, Int) (HalfEdge s) -> ST s ()
forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> HalfEdge s
-> HashMap (Int, Int) (HalfEdge s)
-> HashMap (Int, Int) (HalfEdge s)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (Int
vTail, Int
vTip) HalfEdge s
halfEdge HashMap (Int, Int) (HalfEdge s)
hm
                HalfEdge s -> Vertex s -> ST s ()
forall s. HalfEdge s -> Vertex s -> ST s ()
halfEdgeSetVertex HalfEdge s
halfEdge (Int -> PlanarGraph s -> Vertex s
forall s. Int -> PlanarGraph s -> Vertex s
vertexFromId Int
vTip PlanarGraph s
pg)
                HalfEdge s -> Vertex s -> ST s ()
forall s. HalfEdge s -> Vertex s -> ST s ()
halfEdgeSetVertex (HalfEdge s -> HalfEdge s
forall s. HalfEdge s -> HalfEdge s
halfEdgeTwin HalfEdge s
halfEdge) (Int -> PlanarGraph s -> Vertex s
forall s. Int -> PlanarGraph s -> Vertex s
vertexFromId Int
vTail PlanarGraph s
pg)
                HalfEdge s -> ST s (HalfEdge s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HalfEdge s
halfEdge
      addFace :: CircularVector Int -> ST s ()
addFace CircularVector Int
face | CircularVector Int -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length CircularVector Int
face Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 = String -> String -> ST s ()
forall a. String -> String -> a
panic String
"fromFaces" String
"Faces must have at least 3 vertices."
      addFace CircularVector Int
face = {- trace "Adding face" $ -} do
        Face s
fId <- PlanarGraph s -> ST s (Face s)
forall s. PlanarGraph s -> ST s (Face s)
faceNew PlanarGraph s
pg
        let edges :: CircularVector (Int, Int)
edges = CircularVector Int
-> CircularVector Int -> CircularVector (Int, Int)
forall a b.
CircularVector a -> CircularVector b -> CircularVector (a, b)
CV.zip CircularVector Int
face (Int -> CircularVector Int -> CircularVector Int
forall a. Int -> CircularVector a -> CircularVector a
CV.rotateRight Int
1 CircularVector Int
face)
        CircularVector (HalfEdge s)
halfEdges <- {- trace ("getHalfEdge") $ -} ((Int, Int) -> ST s (HalfEdge s))
-> CircularVector (Int, Int) -> ST s (CircularVector (HalfEdge s))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int, Int) -> ST s (HalfEdge s)
getHalfEdge CircularVector (Int, Int)
edges
        Face s -> HalfEdge s -> ST s ()
forall s. Face s -> HalfEdge s -> ST s ()
faceSetHalfEdge Face s
fId (CircularVector (HalfEdge s) -> HalfEdge s
forall a. CircularVector a -> a
CV.head CircularVector (HalfEdge s)
halfEdges)
        Face s -> CircularVector (HalfEdge s) -> ST s ()
forall s. Face s -> CircularVector (HalfEdge s) -> ST s ()
setNextPrevFace Face s
fId (CircularVector (HalfEdge s) -> CircularVector (HalfEdge s)
forall a. CircularVector a -> CircularVector a
CV.reverse CircularVector (HalfEdge s)
halfEdges)
  [CircularVector Int] -> (CircularVector Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CircularVector Int]
faces CircularVector Int -> ST s ()
addFace

  Int
maxHalfEdgeId <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef (PlanarGraph s -> STRef s Int
forall s. PlanarGraph s -> STRef s Int
pgNextHalfEdgeId PlanarGraph s
pg)
  -- For each half-edge:
  --   If face is invalid:
  --     Find loop and add it as a boundary.
  [HalfEdge s] -> (HalfEdge s -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((Int -> HalfEdge s) -> [Int] -> [HalfEdge s]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> PlanarGraph s -> HalfEdge s
forall s. Int -> PlanarGraph s -> HalfEdge s
`halfEdgeFromId` PlanarGraph s
pg) [Int
0..Int
maxHalfEdgeIdInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]) ((HalfEdge s -> ST s ()) -> ST s ())
-> (HalfEdge s -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \HalfEdge s
he -> {- trace ("Scan halfedge: " ++ show he) $ -} do
    -- f <- halfEdgeFace he
    Bool
validFace <- Face s -> Bool
forall s. Face s -> Bool
faceIsValid (Face s -> Bool) -> ST s (Face s) -> ST s Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HalfEdge s -> ST s (Face s)
forall s. HalfEdge s -> ST s (Face s)
halfEdgeFace HalfEdge s
he
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
validFace (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ {- trace ("Found invalid face: " ++ show f) $ -} do
      Face s
face <- PlanarGraph s -> ST s (Face s)
forall s. PlanarGraph s -> ST s (Face s)
faceNewBoundary PlanarGraph s
pg
      CircularVector (HalfEdge s)
boundary <- HalfEdge s -> ST s (CircularVector (HalfEdge s))
forall s. HalfEdge s -> ST s (CircularVector (HalfEdge s))
halfEdgeConstructBoundary HalfEdge s
he
      -- trace ("Boundary: " ++ show (face, boundary)) $ return ()
      Face s -> HalfEdge s -> ST s ()
forall s. Face s -> HalfEdge s -> ST s ()
faceSetHalfEdge Face s
face (CircularVector (HalfEdge s) -> HalfEdge s
forall a. CircularVector a -> a
CV.head CircularVector (HalfEdge s)
boundary)
      Face s -> CircularVector (HalfEdge s) -> ST s ()
forall s. Face s -> CircularVector (HalfEdge s) -> ST s ()
setNextPrevFace Face s
face CircularVector (HalfEdge s)
boundary
  PlanarGraph s -> ST s (PlanarGraph s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PlanarGraph s
pg
  where
    setNextPrevFace :: Face s -> CircularVector (HalfEdge s) -> ST s ()
setNextPrevFace Face s
fId CircularVector (HalfEdge s)
halfEdges = do
      let edgeTriples :: CircularVector (HalfEdge s, HalfEdge s, HalfEdge s)
edgeTriples = CircularVector (HalfEdge s)
-> CircularVector (HalfEdge s)
-> CircularVector (HalfEdge s)
-> CircularVector (HalfEdge s, HalfEdge s, HalfEdge s)
forall a b c.
CircularVector a
-> CircularVector b -> CircularVector c -> CircularVector (a, b, c)
CV.zip3 (Int -> CircularVector (HalfEdge s) -> CircularVector (HalfEdge s)
forall a. Int -> CircularVector a -> CircularVector a
CV.rotateLeft Int
1 CircularVector (HalfEdge s)
halfEdges) CircularVector (HalfEdge s)
halfEdges (Int -> CircularVector (HalfEdge s) -> CircularVector (HalfEdge s)
forall a. Int -> CircularVector a -> CircularVector a
CV.rotateRight Int
1 CircularVector (HalfEdge s)
halfEdges)
      CircularVector (HalfEdge s, HalfEdge s, HalfEdge s)
-> ((HalfEdge s, HalfEdge s, HalfEdge s) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (CircularVector (HalfEdge s, HalfEdge s, HalfEdge s)
edgeTriples) (((HalfEdge s, HalfEdge s, HalfEdge s) -> ST s ()) -> ST s ())
-> ((HalfEdge s, HalfEdge s, HalfEdge s) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(HalfEdge s
prev, HalfEdge s
edge, HalfEdge s
next) -> do
          HalfEdge s -> HalfEdge s -> ST s ()
forall s. HalfEdge s -> HalfEdge s -> ST s ()
halfEdgeSetNext HalfEdge s
edge HalfEdge s
next
          HalfEdge s -> HalfEdge s -> ST s ()
forall s. HalfEdge s -> HalfEdge s -> ST s ()
halfEdgeSetPrev HalfEdge s
edge HalfEdge s
prev
          HalfEdge s -> Face s -> ST s ()
forall s. HalfEdge s -> Face s -> ST s ()
halfEdgeSetFace HalfEdge s
edge Face s
fId

-- fromFaces' :: Int -> Int -> Int -> [CircularVector VertexId] -> ST s (PlanarGraph s)
-- fromFaces' nFaces nHalfEdges maxVertexId faces = do
--   undefined

-- | \( O(n) \)
pgClone :: PlanarGraph s -> ST s (PlanarGraph s)
pgClone :: PlanarGraph s -> ST s (PlanarGraph s)
pgClone = PlanarGraph s -> ST s (PlanarGraph s)
forall a. HasCallStack => a
undefined

-- dualTree :: Face s -> ST s (Tree (Face s))
-- dualTree = undefined

pgHash :: PlanarGraph s -> ST s Int
pgHash :: PlanarGraph s -> ST s Int
pgHash PlanarGraph s
pg = do
  Int
eMax <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef (PlanarGraph s -> STRef s Int
forall s. PlanarGraph s -> STRef s Int
pgNextHalfEdgeId PlanarGraph s
pg)
  let loop :: [Int] -> Int -> ST s Int
loop [] Int
salt = Int -> ST s Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
salt
      loop (Int
edgeId:[Int]
rest) Int
salt = do
        let he :: HalfEdge s
he = Int -> PlanarGraph s -> HalfEdge s
forall s. Int -> PlanarGraph s -> HalfEdge s
halfEdgeFromId (Int
edgeIdInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) PlanarGraph s
pg
        Vertex s
vTail <- HalfEdge s -> ST s (Vertex s)
forall s. HalfEdge s -> ST s (Vertex s)
halfEdgeTailVertex HalfEdge s
he
        Vertex s
vTip <- HalfEdge s -> ST s (Vertex s)
forall s. HalfEdge s -> ST s (Vertex s)
halfEdgeTipVertex HalfEdge s
he
        [Int] -> Int -> ST s Int
loop [Int]
rest (Int -> (Vertex s, Vertex s) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Vertex s
vTail, Vertex s
vTip))
  Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> ST s Int -> ST s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Int -> ST s Int
loop [Int
0..Int
eMaxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] Int
0

-------------------------------------------------------------------------------
-- Vertices

-- | \( O(1) \)
vertexFromId :: VertexId -> PlanarGraph s -> Vertex s
vertexFromId :: Int -> PlanarGraph s -> Vertex s
vertexFromId Int
vId PlanarGraph s
pg = Int -> PlanarGraph s -> Vertex s
forall s. Int -> PlanarGraph s -> Vertex s
Vertex Int
vId PlanarGraph s
pg

-- | \( O(1) \)
vertexToId :: Vertex s -> VertexId
vertexToId :: Vertex s -> Int
vertexToId (Vertex Int
vId PlanarGraph s
_pg) = Int
vId

-- | \( O(1) \)
vertexHalfEdge :: Vertex s -> ST s (HalfEdge s)
vertexHalfEdge :: Vertex s -> ST s (HalfEdge s)
vertexHalfEdge (Vertex Int
vId PlanarGraph s
pg) = do
  Int
eId <- GrowVector s Int -> Int -> ST s Int
forall s v. GrowVector s v -> Int -> ST s v
readVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
pgVertexEdges PlanarGraph s
pg) Int
vId
  HalfEdge s -> ST s (HalfEdge s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HalfEdge s -> ST s (HalfEdge s))
-> HalfEdge s -> ST s (HalfEdge s)
forall a b. (a -> b) -> a -> b
$ Int -> PlanarGraph s -> HalfEdge s
forall s. Int -> PlanarGraph s -> HalfEdge s
HalfEdge Int
eId PlanarGraph s
pg

-- | \( O(1) \)
vertexIsBoundary :: Vertex s -> ST s Bool
vertexIsBoundary :: Vertex s -> ST s Bool
vertexIsBoundary Vertex s
vertex = Face s -> Bool
forall s. Face s -> Bool
faceIsBoundary (Face s -> Bool) -> ST s (Face s) -> ST s Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HalfEdge s -> ST s (Face s)
forall s. HalfEdge s -> ST s (Face s)
halfEdgeFace (HalfEdge s -> ST s (Face s)) -> ST s (HalfEdge s) -> ST s (Face s)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (HalfEdge s -> HalfEdge s
forall s. HalfEdge s -> HalfEdge s
halfEdgeTwin (HalfEdge s -> HalfEdge s)
-> ST s (HalfEdge s) -> ST s (HalfEdge s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vertex s -> ST s (HalfEdge s)
forall s. Vertex s -> ST s (HalfEdge s)
vertexHalfEdge Vertex s
vertex))

-- | O(k)
vertexOutgoingHalfEdges :: Vertex s -> ST s (CircularVector (HalfEdge s))
vertexOutgoingHalfEdges :: Vertex s -> ST s (CircularVector (HalfEdge s))
vertexOutgoingHalfEdges Vertex s
vertex = do
  GrowVector s (HalfEdge s)
tmp <- Int -> ST s (GrowVector s (HalfEdge s))
forall s v. Int -> ST s (GrowVector s v)
newVector Int
10
  STRef s Int
iRef <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef Int
0
  Vertex s -> (HalfEdge s -> ST s ()) -> ST s ()
forall s. Vertex s -> (HalfEdge s -> ST s ()) -> ST s ()
vertexWithOutgoingHalfEdges Vertex s
vertex ((HalfEdge s -> ST s ()) -> ST s ())
-> (HalfEdge s -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \HalfEdge s
edge -> do
    Int
i <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
iRef
    STRef s Int -> (Int -> Int) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Int
iRef Int -> Int
forall a. Enum a => a -> a
succ
    GrowVector s (HalfEdge s) -> Int -> HalfEdge s -> ST s ()
forall s v. GrowVector s v -> Int -> v -> ST s ()
writeVector GrowVector s (HalfEdge s)
tmp Int
i HalfEdge s
edge
  Int
i <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef STRef s Int
iRef
  Int
-> GrowVector s (HalfEdge s) -> ST s (CircularVector (HalfEdge s))
forall s v. Int -> GrowVector s v -> ST s (CircularVector v)
freezeCircularVector Int
i GrowVector s (HalfEdge s)
tmp

-- | O(k), more efficient than 'vertexOutgoingHalfEdges'.
vertexWithOutgoingHalfEdges :: Vertex s -> (HalfEdge s -> ST s ()) -> ST s ()
vertexWithOutgoingHalfEdges :: Vertex s -> (HalfEdge s -> ST s ()) -> ST s ()
vertexWithOutgoingHalfEdges Vertex s
vertex HalfEdge s -> ST s ()
cb = do
  HalfEdge s
first <- Vertex s -> ST s (HalfEdge s)
forall s. Vertex s -> ST s (HalfEdge s)
vertexHalfEdge Vertex s
vertex
  HalfEdge s -> ST s ()
cb HalfEdge s
first
  let loop :: HalfEdge s -> ST s ()
loop HalfEdge s
edge | HalfEdge s
edge HalfEdge s -> HalfEdge s -> Bool
forall a. Eq a => a -> a -> Bool
== HalfEdge s
first = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      loop HalfEdge s
edge = String -> ST s () -> ST s ()
forall a. String -> a -> a
trace (String
"At edge: "String -> ShowS
forall a. [a] -> [a] -> [a]
++ (HalfEdge s, HalfEdge s) -> String
forall a. Show a => a -> String
show (HalfEdge s
first, HalfEdge s
edge)) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
        HalfEdge s -> ST s ()
cb HalfEdge s
edge
        HalfEdge s -> ST s ()
loop (HalfEdge s -> ST s ()) -> ST s (HalfEdge s) -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HalfEdge s -> ST s (HalfEdge s)
forall s. HalfEdge s -> ST s (HalfEdge s)
halfEdgeNext (HalfEdge s -> HalfEdge s
forall s. HalfEdge s -> HalfEdge s
halfEdgeTwin HalfEdge s
edge)
  HalfEdge s -> ST s ()
loop (HalfEdge s -> ST s ()) -> ST s (HalfEdge s) -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HalfEdge s -> ST s (HalfEdge s)
forall s. HalfEdge s -> ST s (HalfEdge s)
halfEdgeNext (HalfEdge s -> HalfEdge s
forall s. HalfEdge s -> HalfEdge s
halfEdgeTwin HalfEdge s
first)

-- | O(k)
vertexIncomingHalfEdges :: Vertex s -> ST s (CircularVector (HalfEdge s))
vertexIncomingHalfEdges :: Vertex s -> ST s (CircularVector (HalfEdge s))
vertexIncomingHalfEdges Vertex s
vertex = (HalfEdge s -> HalfEdge s)
-> CircularVector (HalfEdge s) -> CircularVector (HalfEdge s)
forall a b. (a -> b) -> CircularVector a -> CircularVector b
CV.map HalfEdge s -> HalfEdge s
forall s. HalfEdge s -> HalfEdge s
halfEdgeTwin (CircularVector (HalfEdge s) -> CircularVector (HalfEdge s))
-> ST s (CircularVector (HalfEdge s))
-> ST s (CircularVector (HalfEdge s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vertex s -> ST s (CircularVector (HalfEdge s))
forall s. Vertex s -> ST s (CircularVector (HalfEdge s))
vertexOutgoingHalfEdges Vertex s
vertex

-- | O(k)
vertexWithIncomingHalfEdges :: Vertex s -> (HalfEdge s -> ST s ()) -> ST s ()
vertexWithIncomingHalfEdges :: Vertex s -> (HalfEdge s -> ST s ()) -> ST s ()
vertexWithIncomingHalfEdges = Vertex s -> (HalfEdge s -> ST s ()) -> ST s ()
forall a. HasCallStack => a
undefined

-- | O(k)
vertexNeighbours :: Vertex s -> ST s (CircularVector (Vertex s))
vertexNeighbours :: Vertex s -> ST s (CircularVector (Vertex s))
vertexNeighbours Vertex s
vertex = (HalfEdge s -> ST s (Vertex s))
-> CircularVector (HalfEdge s) -> ST s (CircularVector (Vertex s))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CircularVector a -> m (CircularVector b)
CV.mapM HalfEdge s -> ST s (Vertex s)
forall s. HalfEdge s -> ST s (Vertex s)
halfEdgeVertex (CircularVector (HalfEdge s) -> ST s (CircularVector (Vertex s)))
-> ST s (CircularVector (HalfEdge s))
-> ST s (CircularVector (Vertex s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Vertex s -> ST s (CircularVector (HalfEdge s))
forall s. Vertex s -> ST s (CircularVector (HalfEdge s))
vertexIncomingHalfEdges Vertex s
vertex

-- vertexAdjacentVertices :: Vertex -> PlanarGraph -> [Vertex]
-- vertexAdjacentFaces :: Vertex -> PlanarGraph -> [Face]

-- O(1), internal function.
vertexNew :: PlanarGraph s -> ST s (Vertex s)
vertexNew :: PlanarGraph s -> ST s (Vertex s)
vertexNew PlanarGraph s
pg = do
  Int
vId <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef (PlanarGraph s -> STRef s Int
forall s. PlanarGraph s -> STRef s Int
pgNextVertexId PlanarGraph s
pg)
  STRef s Int -> Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (PlanarGraph s -> STRef s Int
forall s. PlanarGraph s -> STRef s Int
pgNextVertexId PlanarGraph s
pg) (Int
vIdInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  Vertex s -> ST s (Vertex s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> PlanarGraph s -> Vertex s
forall s. Int -> PlanarGraph s -> Vertex s
Vertex Int
vId PlanarGraph s
pg)

vertexSetHalfEdge :: Vertex s -> HalfEdge s -> ST s ()
vertexSetHalfEdge :: Vertex s -> HalfEdge s -> ST s ()
vertexSetHalfEdge (Vertex Int
vId PlanarGraph s
pg) (HalfEdge Int
eId PlanarGraph s
pg') = String -> PlanarGraph s -> PlanarGraph s -> ST s () -> ST s ()
forall s a. String -> PlanarGraph s -> PlanarGraph s -> a -> a
eqCheck String
"vertexSetHalfEdge" PlanarGraph s
pg PlanarGraph s
pg' (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
  GrowVector s Int -> Int -> Int -> ST s ()
forall s v. GrowVector s v -> Int -> v -> ST s ()
writeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
pgVertexEdges PlanarGraph s
pg) Int
vId Int
eId

-------------------------------------------------------------------------------
-- Edges

-- | O(1)
edgeFromId :: EdgeId -> PlanarGraph s -> Edge s
edgeFromId :: Int -> PlanarGraph s -> Edge s
edgeFromId = Int -> PlanarGraph s -> Edge s
forall s. Int -> PlanarGraph s -> Edge s
Edge

-- | O(1)
edgeToId :: Edge s -> EdgeId
edgeToId :: Edge s -> Int
edgeToId (Edge Int
e PlanarGraph s
_) = Int
e

-- | O(1)
edgeFromHalfEdge :: HalfEdge s -> Edge s
edgeFromHalfEdge :: HalfEdge s -> Edge s
edgeFromHalfEdge (HalfEdge Int
he PlanarGraph s
pg) = Int -> PlanarGraph s -> Edge s
forall s. Int -> PlanarGraph s -> Edge s
Edge (Int
he Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) PlanarGraph s
pg

-- | O(1)
edgeToHalfEdges :: Edge s -> (HalfEdge s, HalfEdge s)
edgeToHalfEdges :: Edge s -> (HalfEdge s, HalfEdge s)
edgeToHalfEdges (Edge Int
e PlanarGraph s
pg) = (Int -> PlanarGraph s -> HalfEdge s
forall s. Int -> PlanarGraph s -> HalfEdge s
HalfEdge (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) PlanarGraph s
pg, Int -> PlanarGraph s -> HalfEdge s
forall s. Int -> PlanarGraph s -> HalfEdge s
HalfEdge (Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) PlanarGraph s
pg)

-------------------------------------------------------------------------------
-- Half-edges

-- | O(1)
halfEdgePlanarGraph :: HalfEdge s -> PlanarGraph s
halfEdgePlanarGraph :: HalfEdge s -> PlanarGraph s
halfEdgePlanarGraph (HalfEdge Int
_ PlanarGraph s
pg) = PlanarGraph s
pg

-- | O(1)
halfEdgeIsValid :: HalfEdge s -> Bool
halfEdgeIsValid :: HalfEdge s -> Bool
halfEdgeIsValid (HalfEdge Int
eId PlanarGraph s
_) = Int
eId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0

-- | O(1)
halfEdgeFromId :: HalfEdgeId -> PlanarGraph s -> HalfEdge s
halfEdgeFromId :: Int -> PlanarGraph s -> HalfEdge s
halfEdgeFromId Int
eId PlanarGraph s
pg = Int -> PlanarGraph s -> HalfEdge s
forall s. Int -> PlanarGraph s -> HalfEdge s
HalfEdge Int
eId PlanarGraph s
pg

-- | O(1)
halfEdgeToId :: HalfEdge s -> HalfEdgeId
halfEdgeToId :: HalfEdge s -> Int
halfEdgeToId (HalfEdge Int
eId PlanarGraph s
_pg) = Int
eId

-- | O(1)
halfEdgeNext :: HalfEdge s -> ST s (HalfEdge s)
halfEdgeNext :: HalfEdge s -> ST s (HalfEdge s)
halfEdgeNext (HalfEdge Int
eId PlanarGraph s
pg) = do
  Int
next <- GrowVector s Int -> Int -> ST s Int
forall s v. GrowVector s v -> Int -> ST s v
readVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
pgHalfEdgeNext PlanarGraph s
pg) Int
eId
  HalfEdge s -> ST s (HalfEdge s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HalfEdge s -> ST s (HalfEdge s))
-> HalfEdge s -> ST s (HalfEdge s)
forall a b. (a -> b) -> a -> b
$ Int -> PlanarGraph s -> HalfEdge s
forall s. Int -> PlanarGraph s -> HalfEdge s
HalfEdge Int
next PlanarGraph s
pg

-- | O(1)
halfEdgePrev :: HalfEdge s -> ST s (HalfEdge s)
halfEdgePrev :: HalfEdge s -> ST s (HalfEdge s)
halfEdgePrev (HalfEdge Int
eId PlanarGraph s
pg) = do
  Int
prev <- GrowVector s Int -> Int -> ST s Int
forall s v. GrowVector s v -> Int -> ST s v
readVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
pgHalfEdgePrev PlanarGraph s
pg) Int
eId
  HalfEdge s -> ST s (HalfEdge s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HalfEdge s -> ST s (HalfEdge s))
-> HalfEdge s -> ST s (HalfEdge s)
forall a b. (a -> b) -> a -> b
$ Int -> PlanarGraph s -> HalfEdge s
forall s. Int -> PlanarGraph s -> HalfEdge s
HalfEdge Int
prev PlanarGraph s
pg

-- | O(1)
--   Next half-edge with the same vertex.
halfEdgeNextOutgoing :: HalfEdge s -> ST s (HalfEdge s)
halfEdgeNextOutgoing :: HalfEdge s -> ST s (HalfEdge s)
halfEdgeNextOutgoing = HalfEdge s -> ST s (HalfEdge s)
forall s. HalfEdge s -> ST s (HalfEdge s)
halfEdgeNext (HalfEdge s -> ST s (HalfEdge s))
-> (HalfEdge s -> HalfEdge s) -> HalfEdge s -> ST s (HalfEdge s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HalfEdge s -> HalfEdge s
forall s. HalfEdge s -> HalfEdge s
halfEdgeTwin

-- | O(1)
--   Next half-edge with the same vertex.
halfEdgeNextIncoming :: HalfEdge s -> ST s (HalfEdge s)
halfEdgeNextIncoming :: HalfEdge s -> ST s (HalfEdge s)
halfEdgeNextIncoming = HalfEdge s -> ST s (HalfEdge s)
forall s. HalfEdge s -> ST s (HalfEdge s)
halfEdgePrev (HalfEdge s -> ST s (HalfEdge s))
-> (HalfEdge s -> HalfEdge s) -> HalfEdge s -> ST s (HalfEdge s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HalfEdge s -> HalfEdge s
forall s. HalfEdge s -> HalfEdge s
halfEdgeTwin

-- | O(1)
halfEdgeVertex     :: HalfEdge s -> ST s (Vertex s)
halfEdgeVertex :: HalfEdge s -> ST s (Vertex s)
halfEdgeVertex (HalfEdge Int
idx PlanarGraph s
pg) = do
  Int
v <- GrowVector s Int -> Int -> ST s Int
forall s v. GrowVector s v -> Int -> ST s v
readVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
pgHalfEdgeVertex PlanarGraph s
pg) Int
idx
  Vertex s -> ST s (Vertex s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vertex s -> ST s (Vertex s)) -> Vertex s -> ST s (Vertex s)
forall a b. (a -> b) -> a -> b
$ Int -> PlanarGraph s -> Vertex s
forall s. Int -> PlanarGraph s -> Vertex s
Vertex Int
v PlanarGraph s
pg

-- | O(1)
halfEdgeTwin       :: HalfEdge s -> HalfEdge s
halfEdgeTwin :: HalfEdge s -> HalfEdge s
halfEdgeTwin (HalfEdge Int
idx PlanarGraph s
graph) = Int -> PlanarGraph s -> HalfEdge s
forall s. Int -> PlanarGraph s -> HalfEdge s
HalfEdge (Int
idx Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` Int
1) PlanarGraph s
graph

-- | O(1)
--   Tail vertex. IE. the vertex of the twin edge.
halfEdgeTailVertex :: HalfEdge s -> ST s (Vertex s)
halfEdgeTailVertex :: HalfEdge s -> ST s (Vertex s)
halfEdgeTailVertex = HalfEdge s -> ST s (Vertex s)
forall s. HalfEdge s -> ST s (Vertex s)
halfEdgeVertex

-- | O(1)
--   Synonym of `halfEdgeVertex`.
halfEdgeTipVertex  :: HalfEdge s -> ST s (Vertex s)
halfEdgeTipVertex :: HalfEdge s -> ST s (Vertex s)
halfEdgeTipVertex = HalfEdge s -> ST s (Vertex s)
forall s. HalfEdge s -> ST s (Vertex s)
halfEdgeVertex (HalfEdge s -> ST s (Vertex s))
-> (HalfEdge s -> HalfEdge s) -> HalfEdge s -> ST s (Vertex s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HalfEdge s -> HalfEdge s
forall s. HalfEdge s -> HalfEdge s
halfEdgeTwin

-- | \( O(1) \)
--
-- ==== __Examples:__
-- @
-- 'pgFromFaces' [[0,1,2]]
-- @
--
-- <<docs/Data/PlanarGraph/planargraph-2959979592048325618.svg>>
--
-- >>> runST $ do pg <- pgFromFaces [[0,1,2]]; show <$> halfEdgeFace (halfEdgeFromId 0 pg)
-- "Face 0"
--
-- >>> runST $ do pg <- pgFromFaces [[0,1,2]]; show <$> halfEdgeFace (halfEdgeFromId 1 pg)
-- "Boundary 0"
--
halfEdgeFace       :: HalfEdge s -> ST s (Face s)
halfEdgeFace :: HalfEdge s -> ST s (Face s)
halfEdgeFace (HalfEdge Int
eId PlanarGraph s
pg) = do
  Int
fId <- GrowVector s Int -> Int -> ST s Int
forall s v. GrowVector s v -> Int -> ST s v
readVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
pgHalfEdgeFace PlanarGraph s
pg) Int
eId
  Face s -> ST s (Face s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Face s -> ST s (Face s)) -> Face s -> ST s (Face s)
forall a b. (a -> b) -> a -> b
$ Int -> PlanarGraph s -> Face s
forall s. Int -> PlanarGraph s -> Face s
faceFromId Int
fId PlanarGraph s
pg

-- | O(n)
--   Scan boundary half-edges without using 'next' or 'prev'.
halfEdgeConstructBoundary :: HalfEdge s -> ST s (CircularVector (HalfEdge s))
halfEdgeConstructBoundary :: HalfEdge s -> ST s (CircularVector (HalfEdge s))
halfEdgeConstructBoundary HalfEdge s
halfEdge = {- trace ("mkBoundary from: " ++ show halfEdge) $ -} do
  GrowVector s (HalfEdge s)
tmp <- Int -> ST s (GrowVector s (HalfEdge s))
forall s v. Int -> ST s (GrowVector s v)
newVector Int
10
  GrowVector s (HalfEdge s) -> Int -> HalfEdge s -> ST s ()
forall s v. GrowVector s v -> Int -> v -> ST s ()
writeVector GrowVector s (HalfEdge s)
tmp Int
0 HalfEdge s
halfEdge
  let loop :: Int -> HalfEdge s -> ST s Int
loop Int
i HalfEdge s
edge | HalfEdge s
edge HalfEdge s -> HalfEdge s -> Bool
forall a. Eq a => a -> a -> Bool
== HalfEdge s
halfEdge = {- trace "Done" $ -} Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
      loop Int
i HalfEdge s
edge = {- trace ("Going to: " ++ show edge) $ -} do
        Face s
face <- HalfEdge s -> ST s (Face s)
forall s. HalfEdge s -> ST s (Face s)
halfEdgeFace HalfEdge s
edge
        if Face s -> Bool
forall s. Face s -> Bool
faceIsInvalid Face s
face
          then do
            GrowVector s (HalfEdge s) -> Int -> HalfEdge s -> ST s ()
forall s v. GrowVector s v -> Int -> v -> ST s ()
writeVector GrowVector s (HalfEdge s)
tmp Int
i HalfEdge s
edge
            Int -> HalfEdge s -> ST s Int
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (HalfEdge s -> ST s Int) -> ST s (HalfEdge s) -> ST s Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (HalfEdge s -> HalfEdge s
forall s. HalfEdge s -> HalfEdge s
halfEdgeTwin (HalfEdge s -> HalfEdge s)
-> ST s (HalfEdge s) -> ST s (HalfEdge s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HalfEdge s -> ST s (HalfEdge s)
forall s. HalfEdge s -> ST s (HalfEdge s)
halfEdgeNextIncoming HalfEdge s
edge)
          else
            Int -> HalfEdge s -> ST s Int
loop Int
i (HalfEdge s -> ST s Int) -> ST s (HalfEdge s) -> ST s Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (HalfEdge s -> HalfEdge s
forall s. HalfEdge s -> HalfEdge s
halfEdgeTwin (HalfEdge s -> HalfEdge s)
-> ST s (HalfEdge s) -> ST s (HalfEdge s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HalfEdge s -> ST s (HalfEdge s)
forall s. HalfEdge s -> ST s (HalfEdge s)
halfEdgePrev HalfEdge s
edge)
  Int
i <- Int -> HalfEdge s -> ST s Int
loop Int
1 (HalfEdge s -> ST s Int) -> ST s (HalfEdge s) -> ST s Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (HalfEdge s -> HalfEdge s
forall s. HalfEdge s -> HalfEdge s
halfEdgeTwin (HalfEdge s -> HalfEdge s)
-> ST s (HalfEdge s) -> ST s (HalfEdge s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HalfEdge s -> ST s (HalfEdge s)
forall s. HalfEdge s -> ST s (HalfEdge s)
halfEdgeNextIncoming HalfEdge s
halfEdge)
  CircularVector (HalfEdge s)
cv <- Int
-> GrowVector s (HalfEdge s) -> ST s (CircularVector (HalfEdge s))
forall s v. Int -> GrowVector s v -> ST s (CircularVector v)
freezeCircularVector Int
i GrowVector s (HalfEdge s)
tmp
  -- trace ("Boundary: " ++ show cv) $ pure cv
  CircularVector (HalfEdge s) -> ST s (CircularVector (HalfEdge s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure CircularVector (HalfEdge s)
cv

-- | O(k)
halfEdgeWithLoop        :: HalfEdge s -> (HalfEdge s -> ST s ()) -> ST s ()
halfEdgeWithLoop :: HalfEdge s -> (HalfEdge s -> ST s ()) -> ST s ()
halfEdgeWithLoop HalfEdge s
he HalfEdge s -> ST s ()
cb = HalfEdge s -> ST s ()
worker (HalfEdge s -> ST s ()) -> ST s (HalfEdge s) -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HalfEdge s -> ST s (HalfEdge s)
forall s. HalfEdge s -> ST s (HalfEdge s)
halfEdgeNext HalfEdge s
he
  where
    worker :: HalfEdge s -> ST s ()
worker HalfEdge s
edge
      | HalfEdge s
edge HalfEdge s -> HalfEdge s -> Bool
forall a. Eq a => a -> a -> Bool
== HalfEdge s
he = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise  = do HalfEdge s -> ST s ()
cb HalfEdge s
edge; HalfEdge s -> ST s ()
worker (HalfEdge s -> ST s ()) -> ST s (HalfEdge s) -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HalfEdge s -> ST s (HalfEdge s)
forall s. HalfEdge s -> ST s (HalfEdge s)
halfEdgeNext HalfEdge s
edge

-- $setup
-- >>> let genPG = pgFromFaces [[0,1,2]]

-- | \( O(1) \)
--   Check if a half-edge's face is interior or exterior.
--
-- ==== __Examples:__
-- @
-- 'pgFromFaces' [[0,1,2]]
-- @
--
-- <<docs/Data/PlanarGraph/planargraph-2959979592048325618.svg>>
--
-- >>> runST $ do pg <- pgFromFaces [[0,1,2]]; halfEdgeIsInterior (halfEdgeFromId 0 pg)
-- True
--
-- >>> runST $ do pg <- pgFromFaces [[0,1,2]]; halfEdgeIsInterior (halfEdgeFromId 1 pg)
-- False
--
-- >>> runST $ do pg <- pgFromFaces [[0,1,2]]; halfEdgeIsInterior (halfEdgeFromId 2 pg)
-- True
--
-- >>> runST $ do pg <- pgFromFaces [[0,1,2]]; halfEdgeIsInterior (halfEdgeFromId 3 pg)
-- False
halfEdgeIsInterior :: HalfEdge s -> ST s Bool
halfEdgeIsInterior :: HalfEdge s -> ST s Bool
halfEdgeIsInterior HalfEdge s
edge = Face s -> Bool
forall s. Face s -> Bool
faceIsInterior (Face s -> Bool) -> ST s (Face s) -> ST s Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HalfEdge s -> ST s (Face s)
forall s. HalfEdge s -> ST s (Face s)
halfEdgeFace HalfEdge s
edge

-- O(1) Allocate new half-edge pair.
halfEdgeNew :: PlanarGraph s -> ST s (HalfEdge s)
halfEdgeNew :: PlanarGraph s -> ST s (HalfEdge s)
halfEdgeNew PlanarGraph s
pg = do
  Int
eId <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef (PlanarGraph s -> STRef s Int
forall s. PlanarGraph s -> STRef s Int
pgNextHalfEdgeId PlanarGraph s
pg)
  STRef s Int -> Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (PlanarGraph s -> STRef s Int
forall s. PlanarGraph s -> STRef s Int
pgNextHalfEdgeId PlanarGraph s
pg) (Int
eIdInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  HalfEdge s -> ST s (HalfEdge s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> PlanarGraph s -> HalfEdge s
forall s. Int -> PlanarGraph s -> HalfEdge s
HalfEdge (Int
eIdInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) PlanarGraph s
pg)

halfEdgeSetNext :: HalfEdge s -> HalfEdge s -> ST s ()
halfEdgeSetNext :: HalfEdge s -> HalfEdge s -> ST s ()
halfEdgeSetNext (HalfEdge Int
e PlanarGraph s
pg) (HalfEdge Int
next PlanarGraph s
pg') = String -> PlanarGraph s -> PlanarGraph s -> ST s () -> ST s ()
forall s a. String -> PlanarGraph s -> PlanarGraph s -> a -> a
eqCheck String
"halfEdgeSetNext" PlanarGraph s
pg PlanarGraph s
pg' (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
  -- trace ("Set next: " ++ show (e, next)) $
  GrowVector s Int -> Int -> Int -> ST s ()
forall s v. GrowVector s v -> Int -> v -> ST s ()
writeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
pgHalfEdgeNext PlanarGraph s
pg) Int
e Int
next

halfEdgeSetPrev :: HalfEdge s -> HalfEdge s -> ST s ()
halfEdgeSetPrev :: HalfEdge s -> HalfEdge s -> ST s ()
halfEdgeSetPrev (HalfEdge Int
e PlanarGraph s
pg) (HalfEdge Int
prev PlanarGraph s
pg') = String -> PlanarGraph s -> PlanarGraph s -> ST s () -> ST s ()
forall s a. String -> PlanarGraph s -> PlanarGraph s -> a -> a
eqCheck String
"halfEdgeSetPrev" PlanarGraph s
pg PlanarGraph s
pg' (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
  -- trace ("Set prev: " ++ show (e, prev)) $
  GrowVector s Int -> Int -> Int -> ST s ()
forall s v. GrowVector s v -> Int -> v -> ST s ()
writeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
pgHalfEdgePrev PlanarGraph s
pg) Int
e Int
prev

halfEdgeSetFace :: HalfEdge s -> Face s -> ST s ()
halfEdgeSetFace :: HalfEdge s -> Face s -> ST s ()
halfEdgeSetFace (HalfEdge Int
e PlanarGraph s
pg) Face s
face =
  -- trace ("Set face: " ++ show (e, face)) $
  GrowVector s Int -> Int -> Int -> ST s ()
forall s v. GrowVector s v -> Int -> v -> ST s ()
writeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
pgHalfEdgeFace PlanarGraph s
pg) Int
e (Face s -> Int
forall s. Face s -> Int
faceToId Face s
face)

halfEdgeSetVertex :: HalfEdge s -> Vertex s -> ST s ()
halfEdgeSetVertex :: HalfEdge s -> Vertex s -> ST s ()
halfEdgeSetVertex (HalfEdge Int
e PlanarGraph s
pg) Vertex s
vertex =
  -- trace ("Set vertex: " ++ show (e, vertex)) $
  GrowVector s Int -> Int -> Int -> ST s ()
forall s v. GrowVector s v -> Int -> v -> ST s ()
writeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
pgHalfEdgeVertex PlanarGraph s
pg) Int
e (Vertex s -> Int
forall s. Vertex s -> Int
vertexToId Vertex s
vertex)

-------------------------------------------------------------------------------
-- Faces

-- | O(1)
faceInvalid :: PlanarGraph s -> Face s
faceInvalid :: PlanarGraph s -> Face s
faceInvalid = Int -> PlanarGraph s -> Face s
forall s. Int -> PlanarGraph s -> Face s
faceFromId Int
forall a. Bounded a => a
maxBound

-- | O(1)
faceIsValid :: Face s -> Bool
faceIsValid :: Face s -> Bool
faceIsValid = Bool -> Bool
not (Bool -> Bool) -> (Face s -> Bool) -> Face s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Face s -> Bool
forall s. Face s -> Bool
faceIsInvalid

-- | O(1)
faceIsInvalid :: Face s -> Bool
faceIsInvalid :: Face s -> Bool
faceIsInvalid (Face Int
fId PlanarGraph s
_)     = Int
fId Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound
faceIsInvalid (Boundary Int
fId PlanarGraph s
_) = Int
fId Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound

-- | O(1)
faceFromId :: FaceId -> PlanarGraph s -> Face s
faceFromId :: Int -> PlanarGraph s -> Face s
faceFromId Int
fId PlanarGraph s
pg | Int
fId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> PlanarGraph s -> Face s
forall s. Int -> PlanarGraph s -> Face s
Boundary (Int -> Int
forall a. Num a => a -> a
negate Int
fId Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) PlanarGraph s
pg
faceFromId Int
fId PlanarGraph s
pg = Int -> PlanarGraph s -> Face s
forall s. Int -> PlanarGraph s -> Face s
Face Int
fId PlanarGraph s
pg

-- | O(1)
faceToId :: Face s -> FaceId
faceToId :: Face s -> Int
faceToId (Face Int
fId PlanarGraph s
_)     = Int
fId
faceToId (Boundary Int
fId PlanarGraph s
_) = Int -> Int
forall a. Num a => a -> a
negate Int
fId Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | O(1)
faceHalfEdge         :: Face s -> ST s (HalfEdge s)
faceHalfEdge :: Face s -> ST s (HalfEdge s)
faceHalfEdge (Face Int
fId PlanarGraph s
pg) = do
  Int
eId <- GrowVector s Int -> Int -> ST s Int
forall s v. GrowVector s v -> Int -> ST s v
readVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
pgFaceEdges PlanarGraph s
pg) Int
fId
  HalfEdge s -> ST s (HalfEdge s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HalfEdge s -> ST s (HalfEdge s))
-> HalfEdge s -> ST s (HalfEdge s)
forall a b. (a -> b) -> a -> b
$ Int -> PlanarGraph s -> HalfEdge s
forall s. Int -> PlanarGraph s -> HalfEdge s
HalfEdge Int
eId PlanarGraph s
pg
faceHalfEdge (Boundary Int
fId PlanarGraph s
pg) = do
  Int
eId <- GrowVector s Int -> Int -> ST s Int
forall s v. GrowVector s v -> Int -> ST s v
readVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
pgBoundaryEdges PlanarGraph s
pg) Int
fId
  HalfEdge s -> ST s (HalfEdge s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HalfEdge s -> ST s (HalfEdge s))
-> HalfEdge s -> ST s (HalfEdge s)
forall a b. (a -> b) -> a -> b
$ Int -> PlanarGraph s -> HalfEdge s
forall s. Int -> PlanarGraph s -> HalfEdge s
HalfEdge Int
eId PlanarGraph s
pg

-- | O(1)
faceIsInterior       :: Face s -> Bool
faceIsInterior :: Face s -> Bool
faceIsInterior = Bool -> Bool
not (Bool -> Bool) -> (Face s -> Bool) -> Face s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Face s -> Bool
forall s. Face s -> Bool
faceIsBoundary

-- | O(1)
faceIsBoundary       :: Face s -> Bool
faceIsBoundary :: Face s -> Bool
faceIsBoundary Face{}     = Bool
False
faceIsBoundary Boundary{} = Bool
True

-- faceVertices         :: Face s -> ST s (CircularVector (Vertex s))

-- | O(k)
--   Counterclockwise vector of edges.
faceHalfEdges        :: Face s -> ST s (CircularVector (HalfEdge s))
faceHalfEdges :: Face s -> ST s (CircularVector (HalfEdge s))
faceHalfEdges Face s
face
  | Face s -> Bool
forall s. Face s -> Bool
faceIsBoundary Face s
face = (HalfEdge s -> ST s (HalfEdge s))
-> ST s (CircularVector (HalfEdge s))
worker HalfEdge s -> ST s (HalfEdge s)
forall s. HalfEdge s -> ST s (HalfEdge s)
halfEdgeNext
  | Bool
otherwise           = (HalfEdge s -> ST s (HalfEdge s))
-> ST s (CircularVector (HalfEdge s))
worker HalfEdge s -> ST s (HalfEdge s)
forall s. HalfEdge s -> ST s (HalfEdge s)
halfEdgePrev
  where
    worker :: (HalfEdge s -> ST s (HalfEdge s))
-> ST s (CircularVector (HalfEdge s))
worker HalfEdge s -> ST s (HalfEdge s)
advance = do
      HalfEdge s
first <- Face s -> ST s (HalfEdge s)
forall s. Face s -> ST s (HalfEdge s)
faceHalfEdge Face s
face
      GrowVector s (HalfEdge s)
tmp <- Int -> ST s (GrowVector s (HalfEdge s))
forall s v. Int -> ST s (GrowVector s v)
newVector Int
10
      GrowVector s (HalfEdge s) -> Int -> HalfEdge s -> ST s ()
forall s v. GrowVector s v -> Int -> v -> ST s ()
writeVector GrowVector s (HalfEdge s)
tmp Int
0 HalfEdge s
first
      let loop :: Int -> HalfEdge s -> ST s Int
loop Int
i HalfEdge s
edge | HalfEdge s
edge HalfEdge s -> HalfEdge s -> Bool
forall a. Eq a => a -> a -> Bool
== HalfEdge s
first = Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
          loop Int
i HalfEdge s
edge = do
            GrowVector s (HalfEdge s) -> Int -> HalfEdge s -> ST s ()
forall s v. GrowVector s v -> Int -> v -> ST s ()
writeVector GrowVector s (HalfEdge s)
tmp Int
i HalfEdge s
edge
            Int -> HalfEdge s -> ST s Int
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (HalfEdge s -> ST s Int) -> ST s (HalfEdge s) -> ST s Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HalfEdge s -> ST s (HalfEdge s)
advance HalfEdge s
edge
      Int
i <- Int -> HalfEdge s -> ST s Int
loop Int
1 (HalfEdge s -> ST s Int) -> ST s (HalfEdge s) -> ST s Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HalfEdge s -> ST s (HalfEdge s)
advance HalfEdge s
first
      Int
-> GrowVector s (HalfEdge s) -> ST s (CircularVector (HalfEdge s))
forall s v. Int -> GrowVector s v -> ST s (CircularVector v)
freezeCircularVector Int
i GrowVector s (HalfEdge s)
tmp

-- | O(k)
faceBoundary :: Face s -> ST s (CircularVector (Vertex s))
faceBoundary :: Face s -> ST s (CircularVector (Vertex s))
faceBoundary Face s
face = (HalfEdge s -> ST s (Vertex s))
-> CircularVector (HalfEdge s) -> ST s (CircularVector (Vertex s))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CircularVector a -> m (CircularVector b)
CV.mapM HalfEdge s -> ST s (Vertex s)
forall s. HalfEdge s -> ST s (Vertex s)
halfEdgeVertex (CircularVector (HalfEdge s) -> ST s (CircularVector (Vertex s)))
-> ST s (CircularVector (HalfEdge s))
-> ST s (CircularVector (Vertex s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Face s -> ST s (CircularVector (HalfEdge s))
forall s. Face s -> ST s (CircularVector (HalfEdge s))
faceHalfEdges Face s
face

-- faceAdjacentFaces    :: Face s -> ST s (CircularVector (Face s))

faceNew :: PlanarGraph s -> ST s (Face s)
faceNew :: PlanarGraph s -> ST s (Face s)
faceNew PlanarGraph s
pg = do
  Int
fId <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef (PlanarGraph s -> STRef s Int
forall s. PlanarGraph s -> STRef s Int
pgNextFaceId PlanarGraph s
pg)
  STRef s Int -> Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (PlanarGraph s -> STRef s Int
forall s. PlanarGraph s -> STRef s Int
pgNextFaceId PlanarGraph s
pg) (Int
fIdInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  Face s -> ST s (Face s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> PlanarGraph s -> Face s
forall s. Int -> PlanarGraph s -> Face s
Face Int
fId PlanarGraph s
pg)

faceNewBoundary :: PlanarGraph s -> ST s (Face s)
faceNewBoundary :: PlanarGraph s -> ST s (Face s)
faceNewBoundary PlanarGraph s
pg = do
  Int
fId <- STRef s Int -> ST s Int
forall s a. STRef s a -> ST s a
readSTRef (PlanarGraph s -> STRef s Int
forall s. PlanarGraph s -> STRef s Int
pgNextBoundaryId PlanarGraph s
pg)
  STRef s Int -> Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef (PlanarGraph s -> STRef s Int
forall s. PlanarGraph s -> STRef s Int
pgNextBoundaryId PlanarGraph s
pg) (Int
fIdInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  Face s -> ST s (Face s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> PlanarGraph s -> Face s
forall s. Int -> PlanarGraph s -> Face s
Boundary Int
fId PlanarGraph s
pg)

faceSetHalfEdge :: Face s -> HalfEdge s -> ST s ()
faceSetHalfEdge :: Face s -> HalfEdge s -> ST s ()
faceSetHalfEdge (Boundary Int
fId PlanarGraph s
pg) (HalfEdge Int
eId PlanarGraph s
pg') = String -> PlanarGraph s -> PlanarGraph s -> ST s () -> ST s ()
forall s a. String -> PlanarGraph s -> PlanarGraph s -> a -> a
eqCheck String
"faceSetHalfEdge" PlanarGraph s
pg PlanarGraph s
pg' (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
  -- trace ("faceSetHalfEdge: " ++ show (fId, eId)) $
  GrowVector s Int -> Int -> Int -> ST s ()
forall s v. GrowVector s v -> Int -> v -> ST s ()
writeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
pgBoundaryEdges PlanarGraph s
pg) Int
fId Int
eId
faceSetHalfEdge (Face Int
fId PlanarGraph s
pg) (HalfEdge Int
eId PlanarGraph s
pg') = String -> PlanarGraph s -> PlanarGraph s -> ST s () -> ST s ()
forall s a. String -> PlanarGraph s -> PlanarGraph s -> a -> a
eqCheck String
"faceSetHalfEdge" PlanarGraph s
pg PlanarGraph s
pg' (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
  GrowVector s Int -> Int -> Int -> ST s ()
forall s v. GrowVector s v -> Int -> v -> ST s ()
writeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
pgFaceEdges PlanarGraph s
pg) Int
fId Int
eId

-------------------------------------------------------------------------------
-- Mutation

-- | O(k) where @k@ is the number of edges in new face.
--
--   The two half-edges must be different, must have the same face, and may not be
--   consecutive. The first half-edge will stay in the original face. The second
--   half-edge will be in the newly created face.
--
-- ==== __Examples:__
--
-- @
-- 'pgFromFaces' [[0,1,2,3]]
-- @
--
-- <<docs/Data/PlanarGraph/planargraph-2506803680640023584.svg>>
--
-- @
-- do pg <- 'pgFromFaces' [[0,1,2,3]]
--    let he0 = 'halfEdgeFromId' 0 pg'
--        he4 = 'halfEdgeFromId' 4 pg'
--    'pgConnectVertices' he0 he4
-- @
--
-- <<docs/Data/PlanarGraph/planargraph-1902492848341357096.svg>>
pgConnectVertices :: HalfEdge s -> HalfEdge s -> ST s (Edge s)
pgConnectVertices :: HalfEdge s -> HalfEdge s -> ST s (Edge s)
pgConnectVertices HalfEdge s
e1 HalfEdge s
e2 =
  String
-> PlanarGraph s -> PlanarGraph s -> ST s (Edge s) -> ST s (Edge s)
forall s a. String -> PlanarGraph s -> PlanarGraph s -> a -> a
eqCheck String
"pgConnectVertices" (HalfEdge s -> PlanarGraph s
forall s. HalfEdge s -> PlanarGraph s
halfEdgePlanarGraph HalfEdge s
e1) (HalfEdge s -> PlanarGraph s
forall s. HalfEdge s -> PlanarGraph s
halfEdgePlanarGraph HalfEdge s
e2) (ST s (Edge s) -> ST s (Edge s)) -> ST s (Edge s) -> ST s (Edge s)
forall a b. (a -> b) -> a -> b
$ do
    let pg :: PlanarGraph s
pg = HalfEdge s -> PlanarGraph s
forall s. HalfEdge s -> PlanarGraph s
halfEdgePlanarGraph HalfEdge s
e1
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HalfEdge s
e1 HalfEdge s -> HalfEdge s -> Bool
forall a. Eq a => a -> a -> Bool
== HalfEdge s
e2) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ String -> ST s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Edges must be different"
    Face s
f1 <- HalfEdge s -> ST s (Face s)
forall s. HalfEdge s -> ST s (Face s)
halfEdgeFace HalfEdge s
e1
    Face s
f2 <- HalfEdge s -> ST s (Face s)
forall s. HalfEdge s -> ST s (Face s)
halfEdgeFace HalfEdge s
e2
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Face s
f1Face s -> Face s -> Bool
forall a. Eq a => a -> a -> Bool
==Face s
f2) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ String -> ST s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Faces must be the same"
    HalfEdge s
e1' <- HalfEdge s -> ST s (HalfEdge s)
forall s. HalfEdge s -> ST s (HalfEdge s)
halfEdgeNext HalfEdge s
e1
    HalfEdge s
e2' <- HalfEdge s -> ST s (HalfEdge s)
forall s. HalfEdge s -> ST s (HalfEdge s)
halfEdgeNext HalfEdge s
e2
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HalfEdge s
e1' HalfEdge s -> HalfEdge s -> Bool
forall a. Eq a => a -> a -> Bool
== HalfEdge s
e2 Bool -> Bool -> Bool
|| HalfEdge s
e2' HalfEdge s -> HalfEdge s -> Bool
forall a. Eq a => a -> a -> Bool
== HalfEdge s
e1) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ String -> ST s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Edges must not be consecutive"

    HalfEdge s
e1_prev <- HalfEdge s -> ST s (HalfEdge s)
forall s. HalfEdge s -> ST s (HalfEdge s)
halfEdgePrev HalfEdge s
e1
    HalfEdge s
e2_prev <- HalfEdge s -> ST s (HalfEdge s)
forall s. HalfEdge s -> ST s (HalfEdge s)
halfEdgePrev HalfEdge s
e2

    HalfEdge s
he <- PlanarGraph s -> ST s (HalfEdge s)
forall s. PlanarGraph s -> ST s (HalfEdge s)
halfEdgeNew PlanarGraph s
pg
    HalfEdge s -> Face s -> ST s ()
forall s. HalfEdge s -> Face s -> ST s ()
halfEdgeSetFace HalfEdge s
he Face s
f1
    let he' :: HalfEdge s
he' = HalfEdge s -> HalfEdge s
forall s. HalfEdge s -> HalfEdge s
halfEdgeTwin HalfEdge s
he
    
    HalfEdge s -> Vertex s -> ST s ()
forall s. HalfEdge s -> Vertex s -> ST s ()
halfEdgeSetVertex HalfEdge s
he (Vertex s -> ST s ()) -> ST s (Vertex s) -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HalfEdge s -> ST s (Vertex s)
forall s. HalfEdge s -> ST s (Vertex s)
halfEdgeVertex HalfEdge s
e2
    HalfEdge s -> Vertex s -> ST s ()
forall s. HalfEdge s -> Vertex s -> ST s ()
halfEdgeSetVertex HalfEdge s
he' (Vertex s -> ST s ()) -> ST s (Vertex s) -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HalfEdge s -> ST s (Vertex s)
forall s. HalfEdge s -> ST s (Vertex s)
halfEdgeVertex HalfEdge s
e1

    HalfEdge s -> HalfEdge s -> ST s ()
forall s. HalfEdge s -> HalfEdge s -> ST s ()
halfEdgeSetNext HalfEdge s
he HalfEdge s
e1
    HalfEdge s -> HalfEdge s -> ST s ()
forall s. HalfEdge s -> HalfEdge s -> ST s ()
halfEdgeSetPrev HalfEdge s
he HalfEdge s
e2_prev

    HalfEdge s -> HalfEdge s -> ST s ()
forall s. HalfEdge s -> HalfEdge s -> ST s ()
halfEdgeSetNext HalfEdge s
he' HalfEdge s
e2
    HalfEdge s -> HalfEdge s -> ST s ()
forall s. HalfEdge s -> HalfEdge s -> ST s ()
halfEdgeSetPrev HalfEdge s
he' (HalfEdge s -> ST s ()) -> ST s (HalfEdge s) -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HalfEdge s -> ST s (HalfEdge s)
forall s. HalfEdge s -> ST s (HalfEdge s)
halfEdgePrev HalfEdge s
e1

    HalfEdge s -> HalfEdge s -> ST s ()
forall s. HalfEdge s -> HalfEdge s -> ST s ()
halfEdgeSetPrev HalfEdge s
e1 HalfEdge s
he
    HalfEdge s -> HalfEdge s -> ST s ()
forall s. HalfEdge s -> HalfEdge s -> ST s ()
halfEdgeSetNext HalfEdge s
e2_prev HalfEdge s
he

    HalfEdge s -> HalfEdge s -> ST s ()
forall s. HalfEdge s -> HalfEdge s -> ST s ()
halfEdgeSetNext HalfEdge s
e1_prev HalfEdge s
he'
    HalfEdge s -> HalfEdge s -> ST s ()
forall s. HalfEdge s -> HalfEdge s -> ST s ()
halfEdgeSetPrev HalfEdge s
e2 HalfEdge s
he'

    Face s
face <- PlanarGraph s -> ST s (Face s)
forall s. PlanarGraph s -> ST s (Face s)
faceNew PlanarGraph s
pg
    Face s -> HalfEdge s -> ST s ()
forall s. Face s -> HalfEdge s -> ST s ()
faceSetHalfEdge Face s
face HalfEdge s
he'
    HalfEdge s -> (HalfEdge s -> ST s ()) -> ST s ()
forall s. HalfEdge s -> (HalfEdge s -> ST s ()) -> ST s ()
halfEdgeWithLoop HalfEdge s
he' (HalfEdge s -> Face s -> ST s ()
forall s. HalfEdge s -> Face s -> ST s ()
`halfEdgeSetFace` Face s
face)

    Edge s -> ST s (Edge s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Edge s -> ST s (Edge s)) -> Edge s -> ST s (Edge s)
forall a b. (a -> b) -> a -> b
$ Int -> PlanarGraph s -> Edge s
forall s. Int -> PlanarGraph s -> Edge s
Edge (HalfEdge s -> Int
forall s. HalfEdge s -> Int
halfEdgeToId HalfEdge s
he Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) PlanarGraph s
pg

-- pgInsertVertex :: HalfEdge s -> ST s (Vertex s)

-- pgRemoveEdge :: Edge s -> ST s ()
-- pgRemoveEdges :: [Edge s] -> ST s ()
-- pgRemoveVertex :: Vertex s -> ST s ()
-- pgRemoveBorder :: Edge s -> ST s ()

-------------------------------------------------------------------------------
-- Use cases

-- Use cases:
--   Triangulate polygon.
--     Create PlanarGraph from polygon. Holes have unique faces.
--     Update with [LineSegment 2 Vertex r]
--     Update Face ids at the end.
--   Cut planar graph in two.
--   Re-triangulate part of graph.
--   Mesh smoothing.
--     1. Keep vertex positions separate. Can update without changing the graph.
--     2. Swap edges. HalfEdge+Twin. Find next of each. Delete original half-edges.
--        Then insert half-edges to next.