From 6e487b011c611fc2c62537695e4baf93a02bb24e Mon Sep 17 00:00:00 2001 From: Steve Dunham Date: Sat, 14 Dec 2024 22:27:03 -0800 Subject: [PATCH] day15 --- aoc2024/Day15.newt | 110 ++++++++++++++++++++++++++++++++++++++++ aoc2024/day15/eg.txt | 21 ++++++++ src/Lib/Parser/Impl.idr | 3 +- 3 files changed, 133 insertions(+), 1 deletion(-) create mode 100644 aoc2024/Day15.newt create mode 100644 aoc2024/day15/eg.txt diff --git a/aoc2024/Day15.newt b/aoc2024/Day15.newt new file mode 100644 index 0000000..48c3864 --- /dev/null +++ b/aoc2024/Day15.newt @@ -0,0 +1,110 @@ +module Day15 + +import Prelude +import Node +import SortedMap +import Aoc + +gridPoints : String → List (Char × Int × Int) +gridPoints text = go 0 0 (unpack text) Nil + where + go : Int → Int → List Char → List (Char × Int × Int) → List (Char × Int × Int) + go row col Nil points = points + go row col ('\n' :: cs) points = go (row + 1) 0 cs points + go row col (c :: cs) points = go row (col + 1) cs ((c,row,col) :: points) + +Grid : U +Grid = SortedMap Point Char + +getDir : Char → Maybe Point +getDir '^' = Just (0 - 1, 0) +getDir '>' = Just (0, 1) +getDir 'v' = Just (1, 0) +getDir '<' = Just (0, 0 - 1) +getDir _ = Nothing + +getGrid : String → Grid +getGrid text = foldl update EmptyMap $ gridPoints text + where + update : Grid → Char × Point → Grid + update grid (c,pt) = updateMap pt c grid + +Problem : U +Problem = Grid × List Point + +parseFile : String → Either String Problem +parseFile text = + let (a :: b :: Nil) = split text "\n\n" | xs => Left $ (show $ length xs) ++ " parts" + in Right (getGrid a, mapMaybe getDir (unpack b)) + +-- Move thing at Point in direction +tryMove : Grid → Point → Point -> Maybe Grid +tryMove grid pt dir = + let x = lookupMap pt grid in + case lookupMap pt grid of + Just (_, '.') => Just grid -- noop moving empty space + Just (_, '#') => Nothing -- fail to move wall + Just (_, '[') => + if fst dir == 0 then do + grid <- tryMove grid (pt + dir) dir + Just $ updateMap pt '.' (updateMap (pt + dir) '[' grid) + else do + grid <- tryMove grid (pt + dir) dir + grid <- tryMove grid (pt + (0,1) + dir) dir + let grid = updateMap pt '.' (updateMap (pt + dir) '[' grid) + let grid = updateMap (pt + (0,1)) '.' (updateMap (pt + (0,1) + dir) ']' grid) + Just grid + Just (_, ']') => + if fst dir == 0 then do + grid <- tryMove grid (pt + dir) dir + Just $ updateMap pt '.' (updateMap (pt + dir) ']' grid) + else do + grid <- tryMove grid (pt + dir) dir + grid <- tryMove grid (pt + (0,0 - 1) + dir) dir + let grid = updateMap pt '.' (updateMap (pt + dir) ']' grid) + let grid = updateMap (pt + (0,0 - 1)) '.' (updateMap (pt + (0,0 - 1) + dir) '[' grid) + Just grid + Just (_, c) => do + grid <- tryMove grid (pt + dir) dir + Just $ updateMap pt '.' (updateMap (pt + dir) c grid) + Nothing => Nothing + +step : Grid × Point → Point → Grid × Point +step (grid, pt) dir = case tryMove grid pt dir of + Just grid => (grid, pt + dir) + Nothing => (grid, pt) + +fromList : ∀ k v. {{Ord k}} {{Eq k}} → List (k × v) → SortedMap k v +fromList xs = foldMap (\ a b => b) EmptyMap xs + +mkPart2 : Grid → Grid +mkPart2 = fromList ∘ go Nil ∘ toList + where + go : List (Point × Char) → List (Point × Char) → List (Point × Char) + go acc Nil = acc + go acc (((r,c), '@') :: rest) = go (((r, 2 * c), '@') :: ((r, 2 * c + 1), '.') :: acc) rest + go acc (((r,c), 'O') :: rest) = go (((r,2 * c), '[') :: ((r, 2 * c + 1), ']') :: acc) rest + go acc (((r,c), ch) :: rest) = go (((r,2 * c), ch) :: ((r, 2 * c + 1), ch) :: acc) rest + +gps : Point → Int +gps (x,y) = x * 100 + y + +run : String -> IO Unit +run fn = do + putStrLn fn + text <- readFile fn + let (Right (grid,steps)) = parseFile text | Left err => putStrLn $ "Error " ++ err + let ((start,_) :: Nil) = filter ((_==_ '@') ∘ snd) $ toList grid | x => debugLog x + let (grid', end) = foldl step (grid, start) steps + let p1 = foldl _+_ 0 $ map (gps ∘ fst) $ filter (_==_ 'O' ∘ snd) $ toList grid' + putStrLn $ "part1 " ++ show p1 + let grid2 = mkPart2 grid + let ((start,_) :: Nil) = filter ((_==_ '@') ∘ snd) $ toList grid2 | x => debugLog x + let (grid2', end) = foldl step (grid2, start) steps + let p2 = foldl _+_ 0 $ map (gps ∘ fst) $ filter (_==_ '[' ∘ snd) $ toList grid2' + putStrLn $ "part2 " ++ show p2 + +main : IO Unit +main = do + run "aoc2024/day15/eg.txt" + run "aoc2024/day15/input.txt" diff --git a/aoc2024/day15/eg.txt b/aoc2024/day15/eg.txt new file mode 100644 index 0000000..b2bce78 --- /dev/null +++ b/aoc2024/day15/eg.txt @@ -0,0 +1,21 @@ +########## +#..O..O.O# +#......O.# +#.OO..O.O# +#..O@..O.# +#O#..O...# +#O..O..O.# +#.OO.O.OO# +#....O...# +########## + +^v>^vv^v>v<>v^v<<><>>v^v^>^<<<><^ +vvv<<^>^v^^><<>>><>^<<><^vv^^<>vvv<>><^^v>^>vv<>v<<<^<^^>>>^<>vv>v^v^<>><>>>><^^>vv>v<^^^>>v^v^<^^>v^^>v^<^v>v<>>v^v^v^^<^^vv< +<>^^^^>>>v^<>vvv^>^^^vv^^>v<^^^^v<>^>vvvv><>>v^<<^^^^^ +^><^><>>><>^^<<^^v>>><^^>v>>>^v><>^v><<<>vvvv>^<><<>^>< +^>><>^v<><^vvv<^^<><^v<<<><<<^^<^>>^<<<^>>^v^>>^v>vv>^<<^v<>><<><<>v<^vv<<<>^^v^>^^>>><<^v>>v^v><^^>>^<>vv^ +<><^^>^^^<>^vv<<^><<><<><<<^^<<<^<<>><<><^^^>^^<>^>v<> +^^>vv<^v^v^<>^^^>>>^^vvv^>vvv<>>>^<^>>>>>^<<^v>^vvv<>^<>< +v^^>>><<^^<>>^v^v^<<>^<^v^v><^<<<><<^vv>>v>v^<<^ \ No newline at end of file diff --git a/src/Lib/Parser/Impl.idr b/src/Lib/Parser/Impl.idr index db58b87..4efac50 100644 --- a/src/Lib/Parser/Impl.idr +++ b/src/Lib/Parser/Impl.idr @@ -195,7 +195,8 @@ token' k = pred (\t => t.val.kind == k) "Expected a \{show k} token" export keyword' : String -> Parser () -keyword' kw = ignore $ pred (\t => t.val.text == kw) "Expected \{kw}" +-- FIXME make this an appropriate whitelist +keyword' kw = ignore $ pred (\t => t.val.text == kw && t.val.kind /= Character) "Expected \{kw}" ||| expect indented token of given kind export