module Data.Graph.Types where
import Data.List (foldl')
import GHC.Float (float2Double)
import GHC.Generics (Generic)
import Control.DeepSeq
import Data.Hashable
import qualified Data.HashMap.Lazy as HM
import Test.QuickCheck
class Graph g where
empty :: (Hashable v) => g v e
order :: g v e -> Int
size :: (Hashable v, Eq v) => g v e -> Int
size = length . edgePairs
vertices :: g v e -> [v]
edgePairs :: (Hashable v, Eq v) => g v e -> [(v, v)]
containsVertex :: (Hashable v, Eq v) => g v e -> v -> Bool
areAdjacent :: (Hashable v, Eq v) => g v e -> v -> v -> Bool
adjacentVertices :: (Hashable v, Eq v) => g v e -> v -> [v]
directlyReachableVertices :: (Hashable v, Eq v) => g v e -> v -> [v]
vertexDegree :: (Hashable v, Eq v) => g v e -> v -> Int
degrees :: (Hashable v, Eq v) => g v e -> [Int]
degrees g = vertexDegree g <$> vertices g
maxDegree :: (Hashable v, Eq v) => g v e -> Int
maxDegree = maximum . degrees
minDegree :: (Hashable v, Eq v) => g v e -> Int
minDegree = minimum . degrees
avgDegree :: (Hashable v, Eq v) => g v e -> Double
avgDegree g = fromIntegral (2 * size g) / (fromIntegral $ order g)
density :: (Hashable v, Eq v) => g v e -> Double
density g = (2 * (e n + 1)) / (n * (n 3) + 2)
where
n = fromIntegral $ order g
e = fromIntegral $ size g
insertVertex :: (Hashable v, Eq v) => v -> g v e -> g v e
insertVertices :: (Hashable v, Eq v) => [v] -> g v e -> g v e
insertVertices vs g = foldl' (flip insertVertex) g vs
containsEdgePair :: (Hashable v, Eq v) => g v e -> (v, v) -> Bool
incidentEdgePairs :: (Hashable v, Eq v) => g v e -> v -> [(v, v)]
insertEdgePair :: (Hashable v, Eq v) => (v, v) -> g v () -> g v ()
insertEdgePairs :: (Hashable v, Eq v) => [(v, v)] -> g v () -> g v ()
insertEdgePairs es g = foldl' (flip insertEdgePair) g es
removeVertex :: (Hashable v, Eq v) => v -> g v e -> g v e
removeVertices :: (Hashable v, Eq v) => [v] -> g v e -> g v e
removeVertices vs g = foldl' (flip removeVertex) g vs
removeEdgePair :: (Hashable v, Eq v) => (v, v) -> g v e -> g v e
removeEdgePairs :: (Hashable v, Eq v) => [(v, v)] -> g v e -> g v e
removeEdgePairs es g = foldl' (flip removeEdgePair) g es
removeEdgePairAndVertices :: (Hashable v, Eq v) => (v, v) -> g v e -> g v e
removeEdgePairAndVertices (v1, v2) g =
removeVertex v2 $ removeVertex v1 $ removeEdgePair (v1, v2) g
isSimple :: (Hashable v, Eq v) => g v e -> Bool
fromAdjacencyMatrix :: [[Int]] -> Maybe (g Int ())
toAdjacencyMatrix :: g v e -> [[Int]]
data Edge v e = Edge v v e
deriving (Show, Read, Ord, Generic)
data Arc v e = Arc v v e
deriving (Show, Read, Ord, Generic)
(<->) :: (Hashable v) => v -> v -> Edge v ()
(<->) v1 v2 = Edge v1 v2 ()
(-->) :: (Hashable v) => v -> v -> Arc v ()
(-->) v1 v2 = Arc v1 v2 ()
class IsEdge e where
toPair :: e v a -> (v, v)
isLoop :: (Eq v) => e v a -> Bool
instance (NFData v, NFData e) => NFData (Edge v e)
instance (NFData v, NFData e) => NFData (Arc v e)
instance IsEdge Edge where
toPair (Edge v1 v2 _) = (v1, v2)
isLoop (Edge v1 v2 _) = v1 == v2
instance IsEdge Arc where
toPair (Arc fromV toV _) = (fromV, toV)
isLoop (Arc v1 v2 _) = v1 == v2
class Weighted a where
weight :: a -> Double
class Labeled a where
label :: a -> String
instance Weighted Int where
weight = fromIntegral
instance Weighted Float where
weight = float2Double
instance Weighted Double where
weight = id
instance Labeled String where
label = id
instance Weighted (Double, String) where
weight = fst
instance Labeled (Double, String) where
label = snd
instance (Arbitrary v, Arbitrary e, Num v, Ord v) => Arbitrary (Edge v e) where
arbitrary = arbitraryEdge Edge
instance (Arbitrary v, Arbitrary e, Num v, Ord v) => Arbitrary (Arc v e) where
arbitrary = arbitraryEdge Arc
instance (Eq v, Eq a) => Eq (Edge v a) where
(Edge v1 v2 a) == (Edge v1' v2' a') =
(a == a')
&& (v1 == v1' && v2 == v2')
|| (v1 == v2' && v2 == v1')
instance (Eq v, Eq a) => Eq (Arc v a) where
(Arc v1 v2 a) == (Arc v1' v2' a') = (a == a') && (v1 == v1' && v2 == v2')
arbitraryEdge :: (Arbitrary v, Arbitrary e, Ord v, Num v)
=> (v -> v -> e -> edge) -> Gen edge
arbitraryEdge edgeType = edgeType <$> vert <*> vert <*> arbitrary
where vert = getPositive <$> arbitrary
type Links v e = HM.HashMap v e
insertLink :: (Hashable v, Eq v) => v -> a -> Links v a -> Links v a
insertLink = HM.insert
getLinks :: (Hashable v, Eq v) => v -> HM.HashMap v (Links v e) -> Links v e
getLinks = HM.lookupDefault HM.empty
linksToArcs :: [(v, Links v a)] -> [Arc v a]
linksToArcs ls = concat $ fmap toArc ls
where
toArc :: (v, Links v a) -> [Arc v a]
toArc (fromV, links) = fmap (\(v, a) -> Arc fromV v a) (HM.toList links)
linksToEdges :: [(v, Links v a)] -> [Edge v a]
linksToEdges ls = concat $ fmap toEdge ls
where
toEdge :: (v, Links v a) -> [Edge v a]
toEdge (fromV, links) = fmap (\(v, a) -> Edge fromV v a) (HM.toList links)
linksToEdges' :: (Eq v) => (v, Links v a) -> [Edge v a]
linksToEdges' (fromV, links) = fmap (\(v, a) -> Edge fromV v a) (HM.toList links)
hashMapInsert :: (Eq k, Hashable k) => k -> v -> HM.HashMap k v -> HM.HashMap k v
hashMapInsert k v m = if not (HM.member k m) then HM.insert k v m else m