Undirected.hs

{-# 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    :: a -> t a -> t a
  removeVertex :: a -> t a -> t a
  addEdge      :: (a,a) -> t a -> t a
  removeEdge   :: (a,a) -> t a -> t a