day 9

aoc2022.cabal

@@ -249,3 +249,29 @@ test-suite day08aoctest
                      , parsec
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   default-language:    Haskell2010
+
+-- Day 9
+
+test-suite day09basictest
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      src/day09/test, src/day09
+  main-is:             Basic.hs
+  other-modules:       
+      Day9Lib
+  build-depends:       base
+                     , HUnit
+                     , parsec
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+
+test-suite day09aoctest
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      src/day09/test, src/day09
+  main-is:             AoCTest.hs
+  other-modules:       
+      Day9Lib
+  build-depends:       base
+                     , HUnit
+                     , parsec
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010

data/input090.txt

@@ -0,0 +1,8 @@
+R 4
+U 4
+L 3
+D 1
+R 4
+D 1
+L 5
+R 2

data/input093.txt

@@ -0,0 +1,8 @@
+R 5
+U 8
+L 8
+D 3
+R 17
+D 10
+L 25
+U 20

src/day09/Day9Lib.hs

@@ -0,0 +1,91 @@
+module Day9Lib
+  ( Rope (..),
+    newRope,
+    -- move,
+    follow,
+    --
+    processInput1,
+    processInput2,
+  )
+where
+
+import Data.List
+import Debug.Trace
+
+type Vector = (Int, Int)
+
+-- data Rope = Rope Vector Vector deriving (Show, Eq)
+data Rope = Rope [Vector] deriving (Show, Eq)
+
+plus :: Vector -> Vector -> Vector
+(x1, y1) `plus` (x2, y2) = (x1 + x2, y1 + y2)
+
+minus :: Vector -> Vector -> Vector
+(x1, y1) `minus` (x2, y2) = (x1 - x2, y1 - y2)
+
+stimes :: Int -> Vector -> Vector
+m `stimes` (x, y) = (m * x, m * y)
+
+vl1 :: Vector -> Int
+vl1 (x, y) = abs x + abs y
+
+vlinf :: Vector -> Int
+vlinf (x, y) = max (abs x) (abs y)
+
+vtruncate :: Vector -> Vector
+vtruncate (x, y) = (signum x * min 1 (abs x), signum y * min 1 (abs y))
+
+newRope :: Int -> Rope
+newRope l = Rope $ replicate l (0, 0)
+
+move :: Vector -> Char -> Int -> Vector
+move v 'L' d = v `plus` (d `stimes` (-1, 0))
+move v 'R' d = v `plus` (d `stimes` (1, 0))
+move v 'U' d = v `plus` (d `stimes` (0, 1))
+move v 'D' d = v `plus` (d `stimes` (0, -1))
+move v dir d = error $ "wrong direction:" ++ show dir
+
+follow :: Vector -> Vector -> [Vector] -> (Vector, [Vector])
+follow h t hist
+  | vlinf (h `minus` t) >= 2 =
+      let newt = (t `plus` vtruncate (h `minus` t))
+       in follow h newt (newt : hist)
+  | otherwise = (t, hist)
+
+-- ####################
+
+moveRope :: Rope -> [Vector] -> (Rope, [Vector])
+moveRope (Rope [h, t]) hist =
+  let (newt, newhist) = follow h t hist
+   in (Rope [h, newt], newhist)
+moveRope (Rope (h : k1 : ks)) hist =
+  let (newk1, _) = follow h k1 []
+      (Rope (newks), newhist) = moveRope (Rope (newk1 : ks)) hist
+   in (Rope (h : newks), newhist)
+moveRope _ _ = error "rope too short"
+
+-- ####################
+
+processInput1 :: String -> Int
+processInput1 = length . nub . snd . foldl processLine1 (newRope 2, [(0, 0)]) . lines
+
+processLine1 :: (Rope, [Vector]) -> String -> (Rope, [Vector])
+processLine1 (r@(Rope (h : t : [])), hist) (dir : _ : dist) =
+  let newh = move h dir (read dist)
+      (newt, newhist) = follow newh t hist
+   in (Rope [newh, newt], newhist)
+processLine1 _ s = error $ "processline1 error: " ++ show s
+
+processInput2 :: String -> Int
+processInput2 = length . nub . snd . foldl processLine2 (newRope 10, [(0, 0)]) . lines
+
+processLine2 :: (Rope, [Vector]) -> String -> (Rope, [Vector])
+processLine2 (r@(Rope (h : ks)), hist) (dir : _ : dist) =
+  last . take (read dist + 1) . iterate (move2 dir) $ (r, hist)
+processLine2 _ s = error $ "processline2 error: " ++ show s
+
+move2 dir (r@(Rope (h : ks)), hist) =
+  let newh = move h dir 1
+      (newrope, newhist) = moveRope (Rope (newh : ks)) hist
+   in (newrope, newhist)
+move2 _ _ = error "wut"

src/day09/test/AoCTest.hs

@@ -0,0 +1,42 @@
+import Day9Lib (processInput1, processInput2)
+import System.IO
+import Test.HUnit
+
+testCases1 =
+  [ ("data/input090.txt", 13),
+    ("data/input091.txt", 6384)
+  ]
+
+testCase1 (file, result) = do
+  withFile
+    file
+    ReadMode
+    ( \handle -> do
+        contents <- hGetContents handle
+        assertEqual "input test" result $ processInput1 contents
+    )
+
+testCases2 =
+  [ ("data/input090.txt", 1),
+    ("data/input091.txt", 2734),
+    ("data/input093.txt", 36)
+  ]
+
+testCase2 (file, result) = do
+  withFile
+    file
+    ReadMode
+    ( \handle -> do
+        contents <- hGetContents handle
+        assertEqual ("input test: " ++ file) result $ processInput2 contents
+    )
+
+tests =
+  TestList $
+    [TestCase (testCase1 c) | c <- testCases1]
+      ++ [TestCase (testCase2 c) | c <- testCases2]
+
+main :: IO ()
+main = do
+  runTestTT tests
+  return ()

src/day09/test/Basic.hs

@@ -0,0 +1,61 @@
+import Day9Lib
+import Test.HUnit
+
+followTests =
+  [ 
+    -- TestCase $
+    --   assertEqual
+    --     "follow 1 stationary"
+    --     (newRope, [(0, 0)])
+    --     (follow newRope [(0, 0)]),
+    -- TestCase $
+    --   assertEqual
+    --     "follow 2 in range"
+    --     (Rope (0, 1) (0, 0), [(0, 0)])
+    --     (follow (Rope (0, 1) (0, 0)) [(0, 0)]),
+    -- TestCase $
+    --   assertEqual
+    --     "follow 3 right"
+    --     (Rope (0, 2) (0, 1), [(0, 1), (0, 0)])
+    --     (follow (Rope (0, 2) (0, 0)) [(0, 0)]),
+    -- TestCase $
+    --   assertEqual
+    --     "follow 4 left"
+    --     (Rope (0, 2) (0, 3), [(0, 3), (0, 0)])
+    --     (follow (Rope (0, 2) (0, 4)) [(0, 0)]),
+    -- TestCase $
+    --   assertEqual
+    --     "follow 5 up"
+    --     (Rope (2, 0) (1, 0), [(1, 0), (0, 0)])
+    --     (follow (Rope (2, 0) (0, 0)) [(0, 0)]),
+    -- TestCase $
+    --   assertEqual
+    --     "follow 6 diagonal"
+    --     (Rope (2, 2) (1, 1), [(1, 1), (0, 0)])
+    --     (follow (Rope (2, 2) (0, 0)) [(0, 0)]),
+    -- TestCase $
+    --   assertEqual
+    --     "follow 7 L"
+    --     (Rope (1, 3) (1, 2), [(1, 2), (1, 1), (0, 0)])
+    --     (follow (Rope (1, 3) (0, 0)) [(0, 0)]),
+    -- TestCase $
+    --   assertEqual
+    --     "follow 7.1 L more"
+    --     (Rope (1, 6) (1, 5), [(1, 5), (1, 4), (1, 3), (1, 2), (1, 1), (0, 0)])
+    --     (follow (Rope (1, 6) (0, 0)) [(0, 0)]),
+    -- TestCase $
+    --   assertEqual
+    --     "follow 8 negative"
+    --     (Rope (-5, -5) (-5, -4), [(-5, -4), (0, 0)])
+    --     (follow (Rope (-5, -5) (-5, -3)) [(0, 0)])
+  ]
+
+tests =
+  TestList $
+    followTests
+      ++ []
+
+main :: IO ()
+main = do
+  runTestTT tests
+  return ()