# AoC 2022 #09

Dec 9th, 2022
2,388
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. {-# OPTIONS_GHC -Wno-incomplete-patterns #-}
2.
3. import Data.List (nub) -- remove duplicates
4. import Data.List.Split (splitOn)
5.
6. main :: IO ()
7. main = do
11.
12. taskOne :: String -> Int
13. taskOne = length . nub . snd . foldl moveRope (replicate 2 (0, 0), [(0, 0)]) . concatMap parseMove . lines
14.
15. taskTwo :: String -> Int
16. taskTwo = length . nub . snd . foldl moveRope (replicate 10 (0, 0), [(0, 0)]) . concatMap parseMove . lines
17.
18. data Move = U | L | D | R deriving (Show, Eq)
19.
20. moveRope :: ([(Int, Int)], [(Int, Int)]) -> Move -> ([(Int, Int)], [(Int, Int)])
21. moveRope (rope, tailTrail) move = (rope', tailTrail')
22.   where
24.    rope' = (scanl moveTail headPos' . tail) rope
25.    tailTrail' = last rope' : tailTrail
26.
27. moveHead :: Move -> (Int, Int) -> (Int, Int)
28. moveHead U (x, y) = (x, y + 1)
29. moveHead L (x, y) = (x - 1, y)
30. moveHead D (x, y) = (x, y - 1)
31. moveHead R (x, y) = (x + 1, y)
32.
33. moveTail :: (Int, Int) -> (Int, Int) -> (Int, Int)
35.  | abs (xHead - xTail) <= 1 && abs (yHead - yTail) <= 1 = (xTail, yTail) -- head and tail are adjacent or on the same position -> no tail movement
36.  | xHead == xTail && yHead > yTail = (xTail, yTail + 1) -- same column, head over tail
37.  | xHead == xTail && yHead < yTail = (xTail, yTail - 1) -- same column, head under tail
38.  | yHead == yTail && xHead > xTail = (xTail + 1, yTail) -- same row, head right of tail
39.  | yHead == yTail && xHead < xTail = (xTail - 1, yTail) -- same row, head left of tail
40.  | xHead > xTail && yHead > yTail = (xTail + 1, yTail + 1) -- head top right of tail
41.  | xHead < xTail && yHead > yTail = (xTail - 1, yTail + 1) -- head top left of tail
42.  | xHead < xTail && yHead < yTail = (xTail - 1, yTail - 1) -- head down left of tail
43.  | xHead > xTail && yHead < yTail = (xTail + 1, yTail - 1) -- head down right of tail
44.
45. parseMove :: String -> [Move]
46. parseMove line
47.  | direction == 'U' = replicate steps U
48.  | direction == 'L' = replicate steps L
49.  | direction == 'D' = replicate steps D
50.  | direction == 'R' = replicate steps R
51.  where