trunk
HeNine 2 years ago
parent 04ef70548a
commit 6d279a0fac

@ -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) =

Loading…
Cancel
Save