trunk
HeNine 2 years ago
parent 1a402dbeaf
commit 04ef70548a

@ -248,4 +248,30 @@ test-suite day08aoctest
, HUnit
, 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

@ -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…
Cancel
Save