Done day 23 part 1
[advent-of-code-23.git] / advent23 / Main.hs
1 -- Writeup at https://work.njae.me.uk/2023/12/29/advent-of-code-2023-day-21/
2
3 import AoC
4 import Linear (V2(..), (^+^))
5 import qualified Data.Set as S
6 import qualified Data.Map as M
7
8 data Slide = SlideLeft | SlideRight | SlideUp | SlideDown
9 deriving (Show, Eq)
10
11 type Position = V2 Int -- r, c
12 type Grid = S.Set Position
13 type Slides = M.Map Position Slide
14
15 main :: IO ()
16 main =
17 do dataFileName <- getDataFileName
18 text <- readFile dataFileName
19 let (forest, slides, start, end) = mkGrid text
20 -- print forest
21 -- print slides
22 -- print start
23 -- print end
24 -- print $ searchStep slides forest [start ^+^ (V2 1 0), start]
25 -- let paths = search slides forest end [] [[start ^+^ (V2 1 0), start]]
26 -- print $ fmap length paths
27 print $ part1 slides forest start end
28
29 part1 slides forest start end = (maximum $ fmap length paths) - 1
30 where paths = search slides forest end [] [[start ^+^ (V2 1 0), start]]
31
32 adjacents :: Position -> Slides -> Grid -> [Position]
33 adjacents here slides walls = filter (`S.notMember` walls) $ fmap (^+^ here) deltas
34 where deltas = case M.lookup here slides of
35 Nothing -> [ V2 0 1, V2 1 0, V2 0 (-1), V2 (-1) 0 ]
36 Just SlideLeft -> [ V2 0 (-1) ]
37 Just SlideRight -> [ V2 0 1 ]
38 Just SlideUp -> [ V2 (-1) 0 ]
39 Just SlideDown -> [ V2 1 0 ]
40
41 searchStep :: Slides -> Grid -> [Position] -> [[Position]]
42 searchStep _ _ [] = []
43 searchStep slides forest path@(here:rest) = fmap (:path) valids
44 where nexts = adjacents here slides forest
45 valids = filter (`notElem` rest) nexts
46
47
48 search :: Slides -> Grid -> Position -> [[Position]] -> [[Position]] -> [[Position]]
49 search _ _ _ foundPaths [] = foundPaths
50 search slides forest goal foundPaths (current:agenda)
51 | head current == goal = search slides forest goal (current:foundPaths) agenda
52 | otherwise = search slides forest goal foundPaths (agenda ++ extendeds)
53 where extendeds = searchStep slides forest current
54
55
56 -- showGrid :: Grid -> (Position, Position) -> Grid -> String
57 -- showGrid rocks bounds cells = unlines $ intercalate [" "] $ chunksOf 7 $ fmap (showRow rocks bounds cells) [-28..34]
58 -- where showRow rocks bounds cells r = intercalate " " $ chunksOf 7 $ fmap ((showCell rocks bounds cells) . V2 r) [-28..34]
59 -- showCell rocks bounds cells here
60 -- | not $ notAtRock rocks bounds here = '#'
61 -- | here `S.member` cells = 'O'
62 -- | otherwise = '.'
63
64 -- reading the map
65
66 mkGrid :: String -> (Grid, Slides, Position, Position)
67 mkGrid text = (forest, slides, start, end)
68 where rows = lines text
69 maxR = length rows - 1
70 maxC = (length $ head rows) - 1
71 forest = S.fromList [ V2 r c | r <- [0..maxR], c <- [0..maxC]
72 , rows !! r !! c == '#'
73 ]
74 slides = M.fromList [ (V2 r c, readSlide (rows !! r !! c))
75 | r <- [0..maxR], c <- [0..maxC]
76 , elem (rows !! r !! c) ("<>^v" :: String)
77 ]
78 start = head $ [ V2 0 c | c <- [0..maxC]
79 , rows !! 0 !! c == '.'
80 ]
81 end = head $ [ V2 maxR c | c <- [0..maxC]
82 , rows !! maxR !! c == '.'
83 ]
84
85 readSlide :: Char -> Slide
86 readSlide '<' = SlideLeft
87 readSlide '>' = SlideRight
88 readSlide '^' = SlideUp
89 readSlide 'v' = SlideDown