Day 14, Part 2

adventofcode2024.cabal

@@ -58,4 +58,5 @@ executable adventofcode2024
     Day13.Puzzle1
     Day13.Puzzle2
     Day14.Puzzle1
+    Day14.Puzzle2
     Day15.Puzzle1

src/Day14/Puzzle2.hs

@@ -0,0 +1,42 @@
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+module Day14.Puzzle2 (day14_2) where
+
+import Data.Char (isDigit)
+import Data.List (nub)
+import Data.List.Split (splitOn)
+
+type Position = (Int, Int)
+
+type Velocity = (Int, Int)
+
+type Robot = (Position, Velocity)
+
+readRobot :: String -> Robot
+readRobot s =
+  let [ps, vs] = splitOn " " s
+      [px, py] = map read . splitOn "," $ filter (\x -> isDigit x || x == ',' || x == '-') ps
+      [vx, vy] = map read . splitOn "," $ filter (\x -> isDigit x || x == ',' || x == '-') vs
+   in ((px, py), (vx, vy))
+
+moveRobot :: Robot -> Robot
+moveRobot r =
+  let (px, py) = fst r
+      (vx, vy) = snd r
+   in (((px + vx) `mod` 101, (py + vy) `mod` 103), (vx, vy))
+
+findChristmasTree :: Int -> [Robot] -> Int
+findChristmasTree n rs =
+  let rs' = map moveRobot rs
+      positions = map fst rs'
+   in if positions == nub positions
+        then n
+        else findChristmasTree (n + 1) rs'
+
+day14_2 :: IO ()
+day14_2 = do
+  contents <- lines <$> readFile "input/day14.txt"
+  let robots = map readRobot contents
+  putStrLn $
+    "Day 14, Puzzle 2 solution: "
+      ++ show (findChristmasTree 1 robots)

src/Main.hs

@@ -25,6 +25,7 @@ import Day12.Puzzle1
 import Day13.Puzzle1
 import Day13.Puzzle2
 import Day14.Puzzle1
+import Day14.Puzzle2
 import Day15.Puzzle1
 import System.Environment (getArgs)
 
@@ -57,5 +58,6 @@ main = do
     "13" : "1" : _ -> day13_1
     "13" : "2" : _ -> day13_2
     "14" : "1" : _ -> day14_1
+    "14" : "2" : _ -> day14_2
     "15" : "1" : _ -> day15_1
     _ -> error "Not implemented"