{-# 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