day 9
parent
1a402dbeaf
commit
04ef70548a
@ -0,0 +1,8 @@
|
||||
R 4
|
||||
U 4
|
||||
L 3
|
||||
D 1
|
||||
R 4
|
||||
D 1
|
||||
L 5
|
||||
R 2
|
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,8 @@
|
||||
R 5
|
||||
U 8
|
||||
L 8
|
||||
D 3
|
||||
R 17
|
||||
D 10
|
||||
L 25
|
||||
U 20
|
@ -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"
|
@ -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 ()
|
@ -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 ()
|
Loading…
Reference in New Issue