Day 9 - Part 2

aoc2022.cabal

@@ -48,6 +48,7 @@ library
       Day7.Interpreter
       Day7.Parser
       Day8
+      Day9
       Lib
       Shared
   other-modules:
@@ -67,6 +68,7 @@ library
     , parsec
     , split
     , text
+    , transformers
     , vector
   default-language: Haskell2010
 
@@ -90,6 +92,7 @@ executable aoc2022-exe
     , parsec
     , split
     , text
+    , transformers
     , vector
   default-language: Haskell2010
 
@@ -105,6 +108,7 @@ test-suite aoc2022-test
       Day6Spec
       Day7Spec
       Day8Spec
+      Day9Spec
       Paths_aoc2022
   hs-source-dirs:
       test
@@ -122,5 +126,6 @@ test-suite aoc2022-test
     , parsec
     , split
     , text
+    , transformers
     , vector
   default-language: Haskell2010

package.yaml

@@ -33,6 +33,7 @@ dependencies:
 - matrix
 - vector
 - megaparsec
+- transformers
 
 ghc-options:
 - -Wall

src/Day9.hs

@@ -0,0 +1,116 @@
+module Day9
+  ( parseMovements,
+    Move (..),
+    Grid (..),
+    up,
+    down,
+    left,
+    right,
+    diag,
+    still,
+    step,
+    recordPositions,
+    normalizeMovement,
+    Step (..),
+    follow,
+    buildTails,
+    day9,
+  )
+where
+
+import Control.Arrow ((>>>))
+import Control.Monad.Trans.State.Strict (State, modify, runState)
+import qualified Data.Set as S
+
+newtype Move = Move (Int, Int)
+  deriving (Show, Eq)
+
+newtype Step = Step (Int, Int)
+  deriving (Show, Eq)
+
+up :: Int -> Move
+up y = Move (0, y)
+
+down :: Int -> Move
+down y = Move (0, y * (-1))
+
+left :: Int -> Move
+left x = Move (x * (-1), 0)
+
+right :: Int -> Move
+right x = Move (x, 0)
+
+diag :: Int -> Move
+diag x = Move (x, x)
+
+still :: Move
+still = Move (0, 0)
+
+type Pos = (Int, Int)
+
+data Grid = Grid {h :: Pos, t :: Pos} deriving (Show, Eq)
+
+data MovementLog = MovementLog {visited :: S.Set Pos, recordedSteps :: [Step]}
+  deriving (Show, Eq)
+
+logOne :: (Pos, Step) -> MovementLog -> MovementLog
+logOne (p, s) (MovementLog v steps) =
+  MovementLog (S.insert p v) (s : steps)
+
+buildTails :: [Step] -> [([Pos], [Step])]
+buildTails steps = iterate (snd >>> recordPositions) ([], steps)
+
+recordPositions :: [Step] -> ([Pos], [Step])
+recordPositions steps = (allPositions, allSteps)
+  where
+    -- insert last tail position
+    allPositions = S.toList $ S.insert lastTailPos (visited state)
+    allSteps = reverse (recordedSteps state)
+    
+    ((_, Grid {t = lastTailPos}), state) =
+      runState (recordPositions' steps Grid {h = (0,0), t = (0,0)}) (MovementLog S.empty [])
+
+    recordPositions' :: [Step] -> Grid -> State MovementLog ([Step], Grid)
+    recordPositions' [] grid = return ([], grid)
+    recordPositions' (m : ms) Grid {h = headPos, t = tailPos} =
+      let newHead = headPos `step` m
+          followStep = follow newHead tailPos
+          newTail = tailPos `step` followStep
+       in modify (logOne (newTail, followStep))
+            >> recordPositions' ms Grid {h = newHead, t = newTail}
+
+parseMovements :: String -> [Move]
+parseMovements = lines >>> map toMove
+  where
+    toMove ('U' : ' ' : xs) = up $ read xs
+    toMove ('D' : ' ' : xs) = down $ read xs
+    toMove ('L' : ' ' : xs) = left $ read xs
+    toMove ('R' : ' ' : xs) = right $ read xs
+    toMove _ = error "cannot parse movement"
+
+normalizeMovement :: Move -> [Step]
+normalizeMovement (Move (dx, 0)) = replicate (abs dx) (Step (signum dx, 0))
+normalizeMovement (Move (0, dy)) = replicate (abs dy) (Step (0, signum dy))
+normalizeMovement m = error $ "cannot normalize movement: " ++ show m
+
+step :: Pos -> Step -> Pos
+step (x, y) (Step (dx, dy)) = (x + dx, y + dy)
+
+follow :: Pos -> Pos -> Step
+follow (x1, y1) (x2, y2)
+  | abs dx > 1 || abs dy > 1 = Step (signum dx, signum dy)
+  | otherwise = Step (0, 0)
+  where
+    dx = x1 - x2
+    dy = y1 - y2
+
+day9 :: IO ()
+day9 = do
+  input <- readFile "ressources/day09-input"
+  putStrLn "Day9"
+  let headSteps = parseMovements >>> concatMap normalizeMovement $ input
+  let allTails = buildTails headSteps
+  let positions = (!! 1) >>> fst >>> length $ allTails
+  putStrLn ("Number of distinct positions " ++ show positions)
+  let tail9 = (!! 9) >>> fst >>> length $ allTails
+  putStrLn ("Number of distinct positions of tail 9" ++ show tail9)

src/Lib.hs

@@ -2,21 +2,22 @@ module Lib
     ( someFunc
     ) where
 
-import Day1
+import Day1 (day1)
-import Day2
+import Day2 (day2)
-import Day3
+import Day3 (day3)
-import Day4
+import Day4 (day4)
-import Day5
+import Day5 (day5)
-import Day6
+import Day6 (day6)
-import Day7
+import Day7 (day7)
-import Day8
+import Day8 (day8)
+import Day9 (day9)
 
 days :: [IO ()]
-days = [day1, day2, day3, day4, day5, day6, day7, day8]
+days = [day1, day2, day3, day4, day5, day6, day7, day8, day9]
 
 sep :: IO ()
 sep = putStrLn "---------"
 
 someFunc :: IO ()
 someFunc = mapM_ (>> sep) days
-  
+

test/Day9Spec.hs

@@ -0,0 +1,102 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Day9Spec (spec) where
+
+import Control.Arrow ((>>>))
+import Day9
+import Test.Hspec
+import Text.Heredoc
+import Data.List (sort)
+
+testInput :: String
+testInput =
+  [str|R 4
+                |U 4
+                |L 3
+                |D 1
+                |R 4
+                |D 1
+                |L 5
+                |R 2
+                |]
+
+expectedPositions :: [(Int, Int)]
+expectedPositions = sort [
+              (2,4),(3,4),
+                    (3,3),(4,3),
+        (1,2),(2,2),(3,2),(4,2),
+                          (4,1),
+  (0,0),(1,0),(2,0),(3,0)
+  ]
+
+testInput2 :: String
+testInput2 = [str|R 5
+                 |U 8
+                 |L 8
+                 |D 3
+                 |R 17
+                 |D 10
+                 |L 25
+                 |U 20
+                 |]
+
+spec :: Spec
+spec =
+  describe "Day9" $ do
+    describe "Part1" $ do
+      it "parses the instructions" $ do
+        parseMovements testInput
+          `shouldBe` [ right 4,
+                       up 4,
+                       left 3,
+                       down 1,
+                       right 4,
+                       down 1,
+                       left 5,
+                       right 2
+                     ]
+      it "moves a step" $ do
+        step (0, 0) (Step (1, 1)) `shouldBe` (1, 1)
+        step (0, 0) (Step (1, 0)) `shouldBe` (1, 0)
+        step (1, 0) (Step (-1, 0)) `shouldBe` (0, 0)
+        step (0, 1) (Step (0, -1)) `shouldBe` (0, 0)
+      it "normalizes movement" $ do
+        normalizeMovement still `shouldBe` []
+        normalizeMovement (left 2) `shouldBe` [Step (-1, 0),Step (-1, 0)]
+        normalizeMovement (right 1) `shouldBe` [Step (1, 0)]
+        normalizeMovement (up 1) `shouldBe` [Step (0, 1)]
+        normalizeMovement (down 2) `shouldBe` [Step (0, -1), Step (0, -1)]
+      it "follows the head" $ do
+        follow (1, 0) (0, 0) `shouldBe` Step (0, 0)
+        follow (0, 1) (0, 0) `shouldBe` Step (0, 0)
+        follow (1, 1) (0, 0) `shouldBe` Step (0, 0)
+        follow (2, 1) (0, 0) `shouldBe` Step (1, 1)
+        follow (1, 2) (0, 0) `shouldBe` Step (1, 1)
+        follow (2, 2) (0, 0) `shouldBe` Step (1, 1)
+        follow (4, 2) (3, 0) `shouldBe` Step (1, 1)
+      it "moves around and records tail position" $ do
+        let positions = parseMovements
+                >>> concatMap normalizeMovement
+                >>> recordPositions
+                >>> fst
+                >>> sort
+                $ testInput
+        length positions `shouldBe` 13
+        positions `shouldBe` expectedPositions
+      it "solves the riddle" $ do
+        input <- readFile "ressources/day09-input"
+        let headSteps = parseMovements >>> concatMap normalizeMovement $ input
+        let allTails = buildTails headSteps
+        let positions = (!! 1)  >>> fst >>> length $ allTails
+        positions `shouldBe` 5878
+      it "solves example of part 2" $ do
+        let headSteps = parseMovements >>> concatMap normalizeMovement $ testInput2
+        let allTails = buildTails headSteps
+        let tail9Positions = fst $ allTails !! 9
+        length tail9Positions `shouldBe` 36
+      it "solves the riddle part 2" $ do
+        input <- readFile "ressources/day09-input"
+        let headSteps = parseMovements >>> concatMap normalizeMovement $ input
+        let allTails = buildTails headSteps
+        let positions = (!! 9)  >>> fst >>> length $ allTails
+        positions `shouldBe` 2405