Day 9 - Part 1

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,110 @@
+module Day9
+  ( parseMovements,
+    Move (..),
+    Grid (..),
+    startGrid,
+    up,
+    down,
+    left,
+    right,
+    diag,
+    still,
+    step,
+    recordPositions,
+    normalizeMovement,
+    Step (..),
+    follow,
+    day9
+  )
+where
+
+import Control.Arrow ((>>>))
+import Data.List (nub)
+
+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)
+
+recordPositions :: [Step] -> [Pos]
+recordPositions steps = nub (lastTailPos:positions)
+  where
+    (positions, _, Grid { t = lastTailPos}) = recordPositions' [] steps startGrid
+    recordPositions' :: [Pos] -> [Step] -> Grid -> ([Pos], [Step], Grid)
+    recordPositions' pos [] grid = (pos, [], grid)
+    recordPositions' pos (m : ms) Grid {h = headPos, t = tailPos} =
+      let newHead = headPos `step` m
+          followStep = follow newHead tailPos
+          newTail = tailPos `step` followStep
+       in recordPositions' (tailPos : pos) ms Grid {h = newHead, t = newTail}
+
+startGrid :: Grid
+startGrid = Grid {h = p, t = p}
+  where
+    p = (0, 0)
+
+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)
+
+distance :: Pos -> Pos -> Int
+distance (x, y) (x2, y2) = floor (dx ** 2 + dy ** 2)
+  where
+    dx :: Double
+    dx = fromIntegral $ x - x2
+    dy :: Double
+    dy = fromIntegral $ y - y2
+
+follow :: Pos -> Pos -> Step
+follow p1@(x1, y1) p2@(x2, y2)
+  | distance p1 p2 > 2 = Step (signum dx, signum dy)
+  | abs dx == 2 = Step (signum dx, 0)
+  | abs dy == 2 = Step (0, 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 movements = parseMovements input
+   let positions = concatMap normalizeMovement >>> recordPositions >>> length $ movements
+   putStrLn ("Number of distinct positions " ++ show positions)

src/Lib.hs

@@ -2,17 +2,18 @@ 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 "---------"

test/Day9Spec.hs

@@ -0,0 +1,79 @@
+{-# 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)
+  ]
+
+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 1) `shouldBe` [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
+                >>> sort
+                $ testInput
+        length positions `shouldBe` 13
+        positions `shouldBe` expectedPositions
+      it "solves the riddle" $ do
+        input <- readFile "ressources/day09-input"
+        putStrLn "Day9"
+        let movements = parseMovements input
+        let positions = concatMap normalizeMovement >>> recordPositions >>> length $ movements
+        positions `shouldBe` 5878