days 11-15

src/Days/Day12.hs

@@ -0,0 +1,59 @@
+module Days.Day12 where
+
+import AOCUtil
+import Data.Bool
+import Data.Char
+import Data.List
+import Data.Maybe
+import Debug.Trace
+import GHC.Arr
+import GHC.Utils.Misc
+
+runA :: IO ()
+runA = interactF "data/day12.txt" solve
+
+runB :: IO ()
+runB = interactF "data/day12.txt" solveB
+
+solve :: String -> String
+solve s = show . bfs [findStart m] $ m
+  where
+    m = readMap s
+
+solveB :: String -> String
+solveB s = show . bfs (getStarts m) $ m
+  where
+    m = setupStarts $ readMap s
+
+data Node = Node {level :: Int, dist :: Maybe Int, isTarget :: Bool} deriving (Show)
+
+type Map = Array (Int, Int) Node
+
+readNode :: Char -> Node
+readNode 'S' = Node {level = 0, dist = Just 0, isTarget = False}
+readNode 'E' = Node {level = 25, dist = Nothing, isTarget = True}
+readNode c = Node {level = fromEnum c - fromEnum 'a', dist = Nothing, isTarget = False}
+
+readMap :: String -> Map
+readMap s = listArray ((0, 0), (length (head ls) - 1, length ls - 1)) . map readNode . concat . transpose $ ls
+  where
+    ls = lines s
+
+findStart :: Map -> (Int, Int)
+findStart = fst . head . filter (isJust . dist . snd) . assocs
+
+setupStarts :: Map -> Map
+setupStarts = amap (\m -> if level m == 0 then m {dist = Just 0} else m)
+
+getStarts :: Map -> [(Int, Int)]
+getStarts = map fst . filter (any (== 0) . dist . snd) . assocs
+
+bfs :: [(Int, Int)] -> Map -> Int
+bfs (p@(x, y) : ns) m
+  | isTarget n = fromJust $ dist n
+  | otherwise = bfs (ns ++ new) $ m // [((x2, y2), (m ! (x2, y2)) {dist = fmap (+ 1) d}) | (x2, y2) <- new]
+  where
+    n = m ! p
+    d = dist n
+    new = filter (isNothing . dist . (m !)) . filter ((<= level n + 1) . level . (m !)) . filter (inRange (bounds m)) $ [(x + 1, y), (x - 1, y), (x, y + 1), (x, y - 1)]
+bfs [] _ = error "dfs could not reach target"