80 lines
1.9 KiB
Haskell
80 lines
1.9 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Aoc.Y2019.A03
|
|
( solve201903
|
|
) where
|
|
|
|
import Data.List
|
|
import Data.Maybe
|
|
import qualified Data.Map.Strict as M
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.IO as T
|
|
import Text.Read (readMaybe)
|
|
|
|
data Pos = Pos Int Int
|
|
deriving (Show, Eq, Ord)
|
|
|
|
zeroPos :: Pos
|
|
zeroPos = Pos 0 0
|
|
|
|
addPos :: Pos -> Pos -> Pos
|
|
addPos (Pos x1 y1) (Pos x2 y2) = Pos (x1 + x2) (y1 + y2)
|
|
|
|
manhattan :: Pos -> Int
|
|
manhattan (Pos x y) = abs x + abs y
|
|
|
|
data Dir = U | D | L | R
|
|
deriving (Show)
|
|
|
|
asDelta :: Dir -> Pos
|
|
asDelta U = Pos 0 1
|
|
asDelta D = Pos 0 (-1)
|
|
asDelta L = Pos (-1) 0
|
|
asDelta R = Pos 1 0
|
|
|
|
data Step = Step Dir Int
|
|
deriving (Show)
|
|
|
|
step :: Step -> Pos -> [Pos]
|
|
step (Step dir n) = take n . drop 1 . iterate (addPos delta)
|
|
where delta = asDelta dir
|
|
|
|
steps :: Pos -> [Step] -> [Pos]
|
|
steps pos = concat . drop 1 . scanl' (flip step . last) [pos]
|
|
|
|
costs :: [Pos] -> M.Map Pos Int
|
|
costs = M.fromList . reverse . flip zip [1..]
|
|
|
|
intersections :: [Step] -> [Step] -> [(Pos, Int)]
|
|
intersections s1 s2 =
|
|
let costs1 = costs $ steps zeroPos s1
|
|
costs2 = costs $ steps zeroPos s2
|
|
in M.toList $ M.intersectionWith (+) costs1 costs2
|
|
|
|
-- Reading input
|
|
|
|
readDir :: Char -> Maybe Dir
|
|
readDir 'U' = Just U
|
|
readDir 'D' = Just D
|
|
readDir 'L' = Just L
|
|
readDir 'R' = Just R
|
|
readDir _ = Nothing
|
|
|
|
readStep :: String -> Maybe Step
|
|
readStep [] = Nothing
|
|
readStep (d:n) = Step <$> readDir d <*> readMaybe n
|
|
|
|
readSteps :: T.Text -> Maybe [Step]
|
|
readSteps = traverse (readStep . T.unpack) . T.splitOn ","
|
|
|
|
solve201903 :: FilePath -> IO ()
|
|
solve201903 f = do
|
|
text <- T.readFile f
|
|
let [steps1, steps2] = mapMaybe readSteps $ T.lines text
|
|
ixs = intersections steps1 steps2
|
|
|
|
putStrLn ">> Part 1"
|
|
print $ manhattan $ fst $ head $ sortOn (manhattan . fst) ixs
|
|
|
|
putStrLn ">> Part 2"
|
|
print $ snd $ head $ sortOn snd ixs
|