{-# LANGUAGE RecordWildCards #-}
module Data.PlanarGraph.Immutable
(
PlanarGraph
, pgFromFaces
, pgFromFacesCV
, pgVertices
, pgEdges
, pgHalfEdges
, pgFaces
, pgBoundaries
, Vertex(..)
, vertexHalfEdge
, vertexIsInterior
, vertexIsBoundary
, vertexOutgoingHalfEdges
, vertexIncomingHalfEdges
, vertexNeighbours
, Edge(..)
, edgeHalfEdges
, HalfEdge(..)
, halfEdgeNext
, halfEdgePrev
, halfEdgeTwin
, halfEdgeNextOutgoing
, halfEdgeNextIncoming
, halfEdgeVertex
, halfEdgeTailVertex
, halfEdgeTipVertex
, halfEdgeFace
, halfEdgeIsInterior
, halfEdgeIsBoundary
, Face(..), FaceId
, faceMember
, faceId
, faceHalfEdge
, faceIsInterior
, faceIsBoundary
, faceHalfEdges
, faceBoundary
, pgMutate
, pgCreate
, pgThaw
, pgFreeze
, pgUnsafeThaw
, pgUnsafeFreeze
, tutteEmbedding
)
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
newtype HalfEdge = HalfEdge {HalfEdge -> Int
halfEdgeId :: Int}
deriving (HalfEdge -> HalfEdge -> Bool
(HalfEdge -> HalfEdge -> Bool)
-> (HalfEdge -> HalfEdge -> Bool) -> Eq HalfEdge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HalfEdge -> HalfEdge -> Bool
$c/= :: HalfEdge -> HalfEdge -> Bool
== :: HalfEdge -> HalfEdge -> Bool
$c== :: HalfEdge -> HalfEdge -> Bool
Eq, Int -> HalfEdge -> Int
HalfEdge -> Int
(Int -> HalfEdge -> Int) -> (HalfEdge -> Int) -> Hashable HalfEdge
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: HalfEdge -> Int
$chash :: HalfEdge -> Int
hashWithSalt :: Int -> HalfEdge -> Int
$chashWithSalt :: Int -> HalfEdge -> Int
Hashable)
instance Show HalfEdge where
showsPrec :: Int -> HalfEdge -> ShowS
showsPrec Int
d (HalfEdge Int
v) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"HalfEdge " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
v
instance Read HalfEdge where
readsPrec :: Int -> ReadS HalfEdge
readsPrec Int
d = Bool -> ReadS HalfEdge -> ReadS HalfEdge
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ReadS HalfEdge -> ReadS HalfEdge)
-> ReadS HalfEdge -> ReadS HalfEdge
forall a b. (a -> b) -> a -> b
$ \String
r ->
[ (Int -> HalfEdge
HalfEdge Int
v, String
t)
| (String
"HalfEdge", String
s) <- ReadS String
lex String
r, (Int
v, String
t) <- ReadS Int
forall a. Read a => ReadS a
reads String
s ]
where app_prec :: Int
app_prec = Int
10
newtype Edge = Edge {Edge -> Int
edgeId :: Int}
deriving (Edge -> Edge -> Bool
(Edge -> Edge -> Bool) -> (Edge -> Edge -> Bool) -> Eq Edge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Edge -> Edge -> Bool
$c/= :: Edge -> Edge -> Bool
== :: Edge -> Edge -> Bool
$c== :: Edge -> Edge -> Bool
Eq, Int -> Edge -> Int
Edge -> Int
(Int -> Edge -> Int) -> (Edge -> Int) -> Hashable Edge
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Edge -> Int
$chash :: Edge -> Int
hashWithSalt :: Int -> Edge -> Int
$chashWithSalt :: Int -> Edge -> Int
Hashable)
instance Show Edge where
showsPrec :: Int -> Edge -> ShowS
showsPrec Int
d (Edge Int
v) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"Edge " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
v
instance Read Edge where
readsPrec :: Int -> ReadS Edge
readsPrec Int
d = Bool -> ReadS Edge -> ReadS Edge
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ReadS Edge -> ReadS Edge) -> ReadS Edge -> ReadS Edge
forall a b. (a -> b) -> a -> b
$ \String
r ->
[ (Int -> Edge
Edge Int
v, String
t)
| (String
"Edge", String
s) <- ReadS String
lex String
r, (Int
v, String
t) <- ReadS Int
forall a. Read a => ReadS a
reads String
s ]
where app_prec :: Int
app_prec = Int
10
newtype Vertex = Vertex {Vertex -> Int
vertexId :: Int}
deriving (Vertex -> Vertex -> Bool
(Vertex -> Vertex -> Bool)
-> (Vertex -> Vertex -> Bool) -> Eq Vertex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vertex -> Vertex -> Bool
$c/= :: Vertex -> Vertex -> Bool
== :: Vertex -> Vertex -> Bool
$c== :: Vertex -> Vertex -> Bool
Eq, Int -> Vertex -> Int
Vertex -> Int
(Int -> Vertex -> Int) -> (Vertex -> Int) -> Hashable Vertex
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Vertex -> Int
$chash :: Vertex -> Int
hashWithSalt :: Int -> Vertex -> Int
$chashWithSalt :: Int -> Vertex -> Int
Hashable)
instance Show Vertex where
showsPrec :: Int -> Vertex -> ShowS
showsPrec Int
d (Vertex Int
v) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"Vertex " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
v
instance Read Vertex where
readsPrec :: Int -> ReadS Vertex
readsPrec Int
d = Bool -> ReadS Vertex -> ReadS Vertex
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ReadS Vertex -> ReadS Vertex) -> ReadS Vertex -> ReadS Vertex
forall a b. (a -> b) -> a -> b
$ \String
r ->
[ (Int -> Vertex
Vertex Int
v, String
t)
| (String
"Vertex", String
s) <- ReadS String
lex String
r, (Int
v, String
t) <- ReadS Int
forall a. Read a => ReadS a
reads String
s ]
where app_prec :: Int
app_prec = Int
10
data Face = Face FaceId | Boundary FaceId
deriving (Face -> Face -> Bool
(Face -> Face -> Bool) -> (Face -> Face -> Bool) -> Eq Face
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Face -> Face -> Bool
$c/= :: Face -> Face -> Bool
== :: Face -> Face -> Bool
$c== :: Face -> Face -> Bool
Eq, ReadPrec [Face]
ReadPrec Face
Int -> ReadS Face
ReadS [Face]
(Int -> ReadS Face)
-> ReadS [Face] -> ReadPrec Face -> ReadPrec [Face] -> Read Face
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Face]
$creadListPrec :: ReadPrec [Face]
readPrec :: ReadPrec Face
$creadPrec :: ReadPrec Face
readList :: ReadS [Face]
$creadList :: ReadS [Face]
readsPrec :: Int -> ReadS Face
$creadsPrec :: Int -> ReadS Face
Read, Int -> Face -> ShowS
[Face] -> ShowS
Face -> String
(Int -> Face -> ShowS)
-> (Face -> String) -> ([Face] -> ShowS) -> Show Face
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Face] -> ShowS
$cshowList :: [Face] -> ShowS
show :: Face -> String
$cshow :: Face -> String
showsPrec :: Int -> Face -> ShowS
$cshowsPrec :: Int -> Face -> ShowS
Show)
data PlanarGraph = PlanarGraph
{ PlanarGraph -> Vector Int
pgHalfEdgeNext :: !(Vector HalfEdgeId)
, PlanarGraph -> Vector Int
pgHalfEdgePrev :: !(Vector HalfEdgeId)
, PlanarGraph -> Vector Int
pgHalfEdgeVertex :: !(Vector VertexId)
, PlanarGraph -> Vector Int
pgHalfEdgeFace :: !(Vector FaceId)
, PlanarGraph -> Vector Int
pgVertexEdges :: !(Vector HalfEdgeId)
, PlanarGraph -> Vector Int
pgFaceEdges :: !(Vector HalfEdgeId)
, PlanarGraph -> Vector Int
pgBoundaryEdges :: !(Vector HalfEdgeId)
} deriving PlanarGraph -> PlanarGraph -> Bool
(PlanarGraph -> PlanarGraph -> Bool)
-> (PlanarGraph -> PlanarGraph -> Bool) -> Eq PlanarGraph
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlanarGraph -> PlanarGraph -> Bool
$c/= :: PlanarGraph -> PlanarGraph -> Bool
== :: PlanarGraph -> PlanarGraph -> Bool
$c== :: PlanarGraph -> PlanarGraph -> Bool
Eq
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.Immutable." 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
pgFromFaces :: [[VertexId]] -> PlanarGraph
pgFromFaces :: [[Int]] -> PlanarGraph
pgFromFaces = [CircularVector Int] -> PlanarGraph
pgFromFacesCV ([CircularVector Int] -> PlanarGraph)
-> ([[Int]] -> [CircularVector Int]) -> [[Int]] -> PlanarGraph
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] -> PlanarGraph
pgFromFacesCV :: [CircularVector Int] -> PlanarGraph
pgFromFacesCV [CircularVector Int]
faces = (forall s. ST s (PlanarGraph s)) -> PlanarGraph
pgCreate ((forall s. ST s (PlanarGraph s)) -> PlanarGraph)
-> (forall s. ST s (PlanarGraph s)) -> PlanarGraph
forall a b. (a -> b) -> a -> b
$ [CircularVector Int] -> ST s (PlanarGraph s)
forall s. [CircularVector Int] -> ST s (PlanarGraph s)
Mut.pgFromFacesCV [CircularVector Int]
faces
instance Hashable PlanarGraph where
hashWithSalt :: Int -> PlanarGraph -> Int
hashWithSalt Int
salt = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Int -> Int) -> (PlanarGraph -> Int) -> PlanarGraph -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlanarGraph -> Int
pgHash
hash :: PlanarGraph -> Int
hash = PlanarGraph -> Int
pgHash
pgHash :: PlanarGraph -> Int
pgHash :: PlanarGraph -> Int
pgHash PlanarGraph
pg =
let loop :: [Int] -> Int -> Int
loop [] Int
salt = Int
salt
loop (Int
edgeId:[Int]
rest) Int
salt =
let he :: HalfEdge
he = Int -> HalfEdge
HalfEdge (Int
edgeIdInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2)
vTail :: Vertex
vTail = HalfEdge -> PlanarGraph -> Vertex
halfEdgeTailVertex HalfEdge
he PlanarGraph
pg
vTip :: Vertex
vTip = HalfEdge -> PlanarGraph -> Vertex
halfEdgeTipVertex HalfEdge
he PlanarGraph
pg
in [Int] -> Int -> Int
loop [Int]
rest (Int -> (Vertex, Vertex) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Vertex
vTail, Vertex
vTip))
in Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Int -> Int
loop [Int
0..Vector Int -> Int
forall a. Vector a -> Int
Vector.length (PlanarGraph -> Vector Int
pgHalfEdgeNext PlanarGraph
pg)Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] Int
0
vertexCheck :: String -> Vertex -> PlanarGraph -> a -> a
vertexCheck :: String -> Vertex -> PlanarGraph -> a -> a
vertexCheck String
tag (Vertex Int
vId) PlanarGraph
pg a
_val
| Int
vId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Vector Int -> Int
forall a. Vector a -> Int
Vector.length (PlanarGraph -> Vector Int
pgVertexEdges PlanarGraph
pg) Bool -> Bool -> Bool
|| Int
vId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
String -> String -> a
forall a. String -> String -> a
panic String
tag (String
"Out-of-bounds vertex access: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
vId)
| Bool -> Bool
not (HalfEdge -> Bool
halfEdgeIsValid (Int -> HalfEdge
HalfEdge (PlanarGraph -> Vector Int
pgVertexEdges PlanarGraph
pg Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
Vector.! Int
vId))) =
String -> String -> a
forall a. String -> String -> a
panic String
tag (String
"Tried to access deleted vertex: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
vId)
vertexCheck String
_tag Vertex
_face PlanarGraph
_pg a
val = a
val
pgVertices :: PlanarGraph -> [Vertex]
pgVertices :: PlanarGraph -> [Vertex]
pgVertices PlanarGraph
pg =
[ Int -> Vertex
Vertex Int
v
| Int
v <- [Int
0 .. Vector Int -> Int
forall a. Vector a -> Int
Vector.length (PlanarGraph -> Vector Int
pgVertexEdges PlanarGraph
pg)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 ]
, HalfEdge -> Bool
halfEdgeIsValid (Int -> HalfEdge
HalfEdge (Int -> HalfEdge) -> Int -> HalfEdge
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgVertexEdges PlanarGraph
pg Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
Vector.! Int
v)
]
vertexHalfEdge :: Vertex -> PlanarGraph -> HalfEdge
vertexHalfEdge :: Vertex -> PlanarGraph -> HalfEdge
vertexHalfEdge Vertex
vertex PlanarGraph
pg | String -> Vertex -> PlanarGraph -> Bool -> Bool
forall a. String -> Vertex -> PlanarGraph -> a -> a
vertexCheck String
"vertexHalfEdge" Vertex
vertex PlanarGraph
pg Bool
False = HalfEdge
forall a. HasCallStack => a
undefined
vertexHalfEdge (Vertex Int
vId) PlanarGraph
pg = Int -> HalfEdge
HalfEdge (Int -> HalfEdge) -> Int -> HalfEdge
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgVertexEdges PlanarGraph
pg Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
Vector.! Int
vId
vertexIsBoundary :: Vertex -> PlanarGraph -> Bool
vertexIsBoundary :: Vertex -> PlanarGraph -> Bool
vertexIsBoundary Vertex
vertex PlanarGraph
pg | String -> Vertex -> PlanarGraph -> Bool -> Bool
forall a. String -> Vertex -> PlanarGraph -> a -> a
vertexCheck String
"vertexIsBoundary" Vertex
vertex PlanarGraph
pg Bool
False = Bool
forall a. HasCallStack => a
undefined
vertexIsBoundary Vertex
vertex PlanarGraph
pg =
Face -> Bool
faceIsBoundary (Face -> Bool) -> Face -> Bool
forall a b. (a -> b) -> a -> b
$ HalfEdge -> PlanarGraph -> Face
halfEdgeFace (HalfEdge -> HalfEdge
halfEdgeTwin (HalfEdge -> HalfEdge) -> HalfEdge -> HalfEdge
forall a b. (a -> b) -> a -> b
$ Vertex -> PlanarGraph -> HalfEdge
vertexHalfEdge Vertex
vertex PlanarGraph
pg) PlanarGraph
pg
vertexIsInterior :: Vertex -> PlanarGraph -> Bool
vertexIsInterior :: Vertex -> PlanarGraph -> Bool
vertexIsInterior Vertex
vertex PlanarGraph
pg | String -> Vertex -> PlanarGraph -> Bool -> Bool
forall a. String -> Vertex -> PlanarGraph -> a -> a
vertexCheck String
"vertexIsInterior" Vertex
vertex PlanarGraph
pg Bool
False = Bool
forall a. HasCallStack => a
undefined
vertexIsInterior Vertex
vertex PlanarGraph
pg = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Vertex -> PlanarGraph -> Bool
vertexIsBoundary Vertex
vertex PlanarGraph
pg
vertexOutgoingHalfEdges :: Vertex -> PlanarGraph -> [HalfEdge]
vertexOutgoingHalfEdges :: Vertex -> PlanarGraph -> [HalfEdge]
vertexOutgoingHalfEdges Vertex
vertex PlanarGraph
pg | String -> Vertex -> PlanarGraph -> Bool -> Bool
forall a. String -> Vertex -> PlanarGraph -> a -> a
vertexCheck String
"vertexOutgoingHalfEdges" Vertex
vertex PlanarGraph
pg Bool
False = [HalfEdge]
forall a. HasCallStack => a
undefined
vertexOutgoingHalfEdges Vertex
vertex PlanarGraph
pg = HalfEdge
first HalfEdge -> [HalfEdge] -> [HalfEdge]
forall a. a -> [a] -> [a]
: (forall b. (HalfEdge -> b -> b) -> b -> b) -> [HalfEdge]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (HalfEdge -> (HalfEdge -> b -> b) -> b -> b
forall b. HalfEdge -> (HalfEdge -> b -> b) -> b -> b
g (HalfEdge -> HalfEdge
advance HalfEdge
first))
where
advance :: HalfEdge -> HalfEdge
advance HalfEdge
he = HalfEdge -> PlanarGraph -> HalfEdge
halfEdgeNext (HalfEdge -> HalfEdge
halfEdgeTwin HalfEdge
he) PlanarGraph
pg
first :: HalfEdge
first = Vertex -> PlanarGraph -> HalfEdge
vertexHalfEdge Vertex
vertex PlanarGraph
pg
g :: HalfEdge -> (HalfEdge -> b -> b) -> b -> b
g :: HalfEdge -> (HalfEdge -> b -> b) -> b -> b
g HalfEdge
he HalfEdge -> b -> b
cons b
nil
| HalfEdge
he HalfEdge -> HalfEdge -> Bool
forall a. Eq a => a -> a -> Bool
== HalfEdge
first = b
nil
| Bool
otherwise = HalfEdge -> b -> b
cons HalfEdge
he (HalfEdge -> (HalfEdge -> b -> b) -> b -> b
forall b. HalfEdge -> (HalfEdge -> b -> b) -> b -> b
g (HalfEdge -> HalfEdge
advance HalfEdge
he) HalfEdge -> b -> b
cons b
nil)
vertexIncomingHalfEdges :: Vertex -> PlanarGraph -> [HalfEdge]
vertexIncomingHalfEdges :: Vertex -> PlanarGraph -> [HalfEdge]
vertexIncomingHalfEdges Vertex
vertex PlanarGraph
pg | String -> Vertex -> PlanarGraph -> Bool -> Bool
forall a. String -> Vertex -> PlanarGraph -> a -> a
vertexCheck String
"vertexIncomingHalfEdges" Vertex
vertex PlanarGraph
pg Bool
False = [HalfEdge]
forall a. HasCallStack => a
undefined
vertexIncomingHalfEdges Vertex
vertex PlanarGraph
pg = (HalfEdge -> HalfEdge) -> [HalfEdge] -> [HalfEdge]
forall a b. (a -> b) -> [a] -> [b]
map HalfEdge -> HalfEdge
halfEdgeTwin ([HalfEdge] -> [HalfEdge]) -> [HalfEdge] -> [HalfEdge]
forall a b. (a -> b) -> a -> b
$ Vertex -> PlanarGraph -> [HalfEdge]
vertexOutgoingHalfEdges Vertex
vertex PlanarGraph
pg
vertexNeighbours :: Vertex -> PlanarGraph -> [Vertex]
vertexNeighbours :: Vertex -> PlanarGraph -> [Vertex]
vertexNeighbours Vertex
vertex PlanarGraph
pg | String -> Vertex -> PlanarGraph -> Bool -> Bool
forall a. String -> Vertex -> PlanarGraph -> a -> a
vertexCheck String
"vertexNeighbours" Vertex
vertex PlanarGraph
pg Bool
False = [Vertex]
forall a. HasCallStack => a
undefined
vertexNeighbours Vertex
vertex PlanarGraph
pg = (HalfEdge -> Vertex) -> [HalfEdge] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map (HalfEdge -> PlanarGraph -> Vertex
`halfEdgeVertex` PlanarGraph
pg) ([HalfEdge] -> [Vertex]) -> [HalfEdge] -> [Vertex]
forall a b. (a -> b) -> a -> b
$ Vertex -> PlanarGraph -> [HalfEdge]
vertexIncomingHalfEdges Vertex
vertex PlanarGraph
pg
pgEdges :: PlanarGraph -> [Edge]
pgEdges :: PlanarGraph -> [Edge]
pgEdges PlanarGraph
pg =
[ Int -> Edge
Edge Int
e
| Int
e <- [Int
0 .. Vector Int -> Int
forall a. Vector a -> Int
Vector.length (PlanarGraph -> Vector Int
pgHalfEdgeNext PlanarGraph
pg) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
, let he :: Int
he = Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2
, HalfEdge -> Bool
halfEdgeIsValid (Int -> HalfEdge
HalfEdge Int
he)
]
edgeHalfEdges :: Edge -> (HalfEdge, HalfEdge)
edgeHalfEdges :: Edge -> (HalfEdge, HalfEdge)
edgeHalfEdges (Edge Int
e) = (Int -> HalfEdge
HalfEdge (Int -> HalfEdge) -> Int -> HalfEdge
forall a b. (a -> b) -> a -> b
$ Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2, Int -> HalfEdge
HalfEdge (Int -> HalfEdge) -> Int -> HalfEdge
forall a b. (a -> b) -> a -> b
$ Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
halfEdgeCheck :: String -> HalfEdgeId -> PlanarGraph -> a -> a
halfEdgeCheck :: String -> Int -> PlanarGraph -> a -> a
halfEdgeCheck String
tag Int
eId PlanarGraph
pg a
_val
| Int
eId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Vector Int -> Int
forall a. Vector a -> Int
Vector.length (PlanarGraph -> Vector Int
pgHalfEdgeVertex PlanarGraph
pg) Bool -> Bool -> Bool
|| Int
eId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
String -> String -> a
forall a. String -> String -> a
panic String
tag (String
"Out-of-bounds half-edge access: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
eId)
| PlanarGraph -> Vector Int
pgHalfEdgeVertex PlanarGraph
pg Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
Vector.! Int
eId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
String -> String -> a
forall a. String -> String -> a
panic String
tag (String
"Tried to access deleted half-edge: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
eId)
halfEdgeCheck String
_tag Int
_face PlanarGraph
_pg a
val = a
val
pgHalfEdges :: PlanarGraph -> [HalfEdge]
pgHalfEdges :: PlanarGraph -> [HalfEdge]
pgHalfEdges PlanarGraph
pg =
[ HalfEdge
he
| HalfEdge
he <- (Int -> HalfEdge) -> [Int] -> [HalfEdge]
forall a b. (a -> b) -> [a] -> [b]
map Int -> HalfEdge
HalfEdge [Int
0 .. Vector Int -> Int
forall a. Vector a -> Int
Vector.length (PlanarGraph -> Vector Int
pgHalfEdgeNext PlanarGraph
pg)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 ]
, HalfEdge -> Bool
halfEdgeIsValid HalfEdge
he
]
halfEdgeIsValid :: HalfEdge -> Bool
halfEdgeIsValid :: HalfEdge -> Bool
halfEdgeIsValid (HalfEdge Int
eId) = Int
eId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
halfEdgeNext :: HalfEdge -> PlanarGraph -> HalfEdge
halfEdgeNext :: HalfEdge -> PlanarGraph -> HalfEdge
halfEdgeNext (HalfEdge Int
eId) PlanarGraph
pg = String -> Int -> PlanarGraph -> HalfEdge -> HalfEdge
forall a. String -> Int -> PlanarGraph -> a -> a
halfEdgeCheck String
"halfEdgeNext" Int
eId PlanarGraph
pg (HalfEdge -> HalfEdge) -> HalfEdge -> HalfEdge
forall a b. (a -> b) -> a -> b
$
Int -> HalfEdge
HalfEdge (Int -> HalfEdge) -> Int -> HalfEdge
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgHalfEdgeNext PlanarGraph
pg Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
Vector.! Int
eId
halfEdgePrev :: HalfEdge -> PlanarGraph -> HalfEdge
halfEdgePrev :: HalfEdge -> PlanarGraph -> HalfEdge
halfEdgePrev (HalfEdge Int
eId) PlanarGraph
pg = String -> Int -> PlanarGraph -> HalfEdge -> HalfEdge
forall a. String -> Int -> PlanarGraph -> a -> a
halfEdgeCheck String
"halfEdgePrev" Int
eId PlanarGraph
pg (HalfEdge -> HalfEdge) -> HalfEdge -> HalfEdge
forall a b. (a -> b) -> a -> b
$
Int -> HalfEdge
HalfEdge (Int -> HalfEdge) -> Int -> HalfEdge
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgHalfEdgePrev PlanarGraph
pg Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
Vector.! Int
eId
halfEdgeNextOutgoing :: HalfEdge -> PlanarGraph -> HalfEdge
halfEdgeNextOutgoing :: HalfEdge -> PlanarGraph -> HalfEdge
halfEdgeNextOutgoing HalfEdge
e PlanarGraph
pg = String -> Int -> PlanarGraph -> HalfEdge -> HalfEdge
forall a. String -> Int -> PlanarGraph -> a -> a
halfEdgeCheck String
"halfEdgeNextOutgoing" (HalfEdge -> Int
halfEdgeId HalfEdge
e) PlanarGraph
pg (HalfEdge -> HalfEdge) -> HalfEdge -> HalfEdge
forall a b. (a -> b) -> a -> b
$
HalfEdge -> PlanarGraph -> HalfEdge
halfEdgeNext (HalfEdge -> HalfEdge
halfEdgeTwin HalfEdge
e) PlanarGraph
pg
halfEdgeNextIncoming :: HalfEdge -> PlanarGraph -> HalfEdge
halfEdgeNextIncoming :: HalfEdge -> PlanarGraph -> HalfEdge
halfEdgeNextIncoming HalfEdge
e PlanarGraph
pg = String -> Int -> PlanarGraph -> HalfEdge -> HalfEdge
forall a. String -> Int -> PlanarGraph -> a -> a
halfEdgeCheck String
"halfEdgeNextIncoming" (HalfEdge -> Int
halfEdgeId HalfEdge
e) PlanarGraph
pg (HalfEdge -> HalfEdge) -> HalfEdge -> HalfEdge
forall a b. (a -> b) -> a -> b
$
HalfEdge -> HalfEdge
halfEdgeTwin (HalfEdge -> PlanarGraph -> HalfEdge
halfEdgeNext HalfEdge
e PlanarGraph
pg)
halfEdgeTwin :: HalfEdge -> HalfEdge
halfEdgeTwin :: HalfEdge -> HalfEdge
halfEdgeTwin (HalfEdge Int
idx) = Int -> HalfEdge
HalfEdge (Int
idx Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` Int
1)
halfEdgeVertex :: HalfEdge -> PlanarGraph -> Vertex
halfEdgeVertex :: HalfEdge -> PlanarGraph -> Vertex
halfEdgeVertex (HalfEdge Int
idx) PlanarGraph
pg = String -> Int -> PlanarGraph -> Vertex -> Vertex
forall a. String -> Int -> PlanarGraph -> a -> a
halfEdgeCheck String
"halfEdgeVertex" Int
idx PlanarGraph
pg (Vertex -> Vertex) -> Vertex -> Vertex
forall a b. (a -> b) -> a -> b
$
Int -> Vertex
Vertex (Int -> Vertex) -> Int -> Vertex
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgHalfEdgeVertex PlanarGraph
pg Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
Vector.! Int
idx
halfEdgeTailVertex :: HalfEdge -> PlanarGraph -> Vertex
halfEdgeTailVertex :: HalfEdge -> PlanarGraph -> Vertex
halfEdgeTailVertex HalfEdge
e PlanarGraph
pg = HalfEdge -> PlanarGraph -> Vertex
halfEdgeVertex HalfEdge
e PlanarGraph
pg
halfEdgeTipVertex :: HalfEdge -> PlanarGraph -> Vertex
halfEdgeTipVertex :: HalfEdge -> PlanarGraph -> Vertex
halfEdgeTipVertex HalfEdge
e PlanarGraph
pg = HalfEdge -> PlanarGraph -> Vertex
halfEdgeVertex (HalfEdge -> HalfEdge
halfEdgeTwin HalfEdge
e) PlanarGraph
pg
halfEdgeFace :: HalfEdge -> PlanarGraph -> Face
halfEdgeFace :: HalfEdge -> PlanarGraph -> Face
halfEdgeFace (HalfEdge Int
eId) PlanarGraph
pg = String -> Int -> PlanarGraph -> Face -> Face
forall a. String -> Int -> PlanarGraph -> a -> a
halfEdgeCheck String
"halfEdgeFace" Int
eId PlanarGraph
pg (Face -> Face) -> Face -> Face
forall a b. (a -> b) -> a -> b
$
Int -> Face
faceFromId (Int -> Face) -> Int -> Face
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgHalfEdgeFace PlanarGraph
pg Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
Vector.! Int
eId
halfEdgeIsBoundary :: HalfEdge -> PlanarGraph -> Bool
halfEdgeIsBoundary :: HalfEdge -> PlanarGraph -> Bool
halfEdgeIsBoundary HalfEdge
edge PlanarGraph
pg = String -> Int -> PlanarGraph -> Bool -> Bool
forall a. String -> Int -> PlanarGraph -> a -> a
halfEdgeCheck String
"halfEdgeIsBoundary" (HalfEdge -> Int
halfEdgeId HalfEdge
edge) PlanarGraph
pg (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
Face -> Bool
faceIsBoundary (Face -> Bool) -> Face -> Bool
forall a b. (a -> b) -> a -> b
$ HalfEdge -> PlanarGraph -> Face
halfEdgeFace HalfEdge
edge PlanarGraph
pg
halfEdgeIsInterior :: HalfEdge -> PlanarGraph -> Bool
halfEdgeIsInterior :: HalfEdge -> PlanarGraph -> Bool
halfEdgeIsInterior HalfEdge
edge PlanarGraph
pg = String -> Int -> PlanarGraph -> Bool -> Bool
forall a. String -> Int -> PlanarGraph -> a -> a
halfEdgeCheck String
"halfEdgeIsInterior" (HalfEdge -> Int
halfEdgeId HalfEdge
edge) PlanarGraph
pg (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
Face -> Bool
faceIsInterior (Face -> Bool) -> Face -> Bool
forall a b. (a -> b) -> a -> b
$ HalfEdge -> PlanarGraph -> Face
halfEdgeFace HalfEdge
edge PlanarGraph
pg
pgFaces :: PlanarGraph -> [Face]
pgFaces :: PlanarGraph -> [Face]
pgFaces PlanarGraph
pg =
[ Int -> Face
Face Int
fId
| Int
fId <- [Int
0 .. Vector Int -> Int
forall a. Vector a -> Int
Vector.length (PlanarGraph -> Vector Int
pgFaceEdges PlanarGraph
pg)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 ]
, HalfEdge -> Bool
halfEdgeIsValid (Face -> PlanarGraph -> HalfEdge
faceHalfEdge (Int -> Face
Face Int
fId) PlanarGraph
pg)
]
pgBoundaries :: PlanarGraph -> [Face]
pgBoundaries :: PlanarGraph -> [Face]
pgBoundaries PlanarGraph
pg =
[ Int -> Face
Boundary Int
fId
| Int
fId <- [Int
0 .. Vector Int -> Int
forall a. Vector a -> Int
Vector.length (PlanarGraph -> Vector Int
pgBoundaryEdges PlanarGraph
pg)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 ]
, HalfEdge -> Bool
halfEdgeIsValid (Face -> PlanarGraph -> HalfEdge
faceHalfEdge (Int -> Face
Boundary Int
fId) PlanarGraph
pg)
]
faceCheck :: String -> Face -> PlanarGraph -> a -> a
faceCheck :: String -> Face -> PlanarGraph -> a -> a
faceCheck String
tag (Face Int
fId) PlanarGraph
pg a
_val
| Int
fId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Vector Int -> Int
forall a. Vector a -> Int
Vector.length (PlanarGraph -> Vector Int
pgFaceEdges PlanarGraph
pg) Bool -> Bool -> Bool
|| Int
fId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
String -> String -> a
forall a. String -> String -> a
panic String
tag (String
"Out-of-bounds face access: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
fId)
| PlanarGraph -> Vector Int
pgFaceEdges PlanarGraph
pg Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
Vector.! Int
fId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
String -> String -> a
forall a. String -> String -> a
panic String
tag (String
"Tried to access deleted face: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
fId)
faceCheck String
tag (Boundary Int
fId) PlanarGraph
pg a
_val
| Int
fId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Vector Int -> Int
forall a. Vector a -> Int
Vector.length (PlanarGraph -> Vector Int
pgBoundaryEdges PlanarGraph
pg) Bool -> Bool -> Bool
|| Int
fId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
String -> String -> a
forall a. String -> String -> a
panic String
tag (String
"Out-of-bounds boundary access: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
fId)
| PlanarGraph -> Vector Int
pgBoundaryEdges PlanarGraph
pg Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
Vector.! Int
fId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
String -> String -> a
forall a. String -> String -> a
panic String
tag (String
"Tried to access deleted boundary: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
fId)
faceCheck String
_tag Face
_face PlanarGraph
_pg a
val = a
val
faceMember :: Face -> PlanarGraph -> Bool
faceMember :: Face -> PlanarGraph -> Bool
faceMember face :: Face
face@(Face Int
fId) PlanarGraph
pg =
Int
fId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Vector Int -> Int
forall a. Vector a -> Int
Vector.length (PlanarGraph -> Vector Int
pgFaceEdges PlanarGraph
pg) Bool -> Bool -> Bool
&&
Int
fId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&&
HalfEdge -> Bool
halfEdgeIsValid (Face -> PlanarGraph -> HalfEdge
faceHalfEdge Face
face PlanarGraph
pg)
faceMember face :: Face
face@(Boundary Int
fId) PlanarGraph
pg =
Int
fId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Vector Int -> Int
forall a. Vector a -> Int
Vector.length (PlanarGraph -> Vector Int
pgFaceEdges PlanarGraph
pg) Bool -> Bool -> Bool
&&
Int
fId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&&
HalfEdge -> Bool
halfEdgeIsValid (Face -> PlanarGraph -> HalfEdge
faceHalfEdge Face
face PlanarGraph
pg)
faceFromId :: FaceId -> Face
faceFromId :: Int -> Face
faceFromId Int
fId | Int
fId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> Face
Boundary (Int -> Int
forall a. Num a => a -> a
negate Int
fId Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
faceFromId Int
fId = Int -> Face
Face Int
fId
faceId :: Face -> FaceId
faceId :: Face -> Int
faceId (Face Int
fId) = Int
fId
faceId (Boundary Int
fId) = Int -> Int
forall a. Num a => a -> a
negate Int
fId Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
faceHalfEdge :: Face -> PlanarGraph -> HalfEdge
faceHalfEdge :: Face -> PlanarGraph -> HalfEdge
faceHalfEdge Face
face PlanarGraph
pg = String -> Face -> PlanarGraph -> HalfEdge -> HalfEdge
forall a. String -> Face -> PlanarGraph -> a -> a
faceCheck String
"faceHalfEdge" Face
face PlanarGraph
pg (HalfEdge -> HalfEdge) -> HalfEdge -> HalfEdge
forall a b. (a -> b) -> a -> b
$
case Face
face of
Face Int
fId -> Int -> HalfEdge
HalfEdge (Int -> HalfEdge) -> Int -> HalfEdge
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgFaceEdges PlanarGraph
pg Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
Vector.! Int
fId
Boundary Int
fId -> Int -> HalfEdge
HalfEdge (Int -> HalfEdge) -> Int -> HalfEdge
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgBoundaryEdges PlanarGraph
pg Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
Vector.! Int
fId
faceIsInterior :: Face -> Bool
faceIsInterior :: Face -> Bool
faceIsInterior = Bool -> Bool
not (Bool -> Bool) -> (Face -> Bool) -> Face -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Face -> Bool
faceIsBoundary
faceIsBoundary :: Face -> Bool
faceIsBoundary :: Face -> Bool
faceIsBoundary Face{} = Bool
False
faceIsBoundary Boundary{} = Bool
True
faceHalfEdges :: Face -> PlanarGraph -> [HalfEdge]
faceHalfEdges :: Face -> PlanarGraph -> [HalfEdge]
faceHalfEdges Face
face PlanarGraph
pg | String -> Face -> PlanarGraph -> Bool -> Bool
forall a. String -> Face -> PlanarGraph -> a -> a
faceCheck String
"faceHalfEdges" Face
face PlanarGraph
pg Bool
False = [HalfEdge]
forall a. HasCallStack => a
undefined
faceHalfEdges Face
face PlanarGraph
pg
| Face -> Bool
faceIsBoundary Face
face = HalfEdge
first HalfEdge -> [HalfEdge] -> [HalfEdge]
forall a. a -> [a] -> [a]
: (forall b. (HalfEdge -> b -> b) -> b -> b) -> [HalfEdge]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build ((HalfEdge -> PlanarGraph -> HalfEdge)
-> HalfEdge -> (HalfEdge -> b -> b) -> b -> b
forall b.
(HalfEdge -> PlanarGraph -> HalfEdge)
-> HalfEdge -> (HalfEdge -> b -> b) -> b -> b
worker HalfEdge -> PlanarGraph -> HalfEdge
halfEdgeNext (HalfEdge -> PlanarGraph -> HalfEdge
halfEdgeNext HalfEdge
first PlanarGraph
pg))
| Bool
otherwise = HalfEdge
first HalfEdge -> [HalfEdge] -> [HalfEdge]
forall a. a -> [a] -> [a]
: (forall b. (HalfEdge -> b -> b) -> b -> b) -> [HalfEdge]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build ((HalfEdge -> PlanarGraph -> HalfEdge)
-> HalfEdge -> (HalfEdge -> b -> b) -> b -> b
forall b.
(HalfEdge -> PlanarGraph -> HalfEdge)
-> HalfEdge -> (HalfEdge -> b -> b) -> b -> b
worker HalfEdge -> PlanarGraph -> HalfEdge
halfEdgePrev (HalfEdge -> PlanarGraph -> HalfEdge
halfEdgePrev HalfEdge
first PlanarGraph
pg))
where
first :: HalfEdge
first = Face -> PlanarGraph -> HalfEdge
faceHalfEdge Face
face PlanarGraph
pg
worker :: (HalfEdge -> PlanarGraph -> HalfEdge) -> HalfEdge -> (HalfEdge -> b -> b) -> b -> b
worker :: (HalfEdge -> PlanarGraph -> HalfEdge)
-> HalfEdge -> (HalfEdge -> b -> b) -> b -> b
worker HalfEdge -> PlanarGraph -> HalfEdge
advance HalfEdge
he HalfEdge -> b -> b
cons b
nil
| HalfEdge
he HalfEdge -> HalfEdge -> Bool
forall a. Eq a => a -> a -> Bool
== HalfEdge
first = b
nil
| Bool
otherwise = HalfEdge -> b -> b
cons HalfEdge
he ((HalfEdge -> PlanarGraph -> HalfEdge)
-> HalfEdge -> (HalfEdge -> b -> b) -> b -> b
forall b.
(HalfEdge -> PlanarGraph -> HalfEdge)
-> HalfEdge -> (HalfEdge -> b -> b) -> b -> b
worker HalfEdge -> PlanarGraph -> HalfEdge
advance (HalfEdge -> PlanarGraph -> HalfEdge
advance HalfEdge
he PlanarGraph
pg) HalfEdge -> b -> b
cons b
nil)
faceBoundary :: Face -> PlanarGraph -> [Vertex]
faceBoundary :: Face -> PlanarGraph -> [Vertex]
faceBoundary Face
face PlanarGraph
pg = String -> Face -> PlanarGraph -> [Vertex] -> [Vertex]
forall a. String -> Face -> PlanarGraph -> a -> a
faceCheck String
"faceBoundary" Face
face PlanarGraph
pg ([Vertex] -> [Vertex]) -> [Vertex] -> [Vertex]
forall a b. (a -> b) -> a -> b
$
(HalfEdge -> Vertex) -> [HalfEdge] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map (HalfEdge -> PlanarGraph -> Vertex
`halfEdgeVertex` PlanarGraph
pg) ([HalfEdge] -> [Vertex]) -> [HalfEdge] -> [Vertex]
forall a b. (a -> b) -> a -> b
$ Face -> PlanarGraph -> [HalfEdge]
faceHalfEdges Face
face PlanarGraph
pg
pgMutate :: PlanarGraph -> (forall s. Mut.PlanarGraph s -> ST s ()) -> PlanarGraph
pgMutate :: PlanarGraph -> (forall s. PlanarGraph s -> ST s ()) -> PlanarGraph
pgMutate PlanarGraph
pg forall s. PlanarGraph s -> ST s ()
action = (forall s. ST s PlanarGraph) -> PlanarGraph
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s PlanarGraph) -> PlanarGraph)
-> (forall s. ST s PlanarGraph) -> PlanarGraph
forall a b. (a -> b) -> a -> b
$ do
PlanarGraph s
mutPG <- PlanarGraph -> ST s (PlanarGraph s)
forall s. PlanarGraph -> ST s (PlanarGraph s)
pgThaw PlanarGraph
pg
PlanarGraph s -> ST s ()
forall s. PlanarGraph s -> ST s ()
action PlanarGraph s
mutPG
PlanarGraph s -> ST s PlanarGraph
forall s. PlanarGraph s -> ST s PlanarGraph
pgUnsafeFreeze PlanarGraph s
mutPG
pgCreate :: (forall s. ST s (Mut.PlanarGraph s)) -> PlanarGraph
pgCreate :: (forall s. ST s (PlanarGraph s)) -> PlanarGraph
pgCreate forall s. ST s (PlanarGraph s)
action = (forall s. ST s PlanarGraph) -> PlanarGraph
forall a. (forall s. ST s a) -> a
runST (ST s (PlanarGraph s)
forall s. ST s (PlanarGraph s)
action ST s (PlanarGraph s)
-> (PlanarGraph s -> ST s PlanarGraph) -> ST s PlanarGraph
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PlanarGraph s -> ST s PlanarGraph
forall s. PlanarGraph s -> ST s PlanarGraph
pgUnsafeFreeze)
pgThaw :: PlanarGraph -> ST s (Mut.PlanarGraph s)
pgThaw :: PlanarGraph -> ST s (PlanarGraph s)
pgThaw PlanarGraph
pg = do
STRef s Int
pgNextHalfEdgeId <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef (Int -> ST s (STRef s Int)) -> Int -> ST s (STRef s Int)
forall a b. (a -> b) -> a -> b
$ Vector Int -> Int
forall a. Vector a -> Int
Vector.length (PlanarGraph -> Vector Int
pgHalfEdgeNext PlanarGraph
pg) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
STRef s Int
pgNextVertexId <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef (Int -> ST s (STRef s Int)) -> Int -> ST s (STRef s Int)
forall a b. (a -> b) -> a -> b
$ Vector Int -> Int
forall a. Vector a -> Int
Vector.length (Vector Int -> Int) -> Vector Int -> Int
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgVertexEdges PlanarGraph
pg
STRef s Int
pgNextFaceId <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef (Int -> ST s (STRef s Int)) -> Int -> ST s (STRef s Int)
forall a b. (a -> b) -> a -> b
$ Vector Int -> Int
forall a. Vector a -> Int
Vector.length (Vector Int -> Int) -> Vector Int -> Int
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgFaceEdges PlanarGraph
pg
STRef s Int
pgNextBoundaryId <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef (Int -> ST s (STRef s Int)) -> Int -> ST s (STRef s Int)
forall a b. (a -> b) -> a -> b
$ Vector Int -> Int
forall a. Vector a -> Int
Vector.length (Vector Int -> Int) -> Vector Int -> Int
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgBoundaryEdges PlanarGraph
pg
GrowVector s Int
pgHalfEdgeNext <- Vector Int -> ST s (GrowVector s Int)
forall v s. Vector v -> ST s (GrowVector s v)
Mut.thawVector (Vector Int -> ST s (GrowVector s Int))
-> Vector Int -> ST s (GrowVector s Int)
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgHalfEdgeNext PlanarGraph
pg
GrowVector s Int
pgHalfEdgePrev <- Vector Int -> ST s (GrowVector s Int)
forall v s. Vector v -> ST s (GrowVector s v)
Mut.thawVector (Vector Int -> ST s (GrowVector s Int))
-> Vector Int -> ST s (GrowVector s Int)
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgHalfEdgePrev PlanarGraph
pg
GrowVector s Int
pgHalfEdgeFace <- Vector Int -> ST s (GrowVector s Int)
forall v s. Vector v -> ST s (GrowVector s v)
Mut.thawVector (Vector Int -> ST s (GrowVector s Int))
-> Vector Int -> ST s (GrowVector s Int)
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgHalfEdgeFace PlanarGraph
pg
GrowVector s Int
pgHalfEdgeVertex <- Vector Int -> ST s (GrowVector s Int)
forall v s. Vector v -> ST s (GrowVector s v)
Mut.thawVector (Vector Int -> ST s (GrowVector s Int))
-> Vector Int -> ST s (GrowVector s Int)
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgHalfEdgeVertex PlanarGraph
pg
GrowVector s Int
pgVertexEdges <- Vector Int -> ST s (GrowVector s Int)
forall v s. Vector v -> ST s (GrowVector s v)
Mut.thawVector (Vector Int -> ST s (GrowVector s Int))
-> Vector Int -> ST s (GrowVector s Int)
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgVertexEdges PlanarGraph
pg
GrowVector s Int
pgFaceEdges <- Vector Int -> ST s (GrowVector s Int)
forall v s. Vector v -> ST s (GrowVector s v)
Mut.thawVector (Vector Int -> ST s (GrowVector s Int))
-> Vector Int -> ST s (GrowVector s Int)
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgFaceEdges PlanarGraph
pg
GrowVector s Int
pgBoundaryEdges <- Vector Int -> ST s (GrowVector s Int)
forall v s. Vector v -> ST s (GrowVector s v)
Mut.thawVector (Vector Int -> ST s (GrowVector s Int))
-> Vector Int -> ST s (GrowVector s Int)
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgBoundaryEdges PlanarGraph
pg
PlanarGraph s -> ST s (PlanarGraph s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PlanarGraph :: 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
Mut.PlanarGraph {STRef s Int
GrowVector s Int
pgBoundaryEdges :: GrowVector s Int
pgFaceEdges :: GrowVector s Int
pgVertexEdges :: GrowVector s Int
pgHalfEdgeFace :: GrowVector s Int
pgHalfEdgeVertex :: GrowVector s Int
pgHalfEdgePrev :: GrowVector s Int
pgHalfEdgeNext :: GrowVector s Int
pgNextBoundaryId :: STRef s Int
pgNextFaceId :: STRef s Int
pgNextVertexId :: STRef s Int
pgNextHalfEdgeId :: STRef s Int
pgBoundaryEdges :: GrowVector s Int
pgFaceEdges :: GrowVector s Int
pgVertexEdges :: GrowVector s Int
pgHalfEdgeVertex :: GrowVector s Int
pgHalfEdgeFace :: GrowVector s Int
pgHalfEdgePrev :: GrowVector s Int
pgHalfEdgeNext :: GrowVector s Int
pgNextBoundaryId :: STRef s Int
pgNextFaceId :: STRef s Int
pgNextVertexId :: STRef s Int
pgNextHalfEdgeId :: STRef s Int
..}
pgUnsafeThaw :: PlanarGraph -> ST s (Mut.PlanarGraph s)
pgUnsafeThaw :: PlanarGraph -> ST s (PlanarGraph s)
pgUnsafeThaw PlanarGraph
pg = do
STRef s Int
pgNextHalfEdgeId <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef (Int -> ST s (STRef s Int)) -> Int -> ST s (STRef s Int)
forall a b. (a -> b) -> a -> b
$ Vector Int -> Int
forall a. Vector a -> Int
Vector.length (Vector Int -> Int) -> Vector Int -> Int
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgHalfEdgeNext PlanarGraph
pg
STRef s Int
pgNextVertexId <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef (Int -> ST s (STRef s Int)) -> Int -> ST s (STRef s Int)
forall a b. (a -> b) -> a -> b
$ Vector Int -> Int
forall a. Vector a -> Int
Vector.length (Vector Int -> Int) -> Vector Int -> Int
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgVertexEdges PlanarGraph
pg
STRef s Int
pgNextFaceId <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef (Int -> ST s (STRef s Int)) -> Int -> ST s (STRef s Int)
forall a b. (a -> b) -> a -> b
$ Vector Int -> Int
forall a. Vector a -> Int
Vector.length (Vector Int -> Int) -> Vector Int -> Int
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgFaceEdges PlanarGraph
pg
STRef s Int
pgNextBoundaryId <- Int -> ST s (STRef s Int)
forall a s. a -> ST s (STRef s a)
newSTRef (Int -> ST s (STRef s Int)) -> Int -> ST s (STRef s Int)
forall a b. (a -> b) -> a -> b
$ Vector Int -> Int
forall a. Vector a -> Int
Vector.length (Vector Int -> Int) -> Vector Int -> Int
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgBoundaryEdges PlanarGraph
pg
GrowVector s Int
pgHalfEdgeNext <- Vector Int -> ST s (GrowVector s Int)
forall v s. Vector v -> ST s (GrowVector s v)
Mut.unsafeThawVector (Vector Int -> ST s (GrowVector s Int))
-> Vector Int -> ST s (GrowVector s Int)
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgHalfEdgeNext PlanarGraph
pg
GrowVector s Int
pgHalfEdgePrev <- Vector Int -> ST s (GrowVector s Int)
forall v s. Vector v -> ST s (GrowVector s v)
Mut.unsafeThawVector (Vector Int -> ST s (GrowVector s Int))
-> Vector Int -> ST s (GrowVector s Int)
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgHalfEdgePrev PlanarGraph
pg
GrowVector s Int
pgHalfEdgeFace <- Vector Int -> ST s (GrowVector s Int)
forall v s. Vector v -> ST s (GrowVector s v)
Mut.unsafeThawVector (Vector Int -> ST s (GrowVector s Int))
-> Vector Int -> ST s (GrowVector s Int)
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgHalfEdgeFace PlanarGraph
pg
GrowVector s Int
pgHalfEdgeVertex <- Vector Int -> ST s (GrowVector s Int)
forall v s. Vector v -> ST s (GrowVector s v)
Mut.unsafeThawVector (Vector Int -> ST s (GrowVector s Int))
-> Vector Int -> ST s (GrowVector s Int)
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgHalfEdgeVertex PlanarGraph
pg
GrowVector s Int
pgVertexEdges <- Vector Int -> ST s (GrowVector s Int)
forall v s. Vector v -> ST s (GrowVector s v)
Mut.unsafeThawVector (Vector Int -> ST s (GrowVector s Int))
-> Vector Int -> ST s (GrowVector s Int)
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgVertexEdges PlanarGraph
pg
GrowVector s Int
pgFaceEdges <- Vector Int -> ST s (GrowVector s Int)
forall v s. Vector v -> ST s (GrowVector s v)
Mut.unsafeThawVector (Vector Int -> ST s (GrowVector s Int))
-> Vector Int -> ST s (GrowVector s Int)
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgFaceEdges PlanarGraph
pg
GrowVector s Int
pgBoundaryEdges <- Vector Int -> ST s (GrowVector s Int)
forall v s. Vector v -> ST s (GrowVector s v)
Mut.unsafeThawVector (Vector Int -> ST s (GrowVector s Int))
-> Vector Int -> ST s (GrowVector s Int)
forall a b. (a -> b) -> a -> b
$ PlanarGraph -> Vector Int
pgBoundaryEdges PlanarGraph
pg
PlanarGraph s -> ST s (PlanarGraph s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PlanarGraph :: 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
Mut.PlanarGraph {STRef s Int
GrowVector s Int
pgBoundaryEdges :: GrowVector s Int
pgFaceEdges :: GrowVector s Int
pgVertexEdges :: GrowVector s Int
pgHalfEdgeVertex :: GrowVector s Int
pgHalfEdgeFace :: GrowVector s Int
pgHalfEdgePrev :: GrowVector s Int
pgHalfEdgeNext :: GrowVector s Int
pgNextBoundaryId :: STRef s Int
pgNextFaceId :: STRef s Int
pgNextVertexId :: STRef s Int
pgNextHalfEdgeId :: STRef s Int
pgBoundaryEdges :: GrowVector s Int
pgFaceEdges :: GrowVector s Int
pgVertexEdges :: GrowVector s Int
pgHalfEdgeFace :: GrowVector s Int
pgHalfEdgeVertex :: GrowVector s Int
pgHalfEdgePrev :: GrowVector s Int
pgHalfEdgeNext :: GrowVector s Int
pgNextBoundaryId :: STRef s Int
pgNextFaceId :: STRef s Int
pgNextVertexId :: STRef s Int
pgNextHalfEdgeId :: STRef s Int
..}
pgFreeze :: Mut.PlanarGraph s -> ST s PlanarGraph
pgFreeze :: PlanarGraph s -> ST s PlanarGraph
pgFreeze PlanarGraph s
pg = do
Int
maxEdgeId <- 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
Mut.pgNextHalfEdgeId PlanarGraph s
pg)
Int
maxVertexId <- 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
Mut.pgNextVertexId PlanarGraph s
pg)
Int
maxFaceId <- 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
Mut.pgNextFaceId PlanarGraph s
pg)
Int
maxBoundaryId <- 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
Mut.pgNextBoundaryId PlanarGraph s
pg)
Vector Int
pgHalfEdgeNext <- Int -> Vector Int -> Vector Int
forall a. Int -> Vector a -> Vector a
Vector.take (Int
maxEdgeIdInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) (Vector Int -> Vector Int)
-> ST s (Vector Int) -> ST s (Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GrowVector s Int -> ST s (Vector Int)
forall s v. GrowVector s v -> ST s (Vector v)
Mut.freezeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
Mut.pgHalfEdgeNext PlanarGraph s
pg)
Vector Int
pgHalfEdgePrev <- Int -> Vector Int -> Vector Int
forall a. Int -> Vector a -> Vector a
Vector.take (Int
maxEdgeIdInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) (Vector Int -> Vector Int)
-> ST s (Vector Int) -> ST s (Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GrowVector s Int -> ST s (Vector Int)
forall s v. GrowVector s v -> ST s (Vector v)
Mut.freezeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
Mut.pgHalfEdgePrev PlanarGraph s
pg)
Vector Int
pgHalfEdgeFace <- Int -> Vector Int -> Vector Int
forall a. Int -> Vector a -> Vector a
Vector.take (Int
maxEdgeIdInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) (Vector Int -> Vector Int)
-> ST s (Vector Int) -> ST s (Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GrowVector s Int -> ST s (Vector Int)
forall s v. GrowVector s v -> ST s (Vector v)
Mut.freezeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
Mut.pgHalfEdgeFace PlanarGraph s
pg)
Vector Int
pgHalfEdgeVertex <- Int -> Vector Int -> Vector Int
forall a. Int -> Vector a -> Vector a
Vector.take (Int
maxEdgeIdInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) (Vector Int -> Vector Int)
-> ST s (Vector Int) -> ST s (Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GrowVector s Int -> ST s (Vector Int)
forall s v. GrowVector s v -> ST s (Vector v)
Mut.freezeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
Mut.pgHalfEdgeVertex PlanarGraph s
pg)
Vector Int
pgVertexEdges <- Int -> Vector Int -> Vector Int
forall a. Int -> Vector a -> Vector a
Vector.take Int
maxVertexId (Vector Int -> Vector Int)
-> ST s (Vector Int) -> ST s (Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GrowVector s Int -> ST s (Vector Int)
forall s v. GrowVector s v -> ST s (Vector v)
Mut.freezeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
Mut.pgVertexEdges PlanarGraph s
pg)
Vector Int
pgFaceEdges <- Int -> Vector Int -> Vector Int
forall a. Int -> Vector a -> Vector a
Vector.take Int
maxFaceId (Vector Int -> Vector Int)
-> ST s (Vector Int) -> ST s (Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GrowVector s Int -> ST s (Vector Int)
forall s v. GrowVector s v -> ST s (Vector v)
Mut.freezeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
Mut.pgFaceEdges PlanarGraph s
pg)
Vector Int
pgBoundaryEdges <- Int -> Vector Int -> Vector Int
forall a. Int -> Vector a -> Vector a
Vector.take Int
maxBoundaryId (Vector Int -> Vector Int)
-> ST s (Vector Int) -> ST s (Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GrowVector s Int -> ST s (Vector Int)
forall s v. GrowVector s v -> ST s (Vector v)
Mut.freezeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
Mut.pgBoundaryEdges PlanarGraph s
pg)
PlanarGraph -> ST s PlanarGraph
forall (f :: * -> *) a. Applicative f => a -> f a
pure PlanarGraph :: Vector Int
-> Vector Int
-> Vector Int
-> Vector Int
-> Vector Int
-> Vector Int
-> Vector Int
-> PlanarGraph
PlanarGraph { Vector Int
pgBoundaryEdges :: Vector Int
pgFaceEdges :: Vector Int
pgVertexEdges :: Vector Int
pgHalfEdgeVertex :: Vector Int
pgHalfEdgeFace :: Vector Int
pgHalfEdgePrev :: Vector Int
pgHalfEdgeNext :: Vector Int
pgBoundaryEdges :: Vector Int
pgFaceEdges :: Vector Int
pgVertexEdges :: Vector Int
pgHalfEdgeFace :: Vector Int
pgHalfEdgeVertex :: Vector Int
pgHalfEdgePrev :: Vector Int
pgHalfEdgeNext :: Vector Int
.. }
pgUnsafeFreeze :: Mut.PlanarGraph s -> ST s PlanarGraph
pgUnsafeFreeze :: PlanarGraph s -> ST s PlanarGraph
pgUnsafeFreeze PlanarGraph s
pg = do
Int
maxEdgeId <- 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
Mut.pgNextHalfEdgeId PlanarGraph s
pg)
Int
maxVertexId <- 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
Mut.pgNextVertexId PlanarGraph s
pg)
Int
maxFaceId <- 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
Mut.pgNextFaceId PlanarGraph s
pg)
Int
maxBoundaryId <- 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
Mut.pgNextBoundaryId PlanarGraph s
pg)
Vector Int
pgHalfEdgeNext <- Int -> Vector Int -> Vector Int
forall a. Int -> Vector a -> Vector a
Vector.take (Int
maxEdgeIdInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) (Vector Int -> Vector Int)
-> ST s (Vector Int) -> ST s (Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GrowVector s Int -> ST s (Vector Int)
forall s v. GrowVector s v -> ST s (Vector v)
Mut.unsafeFreezeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
Mut.pgHalfEdgeNext PlanarGraph s
pg)
Vector Int
pgHalfEdgePrev <- Int -> Vector Int -> Vector Int
forall a. Int -> Vector a -> Vector a
Vector.take (Int
maxEdgeIdInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) (Vector Int -> Vector Int)
-> ST s (Vector Int) -> ST s (Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GrowVector s Int -> ST s (Vector Int)
forall s v. GrowVector s v -> ST s (Vector v)
Mut.unsafeFreezeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
Mut.pgHalfEdgePrev PlanarGraph s
pg)
Vector Int
pgHalfEdgeFace <- Int -> Vector Int -> Vector Int
forall a. Int -> Vector a -> Vector a
Vector.take (Int
maxEdgeIdInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) (Vector Int -> Vector Int)
-> ST s (Vector Int) -> ST s (Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GrowVector s Int -> ST s (Vector Int)
forall s v. GrowVector s v -> ST s (Vector v)
Mut.unsafeFreezeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
Mut.pgHalfEdgeFace PlanarGraph s
pg)
Vector Int
pgHalfEdgeVertex <- Int -> Vector Int -> Vector Int
forall a. Int -> Vector a -> Vector a
Vector.take (Int
maxEdgeIdInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) (Vector Int -> Vector Int)
-> ST s (Vector Int) -> ST s (Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GrowVector s Int -> ST s (Vector Int)
forall s v. GrowVector s v -> ST s (Vector v)
Mut.unsafeFreezeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
Mut.pgHalfEdgeVertex PlanarGraph s
pg)
Vector Int
pgVertexEdges <- Int -> Vector Int -> Vector Int
forall a. Int -> Vector a -> Vector a
Vector.take Int
maxVertexId (Vector Int -> Vector Int)
-> ST s (Vector Int) -> ST s (Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GrowVector s Int -> ST s (Vector Int)
forall s v. GrowVector s v -> ST s (Vector v)
Mut.unsafeFreezeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
Mut.pgVertexEdges PlanarGraph s
pg)
Vector Int
pgFaceEdges <- Int -> Vector Int -> Vector Int
forall a. Int -> Vector a -> Vector a
Vector.take Int
maxFaceId (Vector Int -> Vector Int)
-> ST s (Vector Int) -> ST s (Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GrowVector s Int -> ST s (Vector Int)
forall s v. GrowVector s v -> ST s (Vector v)
Mut.unsafeFreezeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
Mut.pgFaceEdges PlanarGraph s
pg)
Vector Int
pgBoundaryEdges <- Int -> Vector Int -> Vector Int
forall a. Int -> Vector a -> Vector a
Vector.take Int
maxBoundaryId (Vector Int -> Vector Int)
-> ST s (Vector Int) -> ST s (Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GrowVector s Int -> ST s (Vector Int)
forall s v. GrowVector s v -> ST s (Vector v)
Mut.unsafeFreezeVector (PlanarGraph s -> GrowVector s Int
forall s. PlanarGraph s -> GrowVector s Int
Mut.pgBoundaryEdges PlanarGraph s
pg)
PlanarGraph -> ST s PlanarGraph
forall (f :: * -> *) a. Applicative f => a -> f a
pure PlanarGraph :: Vector Int
-> Vector Int
-> Vector Int
-> Vector Int
-> Vector Int
-> Vector Int
-> Vector Int
-> PlanarGraph
PlanarGraph { Vector Int
pgBoundaryEdges :: Vector Int
pgFaceEdges :: Vector Int
pgVertexEdges :: Vector Int
pgHalfEdgeVertex :: Vector Int
pgHalfEdgeFace :: Vector Int
pgHalfEdgePrev :: Vector Int
pgHalfEdgeNext :: Vector Int
pgBoundaryEdges :: Vector Int
pgFaceEdges :: Vector Int
pgVertexEdges :: Vector Int
pgHalfEdgeFace :: Vector Int
pgHalfEdgeVertex :: Vector Int
pgHalfEdgePrev :: Vector Int
pgHalfEdgeNext :: Vector Int
.. }
tutteEmbedding :: PlanarGraph -> Vector.Vector (V2 Double)
tutteEmbedding :: PlanarGraph -> Vector (V2 Double)
tutteEmbedding PlanarGraph
pg = (forall s. ST s (Vector (V2 Double))) -> Vector (V2 Double)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector (V2 Double))) -> Vector (V2 Double))
-> (forall s. ST s (Vector (V2 Double))) -> Vector (V2 Double)
forall a b. (a -> b) -> a -> b
$ do
let nVertices :: Int
nVertices = Vector Int -> Int
forall a. Vector a -> Int
Vector.length (PlanarGraph -> Vector Int
pgVertexEdges PlanarGraph
pg)
Vector (MVector s Double)
m <- Int -> ST s (MVector s Double) -> ST s (Vector (MVector s Double))
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
Vector.replicateM Int
nVertices (Int -> Double -> ST s (MVector (PrimState (ST s)) Double)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
V.replicate Int
nVertices Double
0)
MVector s Double
vx <- Int -> Double -> ST s (MVector (PrimState (ST s)) Double)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
V.replicate Int
nVertices Double
0
MVector s Double
vy <- Int -> Double -> ST s (MVector (PrimState (ST s)) Double)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
V.replicate Int
nVertices Double
0
let boundary :: [Vertex]
boundary = Face -> PlanarGraph -> [Vertex]
faceBoundary (Int -> Face
Boundary Int
0) PlanarGraph
pg
let nBoundary :: Int
nBoundary = [Vertex] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Vertex]
boundary
[(Vertex, (Double, Double))]
-> ((Vertex, (Double, Double)) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Vertex] -> [(Double, Double)] -> [(Vertex, (Double, Double))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Vertex]
boundary (Int -> [(Double, Double)]
regularPolygon Int
nBoundary)) (((Vertex, (Double, Double)) -> ST s ()) -> ST s ())
-> ((Vertex, (Double, Double)) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Vertex
vertex,(Double
x,Double
y)) -> do
let valid :: Bool
valid = HalfEdge -> Bool
halfEdgeIsValid (HalfEdge -> Bool) -> HalfEdge -> Bool
forall a b. (a -> b) -> a -> b
$ Vertex -> PlanarGraph -> HalfEdge
vertexHalfEdge Vertex
vertex PlanarGraph
pg
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
valid (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
MVector (PrimState (ST s)) Double -> Int -> Double -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
V.write (Vector (MVector s Double)
m Vector (MVector s Double) -> Int -> MVector s Double
forall a. Vector a -> Int -> a
Vector.! Vertex -> Int
vertexId Vertex
vertex) (Vertex -> Int
vertexId Vertex
vertex) (Double
1::Double)
MVector (PrimState (ST s)) Double -> Int -> Double -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
V.write MVector s Double
MVector (PrimState (ST s)) Double
vx (Vertex -> Int
vertexId Vertex
vertex) Double
x
MVector (PrimState (ST s)) Double -> Int -> Double -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
V.write MVector s Double
MVector (PrimState (ST s)) Double
vy (Vertex -> Int
vertexId Vertex
vertex) Double
y
[Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
nVerticesInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
vId ->
do
let valid :: Bool
valid = HalfEdge -> Bool
halfEdgeIsValid (HalfEdge -> Bool) -> HalfEdge -> Bool
forall a b. (a -> b) -> a -> b
$ Vertex -> PlanarGraph -> HalfEdge
vertexHalfEdge (Int -> Vertex
Vertex Int
vId) PlanarGraph
pg
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
valid (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
MVector (PrimState (ST s)) Double -> Int -> Double -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
V.write (Vector (MVector s Double)
m Vector (MVector s Double) -> Int -> MVector s Double
forall a. Vector a -> Int -> a
Vector.! Int
vId) Int
vId (Double
1::Double)
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
valid (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
let onOuterBoundary :: Bool
onOuterBoundary =
Int -> Face
Boundary Int
0 Face -> Face -> Bool
forall a. Eq a => a -> a -> Bool
== HalfEdge -> PlanarGraph -> Face
halfEdgeFace (HalfEdge -> HalfEdge
halfEdgeTwin (HalfEdge -> HalfEdge) -> HalfEdge -> HalfEdge
forall a b. (a -> b) -> a -> b
$ Vertex -> PlanarGraph -> HalfEdge
vertexHalfEdge (Int -> Vertex
Vertex Int
vId) PlanarGraph
pg) PlanarGraph
pg
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
onOuterBoundary (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
let vertex :: Vertex
vertex = Int -> Vertex
Vertex Int
vId
let neighbours :: [Vertex]
neighbours = Vertex -> PlanarGraph -> [Vertex]
vertexNeighbours Vertex
vertex PlanarGraph
pg
[Vertex] -> (Vertex -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Vertex]
neighbours ((Vertex -> ST s ()) -> ST s ()) -> (Vertex -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Vertex
neighbour ->
MVector (PrimState (ST s)) Double -> Int -> Double -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
V.write (Vector (MVector s Double)
m Vector (MVector s Double) -> Int -> MVector s Double
forall a. Vector a -> Int -> a
Vector.! Int
vId) (Vertex -> Int
vertexId Vertex
neighbour) (Double
1::Double)
MVector (PrimState (ST s)) Double -> Int -> Double -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
V.write (Vector (MVector s Double)
m Vector (MVector s Double) -> Int -> MVector s Double
forall a. Vector a -> Int -> a
Vector.! Int
vId) Int
vId (Double -> Double
forall a. Num a => a -> a
negate (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ [Vertex] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Vertex]
neighbours)
Vector (Vector Double)
mi <- (MVector s Double -> ST s (Vector Double))
-> Vector (MVector s Double) -> ST s (Vector (Vector Double))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM MVector s Double -> ST s (Vector Double)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
Vector.freeze Vector (MVector s Double)
m
Vector Double
vxi <- MVector (PrimState (ST s)) Double -> ST s (Vector Double)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
Vector.freeze MVector s Double
MVector (PrimState (ST s)) Double
vx
Vector Double
vyi <- MVector (PrimState (ST s)) Double -> ST s (Vector Double)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
Vector.freeze MVector s Double
MVector (PrimState (ST s)) Double
vy
let xPos :: Vector Double
xPos = Vector (Vector Double)
-> Vector Double
-> (forall n.
Dim n =>
V n (V n Double) -> V n Double -> V n Double)
-> Vector Double
forall a.
Vector (Vector a)
-> Vector a
-> (forall n. Dim n => V n (V n a) -> V n a -> V n a)
-> Vector a
reifyMatrix Vector (Vector Double)
mi Vector Double
vxi forall n. Dim n => V n (V n Double) -> V n Double -> V n Double
forall a (m :: * -> *) i.
(Num a, Fractional a, Foldable m, Traversable m, Applicative m,
Additive m, Ixed (m a), Ixed (m (m a)), i ~ Index (m a),
i ~ Index (m (m a)), Eq i, Integral i, a ~ IxValue (m a),
m a ~ IxValue (m (m a)), Num (m a)) =>
m (m a) -> m a -> m a
luSolve
yPos :: Vector Double
yPos = Vector (Vector Double)
-> Vector Double
-> (forall n.
Dim n =>
V n (V n Double) -> V n Double -> V n Double)
-> Vector Double
forall a.
Vector (Vector a)
-> Vector a
-> (forall n. Dim n => V n (V n a) -> V n a -> V n a)
-> Vector a
reifyMatrix Vector (Vector Double)
mi Vector Double
vyi forall n. Dim n => V n (V n Double) -> V n Double -> V n Double
forall a (m :: * -> *) i.
(Num a, Fractional a, Foldable m, Traversable m, Applicative m,
Additive m, Ixed (m a), Ixed (m (m a)), i ~ Index (m a),
i ~ Index (m (m a)), Eq i, Integral i, a ~ IxValue (m a),
m a ~ IxValue (m (m a)), Num (m a)) =>
m (m a) -> m a -> m a
luSolve
Vector (V2 Double) -> ST s (Vector (V2 Double))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector (V2 Double) -> ST s (Vector (V2 Double)))
-> Vector (V2 Double) -> ST s (Vector (V2 Double))
forall a b. (a -> b) -> a -> b
$ (Double -> Double -> V2 Double)
-> Vector Double -> Vector Double -> Vector (V2 Double)
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
Vector.zipWith Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 Vector Double
xPos Vector Double
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 :: Vector (Vector a)
-> Vector a
-> (forall n. Dim n => V n (V n a) -> V n a -> V n a)
-> Vector a
reifyMatrix Vector (Vector a)
m Vector a
v forall n. Dim n => V n (V n a) -> V n a -> V n a
f = Int -> (forall n. Dim n => Proxy n -> Vector a) -> Vector a
forall r. Int -> (forall n. Dim n => Proxy n -> r) -> r
reifyDim (Vector (Vector a) -> Int
forall a. Vector a -> Int
Vector.length Vector (Vector a)
m) ((forall n. Dim n => Proxy n -> Vector a) -> Vector a)
-> (forall n. Dim n => Proxy n -> Vector a) -> Vector a
forall a b. (a -> b) -> a -> b
$ \(Proxy n
Proxy :: Proxy n) ->
V n a -> Vector a
forall k (n :: k) a. V n a -> Vector a
toVector (V n (V n a) -> V n a -> V n a
forall n. Dim n => V n (V n a) -> V n a -> V n a
f (Vector (Vector a) -> V n (V n a)
coerce Vector (Vector a)
m :: (V n (V n a))) (Vector a -> V n a
coerce Vector a
v))
regularPolygon :: Int -> [(Double, Double)]
regularPolygon :: Int -> [(Double, Double)]
regularPolygon Int
n =
[ (Double -> Double
forall a. Floating a => a -> a
cos Double
ang, Double -> Double
forall a. Floating a => a -> a
sin Double
ang)
| Int
i <- [Int
0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
, let ang :: Double
ang = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
frac Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2]
where
frac :: Double
frac = Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n