working dijkstra

03_dijkstra/LeastReachableCity.hs

@@ -0,0 +1,65 @@
+module LeastReachableCity  where
+
+import Types 
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+infinity :: Len
+infinity = 999999 :: Len
+
+dijkstra :: Point -> Graph -> Distances
+dijkstra start graph = dijkstra' start graph visited_init to_visit_init distances_init where
+    -- Helper
+    dijkstra' :: Point -> Graph -> Vertices -> Vertices -> Distances -> Distances 
+    dijkstra' start graph visited to_visit distances = if Set.null to_visit 
+        then 
+            distances
+        else
+            dijkstra' 
+                (findMinNotVisited to_visit distances) 
+                graph 
+                (Set.insert start visited) 
+                (Set.union (Set.delete start to_visit) $ findNotVisitedNeighbours graph visited start) 
+                (updateDistances graph start distances)
+    -- Other
+    to_visit_init = (Set.insert start $ Set.empty :: Set.Set Point)
+    distances_init = (infinityDistances start $ countVertices graph)
+    visited_init = (Set.empty :: Set.Set Point) 
+
+updateDistances :: Graph -> Point -> Distances -> Distances
+updateDistances graph point distances = snd $ Map.foldrWithKey decideMin ((point, Map.findWithDefault (-1) point distances), Map.empty :: Distances) distances where
+    decideMin ::  Point -> Len -> ((Point, Len), Distances) -> ((Point, Len), Distances)
+    decideMin p' l' ((p, l), dist) = if findDistance graph p p' + l < l' then 
+        ((p, l), Map.insert p' (l + findDistance graph p p') dist) else
+        ((p, l), Map.insert p' l' dist)
+
+findDistance :: Graph -> Point -> Point -> Len
+findDistance ((Node (a, b, len)) : graph) p p' = if ((a == p) && (b == p') || (b == p) && (a == p')) then len else findDistance graph p p'  
+findDistance _ _ _ = infinity
+
+findMinNotVisited :: Vertices -> Distances -> Point  
+findMinNotVisited to_visit distances = fst $ Set.foldl (\(p, l) p' -> case Map.lookup p' distances of 
+    (Just l') -> if l' < l then 
+            (p', l') 
+        else (p,l)) 
+    (-1, maxBound) to_visit 
+
+infinityDistances :: Point -> Int -> Distances
+infinityDistances point n = Map.fromList $ (point, 0) : [(x, infinity) | x <- [1..n], x /= point] 
+
+countVertices :: Graph -> Int
+countVertices graph = snd $ foldl f (Set.empty :: Set.Set Point, 0) graph where
+    f :: (Vertices, Int) -> Node -> (Vertices, Int)
+    f (vertices, n) (Node (a, b, _)) = 
+        let aIsNotMember = not $ Set.member a vertices 
+            bIsNotMember = not $ Set.member b vertices in if (aIsNotMember && bIsNotMember) then (Set.insert a $ Set.insert b vertices, n + 2) 
+                else if (aIsNotMember) then (Set.insert a vertices, n + 1) 
+                    else if (bIsNotMember) then (Set.insert b vertices, n + 1) 
+                        else (vertices, n)
+
+findNotVisitedNeighbours :: Graph -> Vertices -> Point -> Vertices 
+findNotVisitedNeighbours graph visited point = foldl f (Set.empty :: Vertices) graph where
+    f :: Vertices -> Node -> Vertices 
+    f vertices (Node (a, b, _)) = if ((a == point) && (not $ Set.member b visited)) then Set.insert b vertices 
+        else if ((b == point) && (not $ Set.member a visited)) then Set.insert a vertices
+            else vertices

03_dijkstra/Types.hs

@@ -0,0 +1,13 @@
+module Types where
+
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+type Point = Int
+type Len = Int
+    
+data Node = Node (Point, Point, Len) deriving Show
+type Graph = [Node]
+
+type Distances = Map.Map Point Len
+type Vertices = Set.Set Point

03_dijkstra/main.hs

@@ -0,0 +1,51 @@
+module Main where
+
+import System.IO 
+import System.Environment
+import System.Directory
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+import LeastReachableCity
+import Types
+
+{- format of input file is:
+ - mileage
+ - from to len
+ - from to len
+ - ...
+ - where "from" and "to" are numbers of graph vertices, "len" is distance between them
+ - -}
+main :: IO()
+main = do
+    argv <- getArgs
+
+    filename <- if not $ null argv then do
+        putStrLn $ "Trying to read file " ++ "\"" ++ head argv ++ "\""
+        head <$> getArgs
+    else do
+        error "Not enough arguments,\nusage: main [filename]"
+
+    content <- readFile filename
+    let mileage = read $ head $ lines content :: Len
+    
+    let graph = readGraph $ tail content
+    --let dist = findNeighbours 1 graph
+    --print $ findNotVisitedNeighbours graph (Set.fromList [1,3]) 2
+    print $ dijkstra 1 graph 
+    --print $ updateDistances graph 2 (Map.fromList [(1, 100), (2, 1), (3, 200)])  
+    --print $ infinityDistances 1 4
+    --print $ findMinNotVisited (Set.fromList [1, 2, 3] :: Set.Set Int) (Map.fromList [(1, 123), (2, 114), (3, 115)]) 
+
+{- For parsing graph using content of the file -} 
+parseStrNode :: [String] -> Node
+parseStrNode [a, b, c] = Node (p a, p b, l c) where
+    p x = read x :: Point
+    l x = read x :: Len
+
+readGraph :: String -> Graph
+readGraph content = parse lst where
+            parse (x:xs) = if length ws == 3 then (parseStrNode ws) : (parse xs) else parse xs where
+                ws = words x
+            parse _ = [] 
+            lst = lines content