Removing duplicated code from sources

1 parent c375b0f commit fb6c6c7a46ff1b0a71b243b7066e5edc471bc83b committed Oct 15, 2011
14 src/Lesson2/BFS.hs
 @@ -1,10 +1,10 @@ module Lesson2.BFS ( - BasicNode(..) + Node(..) , BasicEdge(..) - , BasicGraph(..) - , basicGraphEdges - , basicGraphNodes + , Graph(..) + , graphEdges + , graphNodes , enumBFS , consumeTillNode , parseGraph @@ -16,7 +16,9 @@ import Data.Attoparsec.Enumerator (iterParser) import Data.Enumerator (run_, (\$\$)) import Data.Enumerator.Binary (enumFile) +import Lesson2.Enumerator import Lesson2.Types + import Lesson2.BFS.Enumerator import Lesson2.BFS.Types import Lesson2.BFS.Parser @@ -27,9 +29,9 @@ main = do graph <- run_ \$ enumFile "src/Lesson2/Input.txt" \$\$ iterParser parseGraph -- Set the initial State - let startNode = BasicNode (City "Arad") + let startNode = Node (City "Arad") -- Set the goal State - let goalNode = BasicNode (City "Bucharest") + let goalNode = Node (City "Bucharest") -- Run basic BFS result <- run_ \$ enumBFS startNode graph \$\$ consumeTillNode goalNode -- Print visit order
33 src/Lesson2/BFS/Enumerator.hs
 @@ -16,20 +16,21 @@ import Data.Ord (Ord(..), comparing) import qualified Data.Set as Set +import Lesson2.Types import Lesson2.BFS.Types ------------------------------------------------------------------------------- newtype FrontierEntry a - = FE { fromFE :: (Int, BasicNode a) } + = FE { fromFE :: (Int, Node a) } deriving (Show, Eq, Ord) ------------------------------------------------------------------------------- enumBFS :: (MonadIO m, Show a, Hashable a) - => BasicNode a - -> BasicGraph a - -> Enumerator (BasicNode a) m b + => Node a + -> BFSGraph a + -> Enumerator (Node a) m b enumBFS source0 g = go Set.empty (Set.singleton \$ FE (0, source0)) where @@ -38,27 +39,11 @@ enumBFS source0 g = case Set.minView frontier0 of Just (FE (i, source), frontier1) -> do let explored = Set.insert source explored0 - let frontier = Set.union frontier1 . - Set.fromList . - Prelude.map (\n -> FE (i + 1, n)) . - Prelude.filter (`Set.notMember` explored) \$ + let frontier = Set.union frontier1 . + Set.fromList . + Prelude.map (\(_, n) -> FE (i + 1, n)) . + Prelude.filter ((`Set.notMember` explored) . snd) \$ getNodeNeighbours source g runIteratee \$ consumer (Chunks [source]) >>== go explored frontier Nothing -> return step -------------------------------------------------------------------------------- - -consumeTillNode :: (Monad m, Hashable a) - => BasicNode a - -> Iteratee (BasicNode a) m [BasicNode a] -consumeTillNode dest = continue \$ go [] - where - go acc EOF = yield [] EOF - go acc (Chunks ns) = Iteratee \$ do - let (as, bs) = span (dest /=) ns - case bs of - [] -> return \$ Continue \$ go \$ acc ++ as - (x:xs) -> return \$ Yield (acc ++ as ++ [x]) (Chunks xs) - -------------------------------------------------------------------------------- -
6 src/Lesson2/BFS/Parser.hs
 @@ -18,9 +18,9 @@ parseCity = tillComma <* comma) where - entry = BasicNode . City . toString + entry = Node . City . toString -parseEntry :: Parser (BasicGraph City) +parseEntry :: Parser (Graph BasicEdge City) parseEntry = do a <- parseCity b <- parseCity @@ -33,6 +33,6 @@ parseEntry = do appendNode a \$ appendNode b emptyGraph -parseGraph :: Parser (BasicGraph City) +parseGraph :: Parser (Graph BasicEdge City) parseGraph = mconcat <\$> many1 parseEntry
80 src/Lesson2/BFS/Types.hs
 @@ -1,94 +1,52 @@ -{-# LANGUAGE TemplateHaskell #-} module Lesson2.BFS.Types where -import Data.Lens.Common (getL, modL) -import Data.Lens.Template (makeLenses) -import Data.List (foldl', sort) +import Data.Lens.Common (modL) +import Data.List (foldl') import Data.Hashable (Hashable(..)) -import Data.Monoid (Monoid(..)) import Data.Ord (Ord(..), comparing) import Data.Set (Set) import qualified Data.Set as Set -------------------------------------------------------------------------------- -data BasicGraph a - = BasicGraph { - _basicGraphNodes :: Set (BasicNode a) - , _basicGraphEdges :: Set (BasicEdge a) - } +import Lesson2.Types -data BasicNode a - = BasicNode { - basicNodeValue :: a - } +------------------------------------------------------------------------------- + +type BFSGraph = Graph BasicEdge data BasicEdge a = BasicEdge { - basicEdgeSource :: BasicNode a - , basicEdgeSink :: BasicNode a + basicEdgeSource :: Node a + , basicEdgeSink :: Node a } -makeLenses [''BasicGraph] - ------------------------------------------------------------------------------- -instance Show a => Show (BasicNode a) where - show (BasicNode v) = show v - instance Show a => Show (BasicEdge a) where show (BasicEdge a b) = "(" ++ show a ++ ", " ++ show b ++ ")" -instance Hashable a => Monoid (BasicGraph a) where - mempty = emptyGraph - mappend (BasicGraph n0 e0) (BasicGraph n1 e1) = - BasicGraph (n0 `mappend` n1) - (e0 `mappend` e1) - -instance Hashable a => Hashable (BasicNode a) where - hash (BasicNode a) = 0 `hashWithSalt` a - instance Hashable a => Hashable (BasicEdge a) where hash (BasicEdge a b) = foldl' hashWithSalt 1 [a, b] -instance Hashable a => Eq (BasicNode a) where - a == b = hash a == hash b - -instance (Hashable a) => Ord (BasicNode a) where - compare = comparing hash - instance Hashable a => Eq (BasicEdge a) where a == b = hash a == hash b instance Hashable a => Ord (BasicEdge a) where compare = comparing hash -------------------------------------------------------------------------------- - -emptyGraph :: BasicGraph a -emptyGraph = BasicGraph Set.empty Set.empty - -appendNode :: Hashable a => BasicNode a -> BasicGraph a -> BasicGraph a -appendNode node = modL basicGraphNodes (Set.insert node) - -appendEdge :: Hashable a - => BasicNode a - -> BasicNode a - -> BasicGraph a - -> BasicGraph a -appendEdge a b = modL basicGraphEdges (Set.union otherSet) - where - otherSet = Set.fromList [BasicEdge a b, BasicEdge b a] +instance EdgeLike BasicEdge where + getEdgeSource = basicEdgeSource + getEdgeSink = basicEdgeSink + getEdgeCost = const Nothing ------------------------------------------------------------------------------- -getNodeNeighbours :: Hashable a => BasicNode a -> BasicGraph a -> [BasicNode a] -getNodeNeighbours n = - Set.fold getOtherNode [] . - getL basicGraphEdges +appendEdge :: Hashable a + => Node a + -> Node a + -> Graph BasicEdge a + -> Graph BasicEdge a +appendEdge a b = modL graphEdges (Set.union otherSet) where - getOtherNode e acc - | basicEdgeSource e == n = basicEdgeSink e : acc - | otherwise = acc - + otherSet = Set.fromList [BasicEdge a b, BasicEdge b a]
26 src/Lesson2/Enumerator.hs
 @@ -0,0 +1,26 @@ +module Lesson2.Enumerator where + +import Data.Hashable (Hashable) +import Data.Enumerator ( + Stream(..) + , Iteratee(..) + , Step(..) + , continue + , yield + ) + +import Lesson2.Types + +consumeTillNode :: (Monad m, Hashable a) + => Node a + -> Iteratee (Node a) m [Node a] +consumeTillNode dest = continue \$ go [] + where + go acc EOF = yield [] EOF + go acc (Chunks []) = continue \$ go acc + go acc (Chunks ns) = Iteratee \$ do + let (as, bs) = span (dest /=) ns + case bs of + [] -> return \$ Continue \$ go \$ acc ++ as + (x:xs) -> return \$ Yield (acc ++ as ++ [x]) (Chunks xs) +
76 src/Lesson2/Types.hs
 @@ -1,12 +1,88 @@ +{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell #-} module Lesson2.Types where +import Data.Lens.Common (modL, getL) +import Data.Lens.Template (makeLenses) import Data.Hashable (Hashable(..)) +import Data.Monoid (Monoid(..)) +import Data.Ord (Ord(..), comparing) +import Data.Set (Set) +import qualified Data.Set as Set + +------------------------------------------------------------------------------- + +class EdgeLike e where + getEdgeSource :: e a -> Node a + getEdgeSink :: e a -> Node a + getEdgeCost :: e a -> Maybe Integer + +------------------------------------------------------------------------------- newtype City = City { getCityName :: String } deriving (Eq, Ord, Hashable) + +data Node a + = Node { + nodeValue :: a + } + +data Graph e a + = Graph { + _graphNodes :: Set (Node a) + , _graphEdges :: Set (e a) + } + +makeLenses [''Graph] + +------------------------------------------------------------------------------- + instance Show City where show = show . getCityName +instance Show a => Show (Node a) where + show (Node n) = show n + +instance Hashable a => Hashable (Node a) where + hash (Node n) = 0 `hashWithSalt` n + +instance Hashable a => Eq (Node a) where + a == b = hash a == hash b + +instance (Hashable a) => Ord (Node a) where + compare = comparing hash + +instance (Ord (e a), Hashable a, EdgeLike e) => Monoid (Graph e a) where + mempty = emptyGraph + mappend (Graph n0 e0) (Graph n1 e1) = + Graph (n0 `mappend` n1) + (e0 `mappend` e1) + +------------------------------------------------------------------------------- + +emptyGraph :: Hashable a => Graph e a +emptyGraph = Graph Set.empty Set.empty + +appendNode :: (Hashable a, EdgeLike e) + => Node a + -> Graph e a + -> Graph e a +appendNode node = modL graphNodes (Set.insert node) + + +getNodeNeighbours :: (Hashable a, EdgeLike e) + => Node a + -> Graph e a + -> [(Maybe Integer, Node a)] +getNodeNeighbours n = + Set.fold getOtherNode [] . + getL graphEdges + where + getOtherNode e acc + | getEdgeSource e == n = (getEdgeCost e, getEdgeSink e) : acc + | otherwise = acc +
10 src/Lesson2/UCS.hs
 @@ -1,15 +1,17 @@ module Lesson2.UCS ( main - , UCSGraph(..) + , Graph(..) , UCSEdge(..) - , UCSNode(..) + , Node(..) ) where import Data.Attoparsec.Enumerator (iterParser) import Data.Enumerator (run_, (\$\$)) import Data.Enumerator.Binary (enumFile) +import Lesson2.Enumerator import Lesson2.Types + import Lesson2.UCS.Enumerator import Lesson2.UCS.Parser import Lesson2.UCS.Types @@ -19,9 +21,9 @@ main = do graph <- run_ \$ enumFile "src/Lesson2/Input.txt" \$\$ iterParser parseGraph -- Set the initial State - let startNode = UCSNode (City "Arad") + let startNode = Node (City "Arad") -- Set the goal State - let goalNode = UCSNode (City "Bucharest") + let goalNode = Node (City "Bucharest") -- Run basic UCS result <- run_ \$ enumUCS startNode graph \$\$ consumeTillNode goalNode -- Print visit order
24 src/Lesson2/UCS/Enumerator.hs
 @@ -16,20 +16,21 @@ import Data.Ord (Ord(..), comparing) import qualified Data.Set as Set +import Lesson2.Types import Lesson2.UCS.Types ------------------------------------------------------------------------------- newtype FrontierEntry a - = FE { fromFE :: (Integer, UCSNode a) } + = FE { fromFE :: (Integer, Node a) } deriving (Show, Eq, Ord) ------------------------------------------------------------------------------- enumUCS :: (MonadIO m, Show a, Hashable a) - => UCSNode a + => Node a -> UCSGraph a - -> Enumerator (UCSNode a) m b + -> Enumerator (Node a) m b enumUCS source0 g = go Set.empty (Set.singleton \$ FE (0, source0)) where @@ -43,7 +44,7 @@ enumUCS source0 g = let explored = Set.insert source explored0 let frontier = Set.union frontier1 . Set.fromList . - Prelude.map (\(c, n) -> FE (i + c, n)) . + Prelude.map (\(Just c, n) -> FE (i + c, n)) . Prelude.filter ((`Set.notMember` explored) . snd) \$ getNodeNeighbours source g @@ -52,19 +53,4 @@ enumUCS source0 g = ------------------------------------------------------------------------------- -consumeTillNode :: (Monad m, Hashable a) - => UCSNode a - -> Iteratee (UCSNode a) m [UCSNode a] -consumeTillNode dest = continue \$ go [] - where - go acc EOF = yield [] EOF - go acc (Chunks []) = continue \$ go acc - go acc (Chunks ns) = Iteratee \$ do - let (as, bs) = span (dest /=) ns - case bs of - [] -> return \$ Continue \$ go \$ acc ++ as - (x:xs) -> return \$ Yield (acc ++ as ++ [x]) (Chunks xs) - -------------------------------------------------------------------------------- -
2 src/Lesson2/UCS/Parser.hs
 @@ -18,7 +18,7 @@ parseCity = tillComma <* comma) where - entry = UCSNode . City . toString + entry = Node . City . toString parseCost = skipSpace *> decimal <* tillEOL <* eol
79 src/Lesson2/UCS/Types.hs
 @@ -1,97 +1,54 @@ -{-# LANGUAGE TemplateHaskell #-} module Lesson2.UCS.Types where import Data.Hashable (Hashable(..)) -import Data.Lens.Common (getL, modL) -import Data.Lens.Template (makeLenses) +import Data.Lens.Common (modL) import Data.List (foldl') -import Data.Monoid (Monoid(..)) import Data.Ord (Ord(..), comparing) import Data.Set (Set) import qualified Data.Set as Set +import Lesson2.Types + ------------------------------------------------------------------------------- -data UCSGraph a - = UCSGraph { - _ucsGraphNodes :: Set (UCSNode a) - , _ucsGraphEdges :: Set (UCSEdge a) - } - -data UCSNode a - = UCSNode { - ucsNodeValue :: a - } +type UCSGraph = Graph UCSEdge data UCSEdge a = UCSEdge { - ucsEdgeSource :: UCSNode a - , ucsEdgeSink :: UCSNode a + ucsEdgeSource :: Node a + , ucsEdgeSink :: Node a , ucsCost :: Integer } -makeLenses [''UCSGraph] - ------------------------------------------------------------------------------- -instance Show a => Show (UCSNode a) where - show (UCSNode n) = show n - instance Show a => Show (UCSEdge a) where - show (UCSEdge a b c) = + show (UCSEdge a b c) = "(" ++ show a ++ ", " ++ show b ++ ") -> " ++ show c -instance Hashable a => Monoid (UCSGraph a) where - mempty = emptyGraph - mappend (UCSGraph n0 e0) (UCSGraph n1 e1) = - UCSGraph (n0 `mappend` n1) - (e0 `mappend` e1) - -instance Hashable a => Hashable (UCSNode a) where - hash (UCSNode a) = 1 `hashWithSalt` a - instance Hashable a => Hashable (UCSEdge a) where hash (UCSEdge a b c) = foldl' hashWithSalt 2 [a, b] + hash c -instance Hashable a => Eq (UCSNode a) where - a == b = hash a == hash b - -instance (Hashable a) => Ord (UCSNode a) where - compare = comparing hash - instance Hashable a => Eq (UCSEdge a) where a == b = hash a == hash b instance Hashable a => Ord (UCSEdge a) where compare = comparing hash -------------------------------------------------------------------------------- +instance EdgeLike UCSEdge where + getEdgeSource = ucsEdgeSource + getEdgeSink = ucsEdgeSink + getEdgeCost = Just . ucsCost -emptyGraph :: UCSGraph a -emptyGraph = UCSGraph Set.empty Set.empty - -appendNode :: Hashable a => UCSNode a -> UCSGraph a -> UCSGraph a -appendNode node = modL ucsGraphNodes (Set.insert node) +------------------------------------------------------------------------------- -appendEdge :: Hashable a - => UCSNode a - -> UCSNode a +appendEdge :: Hashable a + => Node a + -> Node a -> Integer - -> UCSGraph a - -> UCSGraph a -appendEdge a b cost = modL ucsGraphEdges (Set.union otherSet) + -> Graph UCSEdge a + -> Graph UCSEdge a +appendEdge a b cost = modL graphEdges (Set.union otherSet) where otherSet = Set.fromList [UCSEdge a b cost, UCSEdge b a cost] - -------------------------------------------------------------------------------- - -getNodeNeighbours :: Hashable a => UCSNode a -> UCSGraph a -> [(Integer, UCSNode a)] -getNodeNeighbours n = - Set.fold getOtherNode [] . - getL ucsGraphEdges - where - getOtherNode e acc - | ucsEdgeSource e == n = (ucsCost e, ucsEdgeSink e) : acc - | otherwise = acc -