Haph.hs

{-# LANGUAGE InstanceSigs #-}
module Haph (bfs) where

import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.List.Ordered as O

newtype AdjacencyList v = AdjacencyList (Map.Map v [v])

class Graph g where
    neighbors :: (Ord v) => g v -> v -> [v]

instance Graph AdjacencyList where
    neighbors :: (Ord v) => AdjacencyList v -> v -> [v]
    neighbors (AdjacencyList m) k = concat $ Map.lookup k m

testGraph = AdjacencyList $ Map.fromList [ (1, [3, 4])
                                         , (2, [4, 5])
                                         , (3, [1, 6])
                                         , (4, [1, 2, 6])
                                         , (5, [2, 6])
                                         , (6, [3, 4, 5])
                                         , (7, [8])
                                         , (8, [7])]

bfs :: (Graph g, Ord v) => g v -> v -> [v]
bfs graph start = bfsPrivate [start] Set.empty graph

bfsPrivate :: (Graph g, Ord v) => [v] -> Set.Set v -> g v -> [v]
bfsPrivate [] _ _ = []
bfsPrivate (vertex:wave) visited graph
    | not (Set.member vertex visited) = vertex : bfsPrivate (wave ++ neighbors graph vertex)
                                                            (Set.insert vertex visited)
                                                            graph
    | otherwise = bfsPrivate wave visited graph