[hs] Solve 2019_03

hs/src/Aoc/Y2019/A03.hs

@@ -0,0 +1,80 @@
+{-# 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