{-# LANGUAGE TemplateHaskell #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.PlanarGraph.Dart
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Data type for representing Darts (edges) in a planar graph.
--------------------------------------------------------------------------------
module Data.PlanarGraph.Dart where

import Control.DeepSeq
import Control.Lens hiding ((.=))
import GHC.Generics (Generic)
import Test.QuickCheck (Arbitrary(..),suchThat)

-- $setup
-- >>> :{
-- let dart i s = Dart (Arc i) (read s)
-- :}

--------------------------------------------------------------------------------

-- | An Arc is a directed edge in a planar graph. The type s is used to tie
-- this arc to a particular graph.
newtype Arc s = Arc { Arc s -> Int
_unArc :: Int } deriving (Arc s -> Arc s -> Bool
(Arc s -> Arc s -> Bool) -> (Arc s -> Arc s -> Bool) -> Eq (Arc s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (s :: k). Arc s -> Arc s -> Bool
/= :: Arc s -> Arc s -> Bool
$c/= :: forall k (s :: k). Arc s -> Arc s -> Bool
== :: Arc s -> Arc s -> Bool
$c== :: forall k (s :: k). Arc s -> Arc s -> Bool
Eq,Eq (Arc s)
Eq (Arc s)
-> (Arc s -> Arc s -> Ordering)
-> (Arc s -> Arc s -> Bool)
-> (Arc s -> Arc s -> Bool)
-> (Arc s -> Arc s -> Bool)
-> (Arc s -> Arc s -> Bool)
-> (Arc s -> Arc s -> Arc s)
-> (Arc s -> Arc s -> Arc s)
-> Ord (Arc s)
Arc s -> Arc s -> Bool
Arc s -> Arc s -> Ordering
Arc s -> Arc s -> Arc s
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (s :: k). Eq (Arc s)
forall k (s :: k). Arc s -> Arc s -> Bool
forall k (s :: k). Arc s -> Arc s -> Ordering
forall k (s :: k). Arc s -> Arc s -> Arc s
min :: Arc s -> Arc s -> Arc s
$cmin :: forall k (s :: k). Arc s -> Arc s -> Arc s
max :: Arc s -> Arc s -> Arc s
$cmax :: forall k (s :: k). Arc s -> Arc s -> Arc s
>= :: Arc s -> Arc s -> Bool
$c>= :: forall k (s :: k). Arc s -> Arc s -> Bool
> :: Arc s -> Arc s -> Bool
$c> :: forall k (s :: k). Arc s -> Arc s -> Bool
<= :: Arc s -> Arc s -> Bool
$c<= :: forall k (s :: k). Arc s -> Arc s -> Bool
< :: Arc s -> Arc s -> Bool
$c< :: forall k (s :: k). Arc s -> Arc s -> Bool
compare :: Arc s -> Arc s -> Ordering
$ccompare :: forall k (s :: k). Arc s -> Arc s -> Ordering
$cp1Ord :: forall k (s :: k). Eq (Arc s)
Ord,Int -> Arc s
Arc s -> Int
Arc s -> [Arc s]
Arc s -> Arc s
Arc s -> Arc s -> [Arc s]
Arc s -> Arc s -> Arc s -> [Arc s]
(Arc s -> Arc s)
-> (Arc s -> Arc s)
-> (Int -> Arc s)
-> (Arc s -> Int)
-> (Arc s -> [Arc s])
-> (Arc s -> Arc s -> [Arc s])
-> (Arc s -> Arc s -> [Arc s])
-> (Arc s -> Arc s -> Arc s -> [Arc s])
-> Enum (Arc s)
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
forall k (s :: k). Int -> Arc s
forall k (s :: k). Arc s -> Int
forall k (s :: k). Arc s -> [Arc s]
forall k (s :: k). Arc s -> Arc s
forall k (s :: k). Arc s -> Arc s -> [Arc s]
forall k (s :: k). Arc s -> Arc s -> Arc s -> [Arc s]
enumFromThenTo :: Arc s -> Arc s -> Arc s -> [Arc s]
$cenumFromThenTo :: forall k (s :: k). Arc s -> Arc s -> Arc s -> [Arc s]
enumFromTo :: Arc s -> Arc s -> [Arc s]
$cenumFromTo :: forall k (s :: k). Arc s -> Arc s -> [Arc s]
enumFromThen :: Arc s -> Arc s -> [Arc s]
$cenumFromThen :: forall k (s :: k). Arc s -> Arc s -> [Arc s]
enumFrom :: Arc s -> [Arc s]
$cenumFrom :: forall k (s :: k). Arc s -> [Arc s]
fromEnum :: Arc s -> Int
$cfromEnum :: forall k (s :: k). Arc s -> Int
toEnum :: Int -> Arc s
$ctoEnum :: forall k (s :: k). Int -> Arc s
pred :: Arc s -> Arc s
$cpred :: forall k (s :: k). Arc s -> Arc s
succ :: Arc s -> Arc s
$csucc :: forall k (s :: k). Arc s -> Arc s
Enum,Arc s
Arc s -> Arc s -> Bounded (Arc s)
forall a. a -> a -> Bounded a
forall k (s :: k). Arc s
maxBound :: Arc s
$cmaxBound :: forall k (s :: k). Arc s
minBound :: Arc s
$cminBound :: forall k (s :: k). Arc s
Bounded,(forall x. Arc s -> Rep (Arc s) x)
-> (forall x. Rep (Arc s) x -> Arc s) -> Generic (Arc s)
forall x. Rep (Arc s) x -> Arc s
forall x. Arc s -> Rep (Arc s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (s :: k) x. Rep (Arc s) x -> Arc s
forall k (s :: k) x. Arc s -> Rep (Arc s) x
$cto :: forall k (s :: k) x. Rep (Arc s) x -> Arc s
$cfrom :: forall k (s :: k) x. Arc s -> Rep (Arc s) x
Generic,Arc s -> ()
(Arc s -> ()) -> NFData (Arc s)
forall a. (a -> ()) -> NFData a
forall k (s :: k). Arc s -> ()
rnf :: Arc s -> ()
$crnf :: forall k (s :: k). Arc s -> ()
NFData)

instance Show (Arc s) where
  show :: Arc s -> String
show (Arc Int
i) = String
"Arc " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i

instance Arbitrary (Arc s) where
  arbitrary :: Gen (Arc s)
arbitrary = Int -> Arc s
forall k (s :: k). Int -> Arc s
Arc (Int -> Arc s) -> Gen Int -> Gen (Arc s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen Int
forall a. Arbitrary a => Gen a
arbitrary Gen Int -> (Int -> Bool) -> Gen Int
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0))


-- | Darts have a direction which is either Positive or Negative (shown as +1
-- or -1, respectively).
data Direction = Negative | Positive deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq,Eq Direction
Eq Direction
-> (Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmax :: Direction -> Direction -> Direction
>= :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c< :: Direction -> Direction -> Bool
compare :: Direction -> Direction -> Ordering
$ccompare :: Direction -> Direction -> Ordering
$cp1Ord :: Eq Direction
Ord,Direction
Direction -> Direction -> Bounded Direction
forall a. a -> a -> Bounded a
maxBound :: Direction
$cmaxBound :: Direction
minBound :: Direction
$cminBound :: Direction
Bounded,Int -> Direction
Direction -> Int
Direction -> [Direction]
Direction -> Direction
Direction -> Direction -> [Direction]
Direction -> Direction -> Direction -> [Direction]
(Direction -> Direction)
-> (Direction -> Direction)
-> (Int -> Direction)
-> (Direction -> Int)
-> (Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> Direction -> [Direction])
-> Enum Direction
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
$cenumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
enumFromTo :: Direction -> Direction -> [Direction]
$cenumFromTo :: Direction -> Direction -> [Direction]
enumFromThen :: Direction -> Direction -> [Direction]
$cenumFromThen :: Direction -> Direction -> [Direction]
enumFrom :: Direction -> [Direction]
$cenumFrom :: Direction -> [Direction]
fromEnum :: Direction -> Int
$cfromEnum :: Direction -> Int
toEnum :: Int -> Direction
$ctoEnum :: Int -> Direction
pred :: Direction -> Direction
$cpred :: Direction -> Direction
succ :: Direction -> Direction
$csucc :: Direction -> Direction
Enum,(forall x. Direction -> Rep Direction x)
-> (forall x. Rep Direction x -> Direction) -> Generic Direction
forall x. Rep Direction x -> Direction
forall x. Direction -> Rep Direction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Direction x -> Direction
$cfrom :: forall x. Direction -> Rep Direction x
Generic)

instance NFData Direction

instance Show Direction where
  show :: Direction -> String
show Direction
Positive = String
"+1"
  show Direction
Negative = String
"-1"

instance Read Direction where
  readsPrec :: Int -> ReadS Direction
readsPrec Int
_ String
"-1" = [(Direction
Negative,String
"")]
  readsPrec Int
_ String
"+1" = [(Direction
Positive,String
"")]
  readsPrec Int
_ String
_    = []

instance Arbitrary Direction where
  arbitrary :: Gen Direction
arbitrary = (\Bool
b -> if Bool
b then Direction
Positive else Direction
Negative) (Bool -> Direction) -> Gen Bool -> Gen Direction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary

-- | Reverse the direcion
rev          :: Direction -> Direction
rev :: Direction -> Direction
rev Direction
Negative = Direction
Positive
rev Direction
Positive = Direction
Negative

-- | 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.
data Dart s = Dart { Dart s -> Arc s
_arc       :: !(Arc s)
                   , Dart s -> Direction
_direction :: !Direction
                   } deriving (Dart s -> Dart s -> Bool
(Dart s -> Dart s -> Bool)
-> (Dart s -> Dart s -> Bool) -> Eq (Dart s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (s :: k). Dart s -> Dart s -> Bool
/= :: Dart s -> Dart s -> Bool
$c/= :: forall k (s :: k). Dart s -> Dart s -> Bool
== :: Dart s -> Dart s -> Bool
$c== :: forall k (s :: k). Dart s -> Dart s -> Bool
Eq,Eq (Dart s)
Eq (Dart s)
-> (Dart s -> Dart s -> Ordering)
-> (Dart s -> Dart s -> Bool)
-> (Dart s -> Dart s -> Bool)
-> (Dart s -> Dart s -> Bool)
-> (Dart s -> Dart s -> Bool)
-> (Dart s -> Dart s -> Dart s)
-> (Dart s -> Dart s -> Dart s)
-> Ord (Dart s)
Dart s -> Dart s -> Bool
Dart s -> Dart s -> Ordering
Dart s -> Dart s -> Dart s
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (s :: k). Eq (Dart s)
forall k (s :: k). Dart s -> Dart s -> Bool
forall k (s :: k). Dart s -> Dart s -> Ordering
forall k (s :: k). Dart s -> Dart s -> Dart s
min :: Dart s -> Dart s -> Dart s
$cmin :: forall k (s :: k). Dart s -> Dart s -> Dart s
max :: Dart s -> Dart s -> Dart s
$cmax :: forall k (s :: k). Dart s -> Dart s -> Dart s
>= :: Dart s -> Dart s -> Bool
$c>= :: forall k (s :: k). Dart s -> Dart s -> Bool
> :: Dart s -> Dart s -> Bool
$c> :: forall k (s :: k). Dart s -> Dart s -> Bool
<= :: Dart s -> Dart s -> Bool
$c<= :: forall k (s :: k). Dart s -> Dart s -> Bool
< :: Dart s -> Dart s -> Bool
$c< :: forall k (s :: k). Dart s -> Dart s -> Bool
compare :: Dart s -> Dart s -> Ordering
$ccompare :: forall k (s :: k). Dart s -> Dart s -> Ordering
$cp1Ord :: forall k (s :: k). Eq (Dart s)
Ord,(forall x. Dart s -> Rep (Dart s) x)
-> (forall x. Rep (Dart s) x -> Dart s) -> Generic (Dart s)
forall x. Rep (Dart s) x -> Dart s
forall x. Dart s -> Rep (Dart s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (s :: k) x. Rep (Dart s) x -> Dart s
forall k (s :: k) x. Dart s -> Rep (Dart s) x
$cto :: forall k (s :: k) x. Rep (Dart s) x -> Dart s
$cfrom :: forall k (s :: k) x. Dart s -> Rep (Dart s) x
Generic)

-- | Arc lens.
arc :: Lens' (Dart s) (Arc s)
arc :: (Arc s -> f (Arc s)) -> Dart s -> f (Dart s)
arc = (Dart s -> Arc s)
-> (Dart s -> Arc s -> Dart s)
-> Lens (Dart s) (Dart s) (Arc s) (Arc s)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Dart s -> Arc s
forall k (s :: k). Dart s -> Arc s
_arc (\Dart s
d Arc s
a -> Dart s
d{_arc :: Arc s
_arc = Arc s
a})

-- | Direction lens.
direction :: Lens' (Dart s) Direction
direction :: (Direction -> f Direction) -> Dart s -> f (Dart s)
direction = (Dart s -> Direction)
-> (Dart s -> Direction -> Dart s)
-> Lens (Dart s) (Dart s) Direction Direction
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Dart s -> Direction
forall k (s :: k). Dart s -> Direction
_direction (\Dart s
d Direction
dir -> Dart s
d{_direction :: Direction
_direction = Direction
dir})

-- makeLenses ''Dart

instance NFData (Dart s)

instance Show (Dart s) where
  show :: Dart s -> String
show (Dart Arc s
a Direction
d) = String
"Dart (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Arc s -> String
forall a. Show a => a -> String
show Arc s
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Direction -> String
forall a. Show a => a -> String
show Direction
d

instance Arbitrary (Dart s) where
  arbitrary :: Gen (Dart s)
arbitrary = Arc s -> Direction -> Dart s
forall k (s :: k). Arc s -> Direction -> Dart s
Dart (Arc s -> Direction -> Dart s)
-> Gen (Arc s) -> Gen (Direction -> Dart s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Arc s)
forall a. Arbitrary a => Gen a
arbitrary Gen (Direction -> Dart s) -> Gen Direction -> Gen (Dart s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Direction
forall a. Arbitrary a => Gen a
arbitrary

-- | Get the twin of this dart (edge)
--
-- >>> twin (dart 0 "+1")
-- Dart (Arc 0) -1
-- >>> twin (dart 0 "-1")
-- Dart (Arc 0) +1
twin            :: Dart s -> Dart s
twin :: Dart s -> Dart s
twin (Dart Arc s
a Direction
d) = Arc s -> Direction -> Dart s
forall k (s :: k). Arc s -> Direction -> Dart s
Dart Arc s
a (Direction -> Direction
rev Direction
d)

-- | test if a dart is Positive
isPositive   :: Dart s -> Bool
isPositive :: Dart s -> Bool
isPositive Dart s
d = Dart s
dDart s -> Getting Direction (Dart s) Direction -> Direction
forall s a. s -> Getting a s a -> a
^.Getting Direction (Dart s) Direction
forall k (s :: k). Lens' (Dart s) Direction
direction Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
Positive


instance Enum (Dart s) where
  toEnum :: Int -> Dart s
toEnum Int
x
    | Int -> Bool
forall a. Integral a => a -> Bool
even Int
x    = Arc s -> Direction -> Dart s
forall k (s :: k). Arc s -> Direction -> Dart s
Dart (Int -> Arc s
forall k (s :: k). Int -> Arc s
Arc (Int -> Arc s) -> Int -> Arc s
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Direction
Positive
    | Bool
otherwise = Arc s -> Direction -> Dart s
forall k (s :: k). Arc s -> Direction -> Dart s
Dart (Int -> Arc s
forall k (s :: k). Int -> Arc s
Arc (Int -> Arc s) -> Int -> Arc s
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Direction
Negative
  -- get the back edge by adding one

  fromEnum :: Dart s -> Int
fromEnum (Dart (Arc Int
i) Direction
d) = case Direction
d of
                                Direction
Positive -> Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i
                                Direction
Negative -> Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1


-- | Enumerates all darts such that
-- allDarts !! i = d   <=> i == fromEnum d
allDarts :: [Dart s]
allDarts :: [Dart s]
allDarts = (Arc s -> [Dart s]) -> [Arc s] -> [Dart s]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Arc s
a -> [Arc s -> Direction -> Dart s
forall k (s :: k). Arc s -> Direction -> Dart s
Dart Arc s
a Direction
Positive, Arc s -> Direction -> Dart s
forall k (s :: k). Arc s -> Direction -> Dart s
Dart Arc s
a Direction
Negative]) [Int -> Arc s
forall k (s :: k). Int -> Arc s
Arc Int
0..]