Day 17

day17/Commons.hs

@@ -0,0 +1,52 @@
+module Commons where
+
+import GHC.IO.Handle (isEOF)
+import Data.Set (Set, insert, notMember, empty)
+import Data.Array (Array, listArray)
+import Data.Char (digitToInt)
+import qualified Data.PQueue.Prio.Min as P
+import qualified Data.Map as M
+
+
+data Direction = North | East | South | West deriving (Ord, Eq, Show)
+type Node = ((Int, Int), Direction, Int)
+type City = Array (Int, Int) Int
+
+
+parseLine :: String -> [Int]
+parseLine = map digitToInt
+
+parseCity :: IO [[Int]]
+parseCity = do done <- isEOF
+               if done
+                  then return []
+                  else do line <- getLine
+                          let cityLine = parseLine line
+                          city <- parseCity
+                          return (cityLine: city)
+
+parse :: IO City
+parse = do city <- parseCity
+           return $ listArray ((1, 1), (length city, length $ head city)) $ concat city
+
+
+astarEstimation :: Node -> Node -> Int
+astarEstimation ((yF, xF), _, _) ((y, x), _, _) = abs (yF - y) + abs (xF - x)
+
+astarIteration :: Ord node => (node -> [(node, Int)]) -> (node -> node -> Int) -> node ->
+                  P.MinPQueue Int (node, Int) -> Set node -> M.Map node Int -> Maybe Int
+astarIteration next estimation goal open closed costs
+  | null open = Nothing
+  | otherwise = let ((_, (node, cost)), openNoMin) = P.deleteFindMin open
+                    newClosed = insert node closed
+                    nextNodes = filter (\ (n, c) -> (n `notMember` closed)
+                                                    && (n `M.notMember` costs || costs M.! n > c + cost)) $ next node
+                    estNextNodes = map (\ (n, c) -> (n, c + cost, estimation n goal)) nextNodes
+                    newOpen = foldl (\ open (n, c, e) -> P.insert (c + e) (n, c) open) openNoMin estNextNodes
+                    newCosts = foldl (\ costs (n, c, _) -> M.insert n c costs) costs estNextNodes
+                in if node == goal then Just cost
+                   else astarIteration next estimation goal newOpen newClosed newCosts
+
+astar :: Ord node => node -> node -> (node -> [(node, Int)]) -> (node -> node -> Int) -> Maybe Int
+astar start end next estimation = astarIteration next estimation end (P.singleton (estimation start end) (start, 0))
+                                                 empty $ M.singleton start 0