Day 17
This commit is contained in:
@@ -116,3 +116,10 @@ executable day16
|
|||||||
hs-source-dirs: day16
|
hs-source-dirs: day16
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
default-extensions: LambdaCase
|
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
52
day17/Commons.hs
Normal 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 :: 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
|
||||||
14
day17/Main.hs
Normal file
14
day17/Main.hs
Normal 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
30
day17/Part1.hs
Normal 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
34
day17/Part2.hs
Normal 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]]
|
||||||
Reference in New Issue
Block a user