{-# LANGUAGE GADTs #-} module HGraph.Directed ( DirectedGraph(..) , Adjacency(..) , Mutable(..) ) where import qualified Data.Map as M import qualified Data.Set as S class DirectedGraph t where empty :: t a -> t a vertices :: t a -> [a] numVertices :: Integral b => t a -> b numVertices t a d = Int -> b forall a b. (Integral a, Num b) => a -> b fromIntegral (Int -> b) -> Int -> b forall a b. (a -> b) -> a -> b $ [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ([a] -> Int) -> [a] -> Int forall a b. (a -> b) -> a -> b $ t a -> [a] forall (t :: * -> *) a. DirectedGraph t => t a -> [a] vertices t a d arcs :: t a -> [(a,a)] numArcs :: Integral b => t a -> b numArcs t a d = Int -> b forall a b. (Integral a, Num b) => a -> b fromIntegral (Int -> b) -> Int -> b forall a b. (a -> b) -> a -> b $ [(a, a)] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ([(a, a)] -> Int) -> [(a, a)] -> Int forall a b. (a -> b) -> a -> b $ t a -> [(a, a)] forall (t :: * -> *) a. DirectedGraph t => t a -> [(a, a)] arcs t a d linearizeVertices :: t a -> (t Int, [(Int, a)]) isVertex :: t a -> a -> Bool class Adjacency t where outneighbors :: t a -> a -> [a] inneighbors :: t a -> a -> [a] outdegree :: Integral b => t a -> a -> b outdegree t a d a v = Int -> b forall a b. (Integral a, Num b) => a -> b fromIntegral (Int -> b) -> Int -> b forall a b. (a -> b) -> a -> b $ [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ([a] -> Int) -> [a] -> Int forall a b. (a -> b) -> a -> b $ t a -> a -> [a] forall (t :: * -> *) a. Adjacency t => t a -> a -> [a] outneighbors t a d a v indegree :: Integral b => t a -> a -> b indegree t a d a v = Int -> b forall a b. (Integral a, Num b) => a -> b fromIntegral (Int -> b) -> Int -> b forall a b. (a -> b) -> a -> b $ [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ([a] -> Int) -> [a] -> Int forall a b. (a -> b) -> a -> b $ t a -> a -> [a] forall (t :: * -> *) a. Adjacency t => t a -> a -> [a] inneighbors t a d a v arcExists :: t a -> (a,a) -> Bool metaBfs :: Ord a => t a -> a -> ([a] -> [a]) -> ([a] -> [a]) -> [a] metaBfs t a d a v [a] -> [a] inFilter [a] -> [a] outFilter = Set a -> Set a -> [a] metaBfs' Set a forall a. Set a S.empty ([a] -> Set a forall a. Ord a => [a] -> Set a S.fromList ([a] -> Set a) -> [a] -> Set a forall a b. (a -> b) -> a -> b $ ([a] -> [a] inFilter ([a] -> [a]) -> [a] -> [a] forall a b. (a -> b) -> a -> b $ t a -> a -> [a] forall (t :: * -> *) a. Adjacency t => t a -> a -> [a] inneighbors t a d a v) [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] ++ ([a] -> [a] outFilter ([a] -> [a]) -> [a] -> [a] forall a b. (a -> b) -> a -> b $ t a -> a -> [a] forall (t :: * -> *) a. Adjacency t => t a -> a -> [a] outneighbors t a d a v)) where metaBfs' :: Set a -> Set a -> [a] metaBfs' Set a visited Set a toVisit = let vs :: [a] vs = Set a -> [a] forall a. Set a -> [a] S.toList Set a toVisit newToVisit :: Set a newToVisit = ([Set a] -> Set a forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a S.unions ([Set a] -> Set a) -> [Set a] -> Set a forall a b. (a -> b) -> a -> b $ (a -> Set a) -> [a] -> [Set a] forall a b. (a -> b) -> [a] -> [b] map ([a] -> Set a forall a. Ord a => [a] -> Set a S.fromList ([a] -> Set a) -> (a -> [a]) -> a -> Set a forall b c a. (b -> c) -> (a -> b) -> a -> c . (\a v -> ([a] -> [a] inFilter ([a] -> [a]) -> [a] -> [a] forall a b. (a -> b) -> a -> b $ t a -> a -> [a] forall (t :: * -> *) a. Adjacency t => t a -> a -> [a] inneighbors t a d a v) [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] ++ ([a] -> [a] outFilter ([a] -> [a]) -> [a] -> [a] forall a b. (a -> b) -> a -> b $ t a -> a -> [a] forall (t :: * -> *) a. Adjacency t => t a -> a -> [a] outneighbors t a d a v))) [a] vs ) Set a -> Set a -> Set a forall a. Ord a => Set a -> Set a -> Set a `S.difference` Set a visited in if Set a -> Bool forall a. Set a -> Bool S.null Set a newToVisit then [a] vs else [a] vs [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] ++ Set a -> Set a -> [a] metaBfs' (Set a -> Set a -> Set a forall a. Ord a => Set a -> Set a -> Set a S.union ([a] -> Set a forall a. Ord a => [a] -> Set a S.fromList [a] vs) Set a visited) Set a newToVisit class Mutable t where addVertex :: a -> t a -> t a removeVertex :: a -> t a -> t a addArc :: (a,a) -> t a -> t a removeArc :: (a,a) -> t a -> t a