70 lines
2.9 KiB
Haskell
70 lines
2.9 KiB
Haskell
{-# 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 |