|
|
@ -1,3 +1,5 @@
|
|
|
|
|
|
|
|
{-# LANGUAGE InstanceSigs #-}
|
|
|
|
|
|
|
|
|
|
|
|
module Day9Lib
|
|
|
|
module Day9Lib
|
|
|
|
( Rope (..),
|
|
|
|
( Rope (..),
|
|
|
|
newRope,
|
|
|
|
newRope,
|
|
|
@ -12,43 +14,47 @@ where
|
|
|
|
import Data.List
|
|
|
|
import Data.List
|
|
|
|
import Debug.Trace
|
|
|
|
import Debug.Trace
|
|
|
|
|
|
|
|
|
|
|
|
type Vector = (Int, Int)
|
|
|
|
newtype Vector = Vector (Int, Int) deriving (Show, Eq)
|
|
|
|
|
|
|
|
|
|
|
|
-- data Rope = Rope Vector Vector deriving (Show, Eq)
|
|
|
|
|
|
|
|
data Rope = Rope [Vector] deriving (Show, Eq)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
plus :: Vector -> Vector -> Vector
|
|
|
|
instance Num Vector where
|
|
|
|
(x1, y1) `plus` (x2, y2) = (x1 + x2, y1 + y2)
|
|
|
|
(+) :: Vector -> Vector -> Vector
|
|
|
|
|
|
|
|
Vector v1 + Vector v2 = Vector (fst v1 + fst v2, snd v1 + snd v2)
|
|
|
|
|
|
|
|
(-) :: Vector -> Vector -> Vector
|
|
|
|
|
|
|
|
Vector v1 - Vector v2 = Vector (fst v1 - fst v2, snd v1 - snd v2)
|
|
|
|
|
|
|
|
(*) :: Vector -> Vector -> Vector
|
|
|
|
|
|
|
|
Vector v1 * Vector v2 = Vector (fst v1 * fst v2, snd v1 * snd v2)
|
|
|
|
|
|
|
|
fromInteger :: Integer -> Vector
|
|
|
|
|
|
|
|
fromInteger i = Vector (fromInteger i, fromInteger i)
|
|
|
|
|
|
|
|
abs :: Vector -> Vector
|
|
|
|
|
|
|
|
abs (Vector v) = Vector (abs . fst $ v, abs . snd $ v)
|
|
|
|
|
|
|
|
signum :: Vector -> Vector
|
|
|
|
|
|
|
|
signum (Vector (x, y)) = Vector (signum x, signum y)
|
|
|
|
|
|
|
|
|
|
|
|
minus :: Vector -> Vector -> Vector
|
|
|
|
newtype Rope = Rope [Vector] deriving (Show, Eq)
|
|
|
|
(x1, y1) `minus` (x2, y2) = (x1 - x2, y1 - y2)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
stimes :: Int -> Vector -> Vector
|
|
|
|
stimes :: Int -> Vector -> Vector
|
|
|
|
m `stimes` (x, y) = (m * x, m * y)
|
|
|
|
m `stimes` v = (fromInteger . toInteger) m * v
|
|
|
|
|
|
|
|
|
|
|
|
vl1 :: Vector -> Int
|
|
|
|
|
|
|
|
vl1 (x, y) = abs x + abs y
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
vlinf :: Vector -> Int
|
|
|
|
vlinf :: Vector -> Int
|
|
|
|
vlinf (x, y) = max (abs x) (abs y)
|
|
|
|
vlinf v = let Vector (ax, ay) = abs v in max ax ay
|
|
|
|
|
|
|
|
|
|
|
|
vtruncate :: Vector -> Vector
|
|
|
|
vtruncate :: Vector -> Vector
|
|
|
|
vtruncate (x, y) = (signum x * min 1 (abs x), signum y * min 1 (abs y))
|
|
|
|
vtruncate v = let Vector (ax, ay) = abs v in signum v * Vector (min 1 ax, min 1 ay)
|
|
|
|
|
|
|
|
|
|
|
|
newRope :: Int -> Rope
|
|
|
|
newRope :: Int -> Rope
|
|
|
|
newRope l = Rope $ replicate l (0, 0)
|
|
|
|
newRope l = Rope $ replicate l (Vector (0, 0))
|
|
|
|
|
|
|
|
|
|
|
|
move :: Vector -> Char -> Int -> Vector
|
|
|
|
move :: Vector -> Char -> Int -> Vector
|
|
|
|
move v 'L' d = v `plus` (d `stimes` (-1, 0))
|
|
|
|
move v 'L' d = v + (d `stimes` (Vector (-1, 0)))
|
|
|
|
move v 'R' d = v `plus` (d `stimes` (1, 0))
|
|
|
|
move v 'R' d = v + (d `stimes` (Vector (1, 0)))
|
|
|
|
move v 'U' d = v `plus` (d `stimes` (0, 1))
|
|
|
|
move v 'U' d = v + (d `stimes` (Vector (0, 1)))
|
|
|
|
move v 'D' d = v `plus` (d `stimes` (0, -1))
|
|
|
|
move v 'D' d = v + (d `stimes` (Vector (0, -1)))
|
|
|
|
move v dir d = error $ "wrong direction:" ++ show dir
|
|
|
|
move v dir d = error $ "wrong direction:" ++ show dir
|
|
|
|
|
|
|
|
|
|
|
|
follow :: Vector -> Vector -> [Vector] -> (Vector, [Vector])
|
|
|
|
follow :: Vector -> Vector -> [Vector] -> (Vector, [Vector])
|
|
|
|
follow h t hist
|
|
|
|
follow h t hist
|
|
|
|
| vlinf (h `minus` t) >= 2 =
|
|
|
|
| vlinf (h - t) >= 2 =
|
|
|
|
let newt = (t `plus` vtruncate (h `minus` t))
|
|
|
|
let newt = (t + vtruncate (h - t))
|
|
|
|
in follow h newt (newt : hist)
|
|
|
|
in follow h newt (newt : hist)
|
|
|
|
| otherwise = (t, hist)
|
|
|
|
| otherwise = (t, hist)
|
|
|
|
|
|
|
|
|
|
|
@ -67,7 +73,7 @@ moveRope _ _ = error "rope too short"
|
|
|
|
-- ####################
|
|
|
|
-- ####################
|
|
|
|
|
|
|
|
|
|
|
|
processInput1 :: String -> Int
|
|
|
|
processInput1 :: String -> Int
|
|
|
|
processInput1 = length . nub . snd . foldl processLine1 (newRope 2, [(0, 0)]) . lines
|
|
|
|
processInput1 = length . nub . snd . foldl processLine1 (newRope 2, [Vector (0, 0)]) . lines
|
|
|
|
|
|
|
|
|
|
|
|
processLine1 :: (Rope, [Vector]) -> String -> (Rope, [Vector])
|
|
|
|
processLine1 :: (Rope, [Vector]) -> String -> (Rope, [Vector])
|
|
|
|
processLine1 (r@(Rope (h : t : [])), hist) (dir : _ : dist) =
|
|
|
|
processLine1 (r@(Rope (h : t : [])), hist) (dir : _ : dist) =
|
|
|
@ -77,7 +83,7 @@ processLine1 (r@(Rope (h : t : [])), hist) (dir : _ : dist) =
|
|
|
|
processLine1 _ s = error $ "processline1 error: " ++ show s
|
|
|
|
processLine1 _ s = error $ "processline1 error: " ++ show s
|
|
|
|
|
|
|
|
|
|
|
|
processInput2 :: String -> Int
|
|
|
|
processInput2 :: String -> Int
|
|
|
|
processInput2 = length . nub . snd . foldl processLine2 (newRope 10, [(0, 0)]) . lines
|
|
|
|
processInput2 = length . nub . snd . foldl processLine2 (newRope 10, [Vector (0, 0)]) . lines
|
|
|
|
|
|
|
|
|
|
|
|
processLine2 :: (Rope, [Vector]) -> String -> (Rope, [Vector])
|
|
|
|
processLine2 :: (Rope, [Vector]) -> String -> (Rope, [Vector])
|
|
|
|
processLine2 (r@(Rope (h : ks)), hist) (dir : _ : dist) =
|
|
|
|
processLine2 (r@(Rope (h : ks)), hist) (dir : _ : dist) =
|
|
|
|