hgeometry-0.6.0.0: Geometric Algorithms, Data structures, and Data types.

Safe HaskellNone
LanguageHaskell2010

Data.PlanarGraph

Synopsis

Documentation

newtype Arc s Source #

An Arc is a directed edge in a planar graph. The type s is used to tie this arc to a particular graph.

Constructors

Arc 

Fields

Instances

Bounded (Arc k s) Source # 

Methods

minBound :: Arc k s #

maxBound :: Arc k s #

Enum (Arc k s) Source # 

Methods

succ :: Arc k s -> Arc k s #

pred :: Arc k s -> Arc k s #

toEnum :: Int -> Arc k s #

fromEnum :: Arc k s -> Int #

enumFrom :: Arc k s -> [Arc k s] #

enumFromThen :: Arc k s -> Arc k s -> [Arc k s] #

enumFromTo :: Arc k s -> Arc k s -> [Arc k s] #

enumFromThenTo :: Arc k s -> Arc k s -> Arc k s -> [Arc k s] #

Eq (Arc k s) Source # 

Methods

(==) :: Arc k s -> Arc k s -> Bool #

(/=) :: Arc k s -> Arc k s -> Bool #

Ord (Arc k s) Source # 

Methods

compare :: Arc k s -> Arc k s -> Ordering #

(<) :: Arc k s -> Arc k s -> Bool #

(<=) :: Arc k s -> Arc k s -> Bool #

(>) :: Arc k s -> Arc k s -> Bool #

(>=) :: Arc k s -> Arc k s -> Bool #

max :: Arc k s -> Arc k s -> Arc k s #

min :: Arc k s -> Arc k s -> Arc k s #

Show (Arc k s) Source # 

Methods

showsPrec :: Int -> Arc k s -> ShowS #

show :: Arc k s -> String #

showList :: [Arc k s] -> ShowS #

rev :: Direction -> Direction Source #

Reverse the direcion

data Dart s Source #

A dart represents a bi-directed edge. I.e. a dart has a direction, however the dart of the oposite direction is always present in the planar graph as well.

Constructors

Dart 

Fields

Instances

Enum (Dart k s) Source # 

Methods

succ :: Dart k s -> Dart k s #

pred :: Dart k s -> Dart k s #

toEnum :: Int -> Dart k s #

fromEnum :: Dart k s -> Int #

enumFrom :: Dart k s -> [Dart k s] #

enumFromThen :: Dart k s -> Dart k s -> [Dart k s] #

enumFromTo :: Dart k s -> Dart k s -> [Dart k s] #

enumFromThenTo :: Dart k s -> Dart k s -> Dart k s -> [Dart k s] #

Eq (Dart k s) Source # 

Methods

(==) :: Dart k s -> Dart k s -> Bool #

(/=) :: Dart k s -> Dart k s -> Bool #

Ord (Dart k s) Source # 

Methods

compare :: Dart k s -> Dart k s -> Ordering #

(<) :: Dart k s -> Dart k s -> Bool #

(<=) :: Dart k s -> Dart k s -> Bool #

(>) :: Dart k s -> Dart k s -> Bool #

(>=) :: Dart k s -> Dart k s -> Bool #

max :: Dart k s -> Dart k s -> Dart k s #

min :: Dart k s -> Dart k s -> Dart k s #

Show (Dart k s) Source # 

Methods

showsPrec :: Int -> Dart k s -> ShowS #

show :: Dart k s -> String #

showList :: [Dart k s] -> ShowS #

arc :: forall s s. Lens (Dart s) (Dart s) (Arc s) (Arc s) Source #

twin :: Dart s -> Dart s Source #

Get the twin of this dart (edge)

>>> twin (dart 0 "+1")
Dart (Arc 0) -1
>>> twin (dart 0 "-1")
Dart (Arc 0) +1

isPositive :: Dart s -> Bool Source #

test if a dart is Positive

data World Source #

The world in which the graph lives

Constructors

Primal_ 
Dual_ 

Instances

Eq World Source # 

Methods

(==) :: World -> World -> Bool #

(/=) :: World -> World -> Bool #

Show World Source # 

Methods

showsPrec :: Int -> World -> ShowS #

show :: World -> String #

showList :: [World] -> ShowS #

type family Dual (sp :: World) where ... Source #

newtype VertexId s w Source #

A vertex in a planar graph. A vertex is tied to a particular planar graph by the phantom type s, and to a particular world w.

Constructors

VertexId 

Fields

Instances

Enum (VertexId k s w) Source # 

Methods

succ :: VertexId k s w -> VertexId k s w #

pred :: VertexId k s w -> VertexId k s w #

toEnum :: Int -> VertexId k s w #

fromEnum :: VertexId k s w -> Int #

enumFrom :: VertexId k s w -> [VertexId k s w] #

enumFromThen :: VertexId k s w -> VertexId k s w -> [VertexId k s w] #

enumFromTo :: VertexId k s w -> VertexId k s w -> [VertexId k s w] #

enumFromThenTo :: VertexId k s w -> VertexId k s w -> VertexId k s w -> [VertexId k s w] #

Eq (VertexId k s w) Source # 

Methods

(==) :: VertexId k s w -> VertexId k s w -> Bool #

(/=) :: VertexId k s w -> VertexId k s w -> Bool #

Ord (VertexId k s w) Source # 

Methods

compare :: VertexId k s w -> VertexId k s w -> Ordering #

(<) :: VertexId k s w -> VertexId k s w -> Bool #

(<=) :: VertexId k s w -> VertexId k s w -> Bool #

(>) :: VertexId k s w -> VertexId k s w -> Bool #

(>=) :: VertexId k s w -> VertexId k s w -> Bool #

max :: VertexId k s w -> VertexId k s w -> VertexId k s w #

min :: VertexId k s w -> VertexId k s w -> VertexId k s w #

Show (VertexId k s w) Source # 

Methods

showsPrec :: Int -> VertexId k s w -> ShowS #

show :: VertexId k s w -> String #

showList :: [VertexId k s w] -> ShowS #

data PlanarGraph s w v e f Source #

A *connected* Planar graph with bidirected edges. I.e. the edges (darts) are directed, however, for every directed edge, the edge in the oposite direction is also in the graph.

The types v, e, and f are the are the types of the data associated with the vertices, edges, and faces, respectively.

The orbits in the embedding are assumed to be in counterclockwise order.

Instances

(Eq f, Eq e, Eq v) => Eq (PlanarGraph k s w v e f) Source # 

Methods

(==) :: PlanarGraph k s w v e f -> PlanarGraph k s w v e f -> Bool #

(/=) :: PlanarGraph k s w v e f -> PlanarGraph k s w v e f -> Bool #

(Show f, Show e, Show v) => Show (PlanarGraph k s w v e f) Source # 

Methods

showsPrec :: Int -> PlanarGraph k s w v e f -> ShowS #

show :: PlanarGraph k s w v e f -> String #

showList :: [PlanarGraph k s w v e f] -> ShowS #

type NumType (PlaneGraph k s w v e f r) Source # 
type NumType (PlaneGraph k s w v e f r) = r

embedding :: forall s w v e f s w. Lens (PlanarGraph s w v e f) (PlanarGraph s w v e f) (Permutation (Dart s)) (Permutation (Dart s)) Source #

vertexData :: forall s w v e f w v. Lens (PlanarGraph s w v e f) (PlanarGraph s w v e f) (Vector v) (Vector v) Source #

dartData :: Lens (PlanarGraph s w v e f) (PlanarGraph s w v e' f) (Vector (Dart s, e)) (Vector (Dart s, e')) Source #

lens to access the Dart Data

faceData :: forall s w v e f w f. Lens (PlanarGraph s w v e f) (PlanarGraph s w v e f) (Vector f) (Vector f) Source #

edgeData :: Lens (PlanarGraph s w v e f) (PlanarGraph s w v e' f) (Vector (Dart s, e)) (Vector (Dart s, e')) Source #

edgeData is just an alias for dartData

planarGraph :: [[(Dart s, e)]] -> PlanarGraph s Primal_ () e () Source #

Construct a planar graph, given the darts in cyclic order around each vertex.

running time: \(O(n)\).

planarGraph' :: Permutation (Dart s) -> PlanarGraph s w () () () Source #

Construct a planar graph

fromAdjacencyLists :: forall s w f. (Foldable f, Functor f) => [(VertexId s w, f (VertexId s w))] -> PlanarGraph s w () () () Source #

Construct a planar graph from a adjacency matrix. For every vertex, all vertices should be given in counter clockwise order.

running time: \(O(n)\).

numVertices :: PlanarGraph s w v e f -> Int Source #

Get the number of vertices

>>> numVertices myGraph
4

numDarts :: PlanarGraph s w v e f -> Int Source #

Get the number of Darts

>>> numDarts myGraph
12

numEdges :: PlanarGraph s w v e f -> Int Source #

Get the number of Edges

>>> numEdges myGraph
6

numFaces :: PlanarGraph s w v e f -> Int Source #

Get the number of faces

>>> numFaces myGraph
4

darts' :: PlanarGraph s w v e f -> Vector (Dart s) Source #

Enumerate all darts

darts :: PlanarGraph s w v e f -> Vector (Dart s, e) Source #

Get all darts together with their data

>>> mapM_ print $ darts myGraph
(Dart (Arc 0) -1,"a-")
(Dart (Arc 2) +1,"c+")
(Dart (Arc 1) +1,"b+")
(Dart (Arc 0) +1,"a+")
(Dart (Arc 4) -1,"e-")
(Dart (Arc 1) -1,"b-")
(Dart (Arc 3) -1,"d-")
(Dart (Arc 5) +1,"g+")
(Dart (Arc 4) +1,"e+")
(Dart (Arc 3) +1,"d+")
(Dart (Arc 2) -1,"c-")
(Dart (Arc 5) -1,"g-")

edges' :: PlanarGraph s w v e f -> Vector (Dart s) Source #

Enumerate all edges. We report only the Positive darts

edges :: PlanarGraph s w v e f -> Vector (Dart s, e) Source #

Enumerate all edges with their edge data. We report only the Positive darts.

>>> mapM_ print $ edges myGraph
(Dart (Arc 2) +1,"c+")
(Dart (Arc 1) +1,"b+")
(Dart (Arc 0) +1,"a+")
(Dart (Arc 5) +1,"g+")
(Dart (Arc 4) +1,"e+")
(Dart (Arc 3) +1,"d+")

vertices' :: PlanarGraph s w v e f -> Vector (VertexId s w) Source #

Enumerate all vertices

>>> vertices' myGraph
[VertexId 0,VertexId 1,VertexId 2,VertexId 3]

vertices :: PlanarGraph s w v e f -> Vector (VertexId s w, v) Source #

Enumerate all vertices, together with their vertex data

faces' :: PlanarGraph s w v e f -> Vector (FaceId s w) Source #

Enumerate all faces in the planar graph

faces :: PlanarGraph s w v e f -> Vector (FaceId s w, f) Source #

All faces with their face data.

tailOf :: Dart s -> PlanarGraph s w v e f -> VertexId s w Source #

The tail of a dart, i.e. the vertex this dart is leaving from

running time: \(O(1)\)

headOf :: Dart s -> PlanarGraph s w v e f -> VertexId s w Source #

The vertex this dart is heading in to

running time: \(O(1)\)

endPoints :: Dart s -> PlanarGraph s w v e f -> (VertexId s w, VertexId s w) Source #

endPoints d g = (tailOf d g, headOf d g)

running time: \(O(1)\)

incidentEdges :: VertexId s w -> PlanarGraph s w v e f -> Vector (Dart s) Source #

All edges incident to vertex v, in counterclockwise order around v.

running time: \(O(k)\), where \(k\) is the output size

incomingEdges :: VertexId s w -> PlanarGraph s w v e f -> Vector (Dart s) Source #

All incoming edges incident to vertex v, in counterclockwise order around v.

outgoingEdges :: VertexId s w -> PlanarGraph s w v e f -> Vector (Dart s) Source #

All outgoing edges incident to vertex v, in counterclockwise order around v.

neighboursOf :: VertexId s w -> PlanarGraph s w v e f -> Vector (VertexId s w) Source #

Gets the neighbours of a particular vertex, in counterclockwise order around the vertex.

running time: \(O(k)\), where \(k\) is the output size

vDataOf :: VertexId s w -> Lens' (PlanarGraph s w v e f) v Source #

Get the vertex data associated with a node. Note that updating this data may be expensive!!

running time: \(O(1)\)

eDataOf :: Dart s -> Lens' (PlanarGraph s w v e f) e Source #

Edge data of a given dart

running time: \(O(1)\)

fDataOf :: FaceId s w -> Lens' (PlanarGraph s w v e f) f Source #

Data of a face of a given face

running time: \(O(1)\)

endPointDataOf :: Dart s -> Getter (PlanarGraph s w v e f) (v, v) Source #

Data corresponding to the endpoints of the dart

endPointData :: Dart s -> PlanarGraph s w v e f -> (v, v) Source #

Data corresponding to the endpoints of the dart

running time: \(O(1)\)

dual :: PlanarGraph s w v e f -> PlanarGraph s (Dual w) f e v Source #

The dual of this graph

>>> :{
 let fromList = V.fromList
     answer = fromList [ fromList [dart 0 "-1"]
                       , fromList [dart 2 "+1",dart 4 "+1",dart 1 "-1",dart 0 "+1"]
                       , fromList [dart 1 "+1",dart 3 "-1",dart 2 "-1"]
                       , fromList [dart 4 "-1",dart 3 "+1",dart 5 "+1",dart 5 "-1"]
                       ]
 in (dual myGraph)^.embedding.orbits == answer
:}
True

running time: \(O(n)\).

newtype FaceId s w Source #

A face

Constructors

FaceId 

Fields

Instances

Eq (FaceId k s w) Source # 

Methods

(==) :: FaceId k s w -> FaceId k s w -> Bool #

(/=) :: FaceId k s w -> FaceId k s w -> Bool #

Ord (FaceId k s w) Source # 

Methods

compare :: FaceId k s w -> FaceId k s w -> Ordering #

(<) :: FaceId k s w -> FaceId k s w -> Bool #

(<=) :: FaceId k s w -> FaceId k s w -> Bool #

(>) :: FaceId k s w -> FaceId k s w -> Bool #

(>=) :: FaceId k s w -> FaceId k s w -> Bool #

max :: FaceId k s w -> FaceId k s w -> FaceId k s w #

min :: FaceId k s w -> FaceId k s w -> FaceId k s w #

Show (FaceId k s w) Source # 

Methods

showsPrec :: Int -> FaceId k s w -> ShowS #

show :: FaceId k s w -> String #

showList :: [FaceId k s w] -> ShowS #

leftFace :: Dart s -> PlanarGraph s w v e f -> FaceId s w Source #

The face to the left of the dart

>>> leftFace (dart 1 "+1") myGraph
FaceId 1
>>> leftFace (dart 1 "-1") myGraph
FaceId 2
>>> leftFace (dart 2 "+1") myGraph
FaceId 2
>>> leftFace (dart 0 "+1") myGraph
FaceId 0

running time: \(O(1)\).

rightFace :: Dart s -> PlanarGraph s w v e f -> FaceId s w Source #

The face to the right of the dart

>>> rightFace (dart 1 "+1") myGraph
FaceId 2
>>> rightFace (dart 1 "-1") myGraph
FaceId 1
>>> rightFace (dart 2 "+1") myGraph
FaceId 1
>>> rightFace (dart 0 "+1") myGraph
FaceId 1

running time: \(O(1)\).

boundary :: FaceId s w -> PlanarGraph s w v e f -> Vector (Dart s) Source #

The darts bounding this face, for internal faces in clockwise order, for the outer face in counter clockwise order.

running time: \(O(k)\), where \(k\) is the output size.

boundaryVertices :: FaceId s w -> PlanarGraph s w v e f -> Vector (VertexId s w) Source #

The vertices bounding this face, for internal faces in clockwise order, for the outer face in counter clockwise order.

running time: \(O(k)\), where \(k\) is the output size.

data EdgeOracle s w a Source #

Edge Oracle:

main idea: store adjacency lists in such a way that we store an edge (u,v) either in u's adjacency list or in v's. This can be done s.t. all adjacency lists have length at most 6.

note: Every edge is stored exactly once (i.e. either at u or at v, but not both)

Instances

Functor (EdgeOracle k s w) Source # 

Methods

fmap :: (a -> b) -> EdgeOracle k s w a -> EdgeOracle k s w b #

(<$) :: a -> EdgeOracle k s w b -> EdgeOracle k s w a #

Foldable (EdgeOracle k s w) Source # 

Methods

fold :: Monoid m => EdgeOracle k s w m -> m #

foldMap :: Monoid m => (a -> m) -> EdgeOracle k s w a -> m #

foldr :: (a -> b -> b) -> b -> EdgeOracle k s w a -> b #

foldr' :: (a -> b -> b) -> b -> EdgeOracle k s w a -> b #

foldl :: (b -> a -> b) -> b -> EdgeOracle k s w a -> b #

foldl' :: (b -> a -> b) -> b -> EdgeOracle k s w a -> b #

foldr1 :: (a -> a -> a) -> EdgeOracle k s w a -> a #

foldl1 :: (a -> a -> a) -> EdgeOracle k s w a -> a #

toList :: EdgeOracle k s w a -> [a] #

null :: EdgeOracle k s w a -> Bool #

length :: EdgeOracle k s w a -> Int #

elem :: Eq a => a -> EdgeOracle k s w a -> Bool #

maximum :: Ord a => EdgeOracle k s w a -> a #

minimum :: Ord a => EdgeOracle k s w a -> a #

sum :: Num a => EdgeOracle k s w a -> a #

product :: Num a => EdgeOracle k s w a -> a #

Traversable (EdgeOracle k s w) Source # 

Methods

traverse :: Applicative f => (a -> f b) -> EdgeOracle k s w a -> f (EdgeOracle k s w b) #

sequenceA :: Applicative f => EdgeOracle k s w (f a) -> f (EdgeOracle k s w a) #

mapM :: Monad m => (a -> m b) -> EdgeOracle k s w a -> m (EdgeOracle k s w b) #

sequence :: Monad m => EdgeOracle k s w (m a) -> m (EdgeOracle k s w a) #

Eq a => Eq (EdgeOracle k s w a) Source # 

Methods

(==) :: EdgeOracle k s w a -> EdgeOracle k s w a -> Bool #

(/=) :: EdgeOracle k s w a -> EdgeOracle k s w a -> Bool #

Show a => Show (EdgeOracle k s w a) Source # 

Methods

showsPrec :: Int -> EdgeOracle k s w a -> ShowS #

show :: EdgeOracle k s w a -> String #

showList :: [EdgeOracle k s w a] -> ShowS #

edgeOracle :: PlanarGraph s w v e f -> EdgeOracle s w () Source #

buildEdgeOracle :: forall f s w e. Foldable f => [(VertexId s w, f (VertexId s w :+ e))] -> EdgeOracle s w e Source #

Builds an edge oracle that can be used to efficiently test if two vertices are connected by an edge.

running time: \(O(n)\)

findEdge :: VertexId s w -> VertexId s w -> EdgeOracle s w a -> Maybe a Source #

Find the edge data corresponding to edge (u,v) if such an edge exists

running time: \(O(1)\)

hasEdge :: VertexId s w -> VertexId s w -> EdgeOracle s w a -> Bool Source #

Test if u and v are connected by an edge.

running time: \(O(1)\)