Day 9 - Part 1

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,21 +2,22 @@ module Lib
     ( someFunc
     ) where
 
-import Day1
-import Day2
-import Day3
-import Day4
-import Day5
-import Day6
-import Day7
-import Day8
+import Day1 (day1)
+import Day2 (day2)
+import Day3 (day3)
+import Day4 (day4)
+import Day5 (day5)
+import Day6 (day6)
+import Day7 (day7)
+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
-  
+