From a8d5a792351219d63c11722cae029dadd3d34881 Mon Sep 17 00:00:00 2001 From: RhiobeT Date: Sun, 17 Dec 2023 17:26:34 +0100 Subject: [PATCH] Day 17 --- advent-of-code-2023.cabal | 7 ++++++ day17/Commons.hs | 52 +++++++++++++++++++++++++++++++++++++++ day17/Main.hs | 14 +++++++++++ day17/Part1.hs | 30 ++++++++++++++++++++++ day17/Part2.hs | 34 +++++++++++++++++++++++++ 5 files changed, 137 insertions(+) create mode 100644 day17/Commons.hs create mode 100644 day17/Main.hs create mode 100644 day17/Part1.hs create mode 100644 day17/Part2.hs diff --git a/advent-of-code-2023.cabal b/advent-of-code-2023.cabal index b81f0da..c31394e 100644 --- a/advent-of-code-2023.cabal +++ b/advent-of-code-2023.cabal @@ -116,3 +116,10 @@ executable day16 hs-source-dirs: day16 default-language: Haskell2010 default-extensions: LambdaCase + +executable day17 + main-is: Main.hs + other-modules: Commons Part1 Part2 + build-depends: base ^>=4.15.1.0, array, containers, pqueue + hs-source-dirs: day17 + default-language: Haskell2010 diff --git a/day17/Commons.hs b/day17/Commons.hs new file mode 100644 index 0000000..25d22b4 --- /dev/null +++ b/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 diff --git a/day17/Main.hs b/day17/Main.hs new file mode 100644 index 0000000..a53ca6a --- /dev/null +++ b/day17/Main.hs @@ -0,0 +1,14 @@ +module Main where + +import Commons +import Data.Array (bounds) +import Data.Map ((!)) +import qualified Part1 +import qualified Part2 + + +main = do city <- parse + let part1Res = Part1.getAllAstar city + print $ minimum part1Res + let part2Res = Part2.getAllAstar city + print $ minimum part2Res diff --git a/day17/Part1.hs b/day17/Part1.hs new file mode 100644 index 0000000..80b72f2 --- /dev/null +++ b/day17/Part1.hs @@ -0,0 +1,30 @@ +module Part1 where + +import Commons +import Data.Array (Ix(inRange), bounds, (!)) +import Data.Maybe (catMaybes) + + +cleanAstarNext :: City -> [Node] -> [(Node, Int)] +cleanAstarNext city = map (\ (c, d, n) -> ((c, d, n), city ! c)) + . filter (\ ((y, x), _, n) -> inRange (bounds city) (y, x) && n <= 3) + +astarNext :: City -> Node -> [(Node, Int)] +astarNext city ((y, x), East, n) = cleanAstarNext city [((y - 1, x), North, 1), + ((y + 1, x), South, 1), + ((y, x + 1), East, n + 1)] +astarNext city ((y, x), South, n) = cleanAstarNext city [((y + 1, x), South, n + 1), + ((y, x + 1), East, 1), + ((y, x - 1), West, 1)] +astarNext city ((y, x), West, n) = cleanAstarNext city [((y - 1, x), North, 1), + ((y + 1, x), South, 1), + ((y, x - 1), West, n + 1)] +astarNext city ((y, x), North, n) = cleanAstarNext city [((y - 1, x), North, n + 1), + ((y, x + 1), East, 1), + ((y, x - 1), West, 1)] + +applyAstar :: City -> Direction -> Int -> Maybe Int +applyAstar city d n = astar ((1, 1), East, 0) (snd $ bounds city, d, n) (astarNext city) astarEstimation + +getAllAstar :: City -> [Int] +getAllAstar city = catMaybes [applyAstar city d n | d <- [East, South], n <- [1..3]] diff --git a/day17/Part2.hs b/day17/Part2.hs new file mode 100644 index 0000000..cd771e5 --- /dev/null +++ b/day17/Part2.hs @@ -0,0 +1,34 @@ +module Part2 where + +import Commons +import Data.Array (Ix(inRange), bounds, (!)) +import Data.Maybe (catMaybes) + + +cleanAstarNext :: City -> [Node] -> [(Node, Int)] +cleanAstarNext city = map (\ (c, d, n) -> ((c, d, n), city ! c)) + . filter (\ ((y, x), _, n) -> inRange (bounds city) (y, x) && n <= 10) + +astarNext :: City -> Node -> [(Node, Int)] +astarNext city ((y, x), East, n) | n < 4 = cleanAstarNext city [((y, x + 1), East, n + 1)] + | otherwise = cleanAstarNext city [((y - 1, x), North, 1), + ((y + 1, x), South, 1), + ((y, x + 1), East, n + 1)] +astarNext city ((y, x), South, n) | n < 4 = cleanAstarNext city [((y + 1, x), South, n + 1)] + | otherwise = cleanAstarNext city [((y + 1, x), South, n + 1), + ((y, x + 1), East, 1), + ((y, x - 1), West, 1)] +astarNext city ((y, x), West, n) | n < 4 = cleanAstarNext city [((y, x - 1), West, n + 1)] + | otherwise = cleanAstarNext city [((y - 1, x), North, 1), + ((y + 1, x), South, 1), + ((y, x - 1), West, n + 1)] +astarNext city ((y, x), North, n) | n < 4 = cleanAstarNext city [((y - 1, x), North, n + 1)] + | otherwise = cleanAstarNext city [((y - 1, x), North, n + 1), + ((y, x + 1), East, 1), + ((y, x - 1), West, 1)] + +applyAstar :: City -> Direction -> Int -> Maybe Int +applyAstar city d n = astar ((1, 1), East, 0) (snd $ bounds city, d, n) (astarNext city) astarEstimation + +getAllAstar :: City -> [Int] +getAllAstar city = catMaybes [applyAstar city d n | d <- [East, South], n <- [4..10]]