rhiobet/advent-of-code-2023
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Day 17

Browse Source
This commit is contained in:
RhiobeT Chan
2023-12-17 17:26:34 +01:00
parent e772a7617c
commit bec5a41811
5 changed files with 137 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
advent-of-code-2023.cabal
View File

@@ -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

52
day17/Commons.hs Normal file
View File

@@ -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 :: (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 :: 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

14
day17/Main.hs Normal file
View File

@@ -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

30
day17/Part1.hs Normal file
View File

@@ -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]]

34
day17/Part2.hs Normal file
View File

@@ -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]]