{-# 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 d = fromIntegral $ length $ vertices d edges :: t a -> [(a,a)] numEdges :: Integral b => t a -> b numEdges d = fromIntegral $ length $ edges 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 d v nFilter = v : metaBfs' (S.singleton v) (S.fromList $ (nFilter $ neighbors d v)) where metaBfs' visited toVisit = let vs = S.toList toVisit newToVisit = (S.unions $ map (S.fromList . (\v -> (nFilter $ neighbors d v))) vs ) `S.difference` visited in if S.null newToVisit then vs else vs ++ metaBfs' (S.union (S.fromList vs) visited) newToVisit connectedComponents :: Ord a => t a -> [[a]] connectedComponents g = cc (vertices g) S.empty where cc [] _ = [] cc (v:vs) visited | v `S.member` visited = cc vs visited | otherwise = component : cc vs (S.union visited $ S.fromList component) where component = metaBfs g v 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