Remove visualization code from main solution

Author: mnvr

17.hs

@@ -1,16 +1,20 @@
 import Data.Map qualified as M
 import Data.Set qualified as S
-import Data.Maybe (fromJust, fromMaybe)
-import Data.List (find)
-
--- A variation of 17.hs that shows the discovered path
+import Control.Arrow ((&&&))
 
 main :: IO ()
-main = interact $ unlines . (\grid -> concat [p1 grid, p2 grid]) . parse
+main = interact $ (++ "\n") . show . (p1 &&& p2) . parse
 
 type Node = (Int, Int)
 data Grid a = Grid { items :: M.Map Node a, lastNode :: Node }
 
+parse :: String -> Grid Int
+parse s = Grid { items = M.fromList xs, lastNode = fst (last xs) }
+  where xs = [((x, y), read [c]) | (y, l) <- enum (lines s), (x, c) <- enum l]
+
+enum :: [a] -> [(Int, a)]
+enum = zip [0..]
+
 data Direction = L | R | U | D deriving (Eq, Ord)
 data Cell = Cell {
   node :: Node, direction :: Direction,
@@ -20,13 +24,6 @@ data Cell = Cell {
 
 data Neighbour = Neighbour { cell :: Cell, distance :: Int }
 
-parse :: String -> Grid Int
-parse s = Grid { items = M.fromList xs, lastNode = fst (last xs) }
-  where xs = [((x, y), read [c]) | (y, l) <- enum (lines s), (x, c) <- enum l]
-
-enum :: [a] -> [(Int, a)]
-enum = zip [0..]
-
 neighbours :: Grid Int -> [Int] -> Cell -> [Neighbour]
 neighbours Grid { items } range = filter inRange . adjacent
   where
@@ -50,29 +47,28 @@ neighbours Grid { items } range = filter inRange . adjacent
       _ -> (d, xs)
     inRange Neighbour { cell } = moves cell `elem` range
 
--- Find the shortest path from start to an end using Dijkstra's algorithm.
-dijkstra :: Grid Int -> Node -> (Cell -> Bool) -> [Int] -> (Maybe Int, [String])
-dijkstra grid@Grid { items } start isEnd range =
-  go (M.singleton startCell 0) M.empty S.empty (singleton (0, startCell))
+shortestPath :: [Int] -> Grid Int -> Int
+shortestPath moveRange grid@Grid { items, lastNode } =
+  go (M.singleton startCell 0) S.empty (singleton (0, startCell))
   where
     -- By setting moves to 0, the starting cell's considers both the left and
     -- down neighbours as equivalent (which is what we want).
-    startCell = Cell { node = start, direction = L, moves = 0 }
-
-    go ds parent seen q = case extractMin q of
-        Nothing -> (Nothing, [])
-        Just ((du, u), q')
-          | isEnd u -> (Just du, showDistanceMap grid ds parent u range)
-          | u `S.member` seen -> go ds parent seen q'
-          | otherwise ->
-             let adj = neighbours grid range u
-                 (ds', parent', q'') = foldl (relax u du) (ds, parent, q') adj
-             in go ds' parent' (S.insert u seen) q''
-
-    relax u du (ds, parent, q) Neighbour { cell = v, distance = d } =
+    startCell = Cell { node = (0, 0), direction = L, moves = 0 }
+    isEnd Cell { node } = node == lastNode
+
+    go ds seen q = case extractMin q of
+      Nothing -> 0
+      Just ((du, u), q')
+        | isEnd u -> du
+        | S.member u seen -> go ds seen q'
+        | otherwise -> let adj = neighbours grid moveRange u
+                           (ds', q'') = foldl (relax u du) (ds, q') adj
+                       in go ds' (S.insert u seen) q''
+
+    relax u du (ds, q) Neighbour { cell = v, distance = d } =
       let d' = du + d in case M.lookup v ds of
-        Just dv | dv < d' -> (ds, parent, q)
-        _ -> (M.insert v d' ds, M.insert v u parent, insert (d', v) q)
+        Just dv | dv < d' -> (ds, q)
+        _ -> (M.insert v d' ds, insert (d', v) q)
 
 data Heap a = Empty | Heap a (Heap a) (Heap a)
 
@@ -93,30 +89,6 @@ singleton x = Heap x Empty Empty
 insert :: Ord a => a -> Heap a -> Heap a
 insert x h = singleton x `union` h
 
-showDistanceMap :: Grid a -> M.Map Cell Int -> M.Map Cell Cell -> Cell -> [Int] -> [String]
-showDistanceMap Grid { lastNode = (mx, my) } ds parent end range = map line [0..my]
-  where
-    path = retrace S.empty end
-      where retrace s n = let s' = S.insert n s in case M.lookup n parent of
-              Nothing -> s'
-              Just p -> retrace s' p
-    isOnPath cell = S.member cell path
-    line y = unwords $ map dist [0..mx]
-      where dist x = showCell $ find isOnPath [
-              Cell {node = (x, y), direction = d, moves }
-              | d <- [L, R, U, D], moves <- range]
-            showCell Nothing = "   .   "
-            showCell (Just cell@Cell { node, moves }) =
-              " " ++ d ++ " " ++ show moves ++ " "
-                where d = pad3 $ show $ fromJust $ M.lookup cell ds
-                      pad3 s = reverse $ take 3 (reverse ("   " ++ s))
-
-p1, p2 :: Grid Int -> [String]
-p1 grid = runP grid [1..3]
-p2 grid = runP grid [4..10]
-
-runP :: Grid Int -> [Int] -> [String]
-runP grid range = let (r, zs) = dijkstra grid (0, 0) isEnd range
-          in zs ++ ["shortest-path result " ++ (show $ fromMaybe (-1) r)]
-  where
-    isEnd Cell { node } = node == (lastNode grid)
+p1, p2 :: Grid Int -> Int
+p1 = shortestPath [1..3]
+p2 = shortestPath [4..10]