day 9
This commit is contained in:
parent
19cd3a3e3b
commit
5fd2159be1
|
@ -0,0 +1,70 @@
|
|||
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
|
||||
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||
|
||||
import Prelude hiding (Left, Right)
|
||||
import Data.List
|
||||
|
||||
data Direction = Left | Down | Up | Right
|
||||
deriving (Eq, Show)
|
||||
|
||||
newtype Instruction = Instruction (Int, Direction)
|
||||
deriving (Eq, Show)
|
||||
|
||||
parseDirection "L" = Left
|
||||
parseDirection "D" = Down
|
||||
parseDirection "U" = Up
|
||||
parseDirection "R" = Right
|
||||
|
||||
directionToOffset :: Direction -> (Int, Int)
|
||||
directionToOffset Left = (-1, 0)
|
||||
directionToOffset Down = (0, -1)
|
||||
directionToOffset Up = (0, 1)
|
||||
directionToOffset Right = (1, 0)
|
||||
|
||||
parseInstructions :: String -> [Instruction]
|
||||
parseInstructions = map (Instruction . (\[d, n] -> (read n, parseDirection d)) . words) . lines
|
||||
|
||||
unrollInstructions :: [Instruction] -> [Direction]
|
||||
unrollInstructions = concatMap (\(Instruction (n, d)) -> replicate n d)
|
||||
|
||||
taxicabDist :: (Int, Int) -> (Int, Int) -> Int
|
||||
taxicabDist (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)
|
||||
|
||||
addPos :: (Int, Int) -> (Int, Int) -> (Int, Int)
|
||||
addPos (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)
|
||||
|
||||
run :: [Direction] -> [(Int, Int)]
|
||||
run = (\(a, b, l) -> l) . foldl stepAccum ((0, 0), (0, 0), [(0, 0)])
|
||||
where stepAccum :: ((Int, Int), (Int, Int), [(Int, Int)]) -> Direction -> ((Int, Int), (Int, Int), [(Int, Int)])
|
||||
stepAccum (posHead, posTail, l) i = (newPosHead, newPosTail, if newPosTail `elem` l then l else newPosTail : l)
|
||||
where (newPosHead, newPosTail) = step (posHead, posTail) i
|
||||
|
||||
step :: ((Int, Int), (Int, Int)) -> Direction -> ((Int, Int), (Int, Int))
|
||||
step ((hX, hY), (tX, tY)) dir = ((hXNew, hYNew), (tXNew, tYNew))
|
||||
where (offsetX, offsetY) = directionToOffset dir
|
||||
(hXNew, hYNew) = addPos (hX, hY) (offsetX, offsetY)
|
||||
tailDistNew = (tX, tY) `taxicabDist` (hXNew, hYNew)
|
||||
(tXNew, tYNew)
|
||||
-- directly touching, no problem
|
||||
| tailDistNew <= 1 = (tX, tY)
|
||||
-- diagonally touching, no problem
|
||||
| tailDistNew == 2 && (tX /= hXNew) && (tY /= hYNew) = (tX, tY)
|
||||
-- horizontally offset, catch up
|
||||
| hYNew == tY = (tX + offsetX, hYNew)
|
||||
-- vertically offset, catch up
|
||||
| hXNew == tX = (hXNew, tY + offsetY)
|
||||
-- diagonally offset moving horizontally, vertically align and catch up
|
||||
| offsetY == 0 = (tX + offsetX, hYNew)
|
||||
-- diagonally offset moving vertically, horizontally align and catch up
|
||||
| offsetX == 0 = (hXNew, tY + offsetY)
|
||||
|
||||
-- for debugging
|
||||
renderSeenMap :: [(Int, Int)] -> String
|
||||
renderSeenMap positions = intercalate "\n" $ map (\y -> map (\x -> if (x, y) `elem` positions then '#' else '.') [0..maxX]) (reverse [0..maxY])
|
||||
where maxX = maximum $ map fst positions
|
||||
maxY = maximum $ map snd positions
|
||||
|
||||
main = interact $
|
||||
show
|
||||
. length . run
|
||||
. unrollInstructions . parseInstructions
|
|
@ -0,0 +1,101 @@
|
|||
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
|
||||
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||
|
||||
import Prelude hiding (Left, Right)
|
||||
import Data.List
|
||||
import GHC.IO
|
||||
import Control.DeepSeq
|
||||
|
||||
knotN = 10
|
||||
|
||||
data Direction = Left | Down | Up | Right
|
||||
deriving (Eq, Show)
|
||||
|
||||
newtype Instruction = Instruction (Int, Direction)
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- help
|
||||
{-# NOINLINE debug #-}
|
||||
debug :: Show a => a -> ()
|
||||
debug = unsafePerformIO . print
|
||||
|
||||
trace :: Show b => b -> a -> a
|
||||
trace s = deepseq (debug s)
|
||||
|
||||
parseDirection "L" = Left
|
||||
parseDirection "D" = Down
|
||||
parseDirection "U" = Up
|
||||
parseDirection "R" = Right
|
||||
|
||||
directionToOffset :: Direction -> (Int, Int)
|
||||
directionToOffset Left = (-1, 0)
|
||||
directionToOffset Down = (0, -1)
|
||||
directionToOffset Up = (0, 1)
|
||||
directionToOffset Right = (1, 0)
|
||||
|
||||
parseInstructions :: String -> [Instruction]
|
||||
parseInstructions = map (Instruction . (\[d, n] -> (read n, parseDirection d)) . words) . lines
|
||||
|
||||
unrollInstructions :: [Instruction] -> [Direction]
|
||||
unrollInstructions = concatMap (\(Instruction (n, d)) -> replicate n d)
|
||||
|
||||
taxicabDist :: (Int, Int) -> (Int, Int) -> Int
|
||||
taxicabDist (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)
|
||||
|
||||
addPos :: (Int, Int) -> (Int, Int) -> (Int, Int)
|
||||
addPos (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)
|
||||
|
||||
subPos :: (Int, Int) -> (Int, Int) -> (Int, Int)
|
||||
subPos (x1, y1) (x2, y2) = (x1 - x2, y1 - y2)
|
||||
|
||||
run :: [Direction] -> [(Int, Int)]
|
||||
run = snd . foldl stepAccum (replicate knotN (0, 0), [(0, 0)])
|
||||
where stepAccum :: ([(Int, Int)], [(Int, Int)]) -> Direction -> ([(Int, Int)], [(Int, Int)])
|
||||
stepAccum (knots, l) i = (newKnots, if lastKnot `elem` l then l else lastKnot : l)
|
||||
where newKnots = step' knots i
|
||||
lastKnot = last newKnots
|
||||
|
||||
-- accounts for >2 knots
|
||||
step' :: [(Int, Int)] -> Direction -> [(Int, Int)]
|
||||
step' knots dir = map snd $ scanl foldStep (h, newHead) t
|
||||
where h = head knots
|
||||
t = tail knots
|
||||
offset = directionToOffset dir
|
||||
newHead = h `addPos` offset
|
||||
foldStep (oldKnot, newKnot) thisKnot = (thisKnot, step (oldKnot, thisKnot) (newKnot `subPos` oldKnot))
|
||||
|
||||
step :: ((Int, Int), (Int, Int)) -> (Int, Int) -> (Int, Int)
|
||||
step ((hX, hY), (tX, tY)) (offsetX, offsetY) = (tXNew, tYNew)
|
||||
where (hXNew, hYNew) = (hX, hY) `addPos` (offsetX, offsetY)
|
||||
tailDistNew = (tX, tY) `taxicabDist` (hXNew, hYNew)
|
||||
(tXNew, tYNew)
|
||||
-- directly touching, no problem
|
||||
| tailDistNew <= 1 = (tX, tY)
|
||||
-- diagonally touching, no problem
|
||||
| tailDistNew == 2 && (tX /= hXNew) && (tY /= hYNew) = (tX, tY)
|
||||
-- horizontally offset, catch up
|
||||
| hYNew == tY = (tX + offsetX, hYNew)
|
||||
-- vertically offset, catch up
|
||||
| hXNew == tX = (hXNew, tY + offsetY)
|
||||
-- diagonally offset moving horizontally, vertically align and catch up
|
||||
| offsetY == 0 = (tX + offsetX, hYNew)
|
||||
-- diagonally offset moving vertically, horizontally align and catch up
|
||||
| offsetX == 0 = (hXNew, tY + offsetY)
|
||||
-- diagonally offset moving diagonally but previous offset was horizontal, vertically align and recurse
|
||||
| offsetX /= 0 && offsetY /= 0 && (hY - tY) == 0 = step ((hX, hY), (tX, hYNew)) (offsetX, offsetY)
|
||||
-- diagonally offset moving diagonally but previous offset was vertical, horizontally align and recurse
|
||||
| offsetX /= 0 && offsetY /= 0 && (hX - tX) == 0 = step ((hX, hY), (hXNew, tY)) (offsetX, offsetY)
|
||||
-- diagonally offset moving diagonally by previous offset was diagonal, move in the same direction and recurse
|
||||
| offsetX /= 0 && offsetY /= 0 && (hX - tX) /= 0 && (hY - tY) /= 0 = step ((hX, hY), (tX + offsetX, tY + offsetY)) (offsetX, offsetY)
|
||||
| otherwise = error $ "wtf: offset x" ++ show offsetX ++ " y" ++ show offsetY ++ ", prev offset x" ++ show (hX - tX) ++ " y" ++ show (hY - tY)
|
||||
|
||||
-- for debugging
|
||||
renderSeenMap :: [(Int, Int)] -> String
|
||||
renderSeenMap positions = intercalate "\n" $ map (\y -> map (\x -> if (x, y) `elem` positions then '#' else '.') [0..maxX]) (reverse [0..maxY])
|
||||
where maxX = maximum $ map fst positions
|
||||
maxY = maximum $ map snd positions
|
||||
|
||||
main = interact $
|
||||
show
|
||||
. length . run
|
||||
. unrollInstructions . parseInstructions
|
Loading…
Reference in New Issue