Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Removing duplicated code from sources

  • Loading branch information...
commit fb6c6c7a46ff1b0a71b243b7066e5edc471bc83b 1 parent c375b0f
@roman authored
View
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
View
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)
-
--------------------------------------------------------------------------------
-
View
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
View
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]
View
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)
+
View
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
+
View
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
View
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)
-
--------------------------------------------------------------------------------
-
View
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
View
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
-
Please sign in to comment.
Something went wrong with that request. Please try again.