{-# LANGUAGE GADTs #-} module HGraph.Undirected ( UndirectedGraph(..) , Adjacency(..) , Mutable(..) ) where import qualified Data.Set as S class UndirectedGraph 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. UndirectedGraph t => t a -> [a] vertices t a d edges :: t a -> [(a,a)] numEdges :: Integral b => t a -> b numEdges 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. UndirectedGraph t => t a -> [(a, a)] edges t a d linearizeVertices :: t a -> (t Int, [(Int, a)]) class UndirectedGraph t => Adjacency t where neighbors :: t a -> a -> [a] degree :: Integral b => t a -> a -> b edgeExists :: t a -> (a,a) -> Bool inducedSubgraph :: t a -> [a] -> t a metaBfs :: Ord a => t a -> a -> ([a] -> [a]) -> [a] metaBfs t a d a v [a] -> [a] nFilter = a v a -> [a] -> [a] forall a. a -> [a] -> [a] : Set a -> Set a -> [a] metaBfs' (a -> Set a forall a. a -> Set a S.singleton a v) ([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] nFilter ([a] -> [a]) -> [a] -> [a] forall a b. (a -> b) -> a -> b $ t a -> a -> [a] forall (t :: * -> *) a. Adjacency t => t a -> a -> [a] neighbors 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] nFilter ([a] -> [a]) -> [a] -> [a] forall a b. (a -> b) -> a -> b $ t a -> a -> [a] forall (t :: * -> *) a. Adjacency t => t a -> a -> [a] neighbors 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 connectedComponents :: Ord a => t a -> [[a]] connectedComponents t a g = [a] -> Set a -> [[a]] cc (t a -> [a] forall (t :: * -> *) a. UndirectedGraph t => t a -> [a] vertices t a g) Set a forall a. Set a S.empty where cc :: [a] -> Set a -> [[a]] cc [] Set a _ = [] cc (a v:[a] vs) Set a visited | a v a -> Set a -> Bool forall a. Ord a => a -> Set a -> Bool `S.member` Set a visited = [a] -> Set a -> [[a]] cc [a] vs Set a visited | Bool otherwise = [a] component [a] -> [[a]] -> [[a]] forall a. a -> [a] -> [a] : [a] -> Set a -> [[a]] cc [a] vs (Set a -> Set a -> Set a forall a. Ord a => Set a -> Set a -> Set a S.union Set a visited (Set a -> Set a) -> Set a -> Set a forall a b. (a -> b) -> a -> b $ [a] -> Set a forall a. Ord a => [a] -> Set a S.fromList [a] component) where component :: [a] component = t a -> a -> ([a] -> [a]) -> [a] forall (t :: * -> *) a. (Adjacency t, Ord a) => t a -> a -> ([a] -> [a]) -> [a] metaBfs t a g a v [a] -> [a] forall a. a -> a id class Mutable t where addVertex :: t a -> a -> t a removeVertex :: t a -> a -> t a addEdge :: t a -> (a,a) -> t a removeEdge :: t a -> (a,a) -> t a