From 4044d6aabf66e3ab76e577b5fb66c7d674b6e8d2 Mon Sep 17 00:00:00 2001
From: Joscha <joscha@plugh.de>
Date: Tue, 3 Nov 2020 22:24:01 +0000
Subject: [PATCH] [hs] Solve 2019_03

---
 hs/app/Main.hs          |  2 ++
 hs/src/Aoc/Y2019/A03.hs | 80 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 82 insertions(+)
 create mode 100644 hs/src/Aoc/Y2019/A03.hs

diff --git a/hs/app/Main.hs b/hs/app/Main.hs
index 7533de7..9670c05 100644
--- a/hs/app/Main.hs
+++ b/hs/app/Main.hs
@@ -4,6 +4,7 @@ import Options.Applicative
 
 import Aoc.Y2019.A01
 import Aoc.Y2019.A02
+import Aoc.Y2019.A03
 
 data Settings = Settings
   { function :: FilePath -> IO ()
@@ -14,6 +15,7 @@ solutions :: Parser (FilePath -> IO ())
 solutions = subparser $ mconcat $ map (\(name, func) -> command name (info (pure func) mempty))
   [ ("2019_01", solve201901)
   , ("2019_02", solve201902)
+  , ("2019_03", solve201903)
   ]
 
 parser :: Parser Settings
diff --git a/hs/src/Aoc/Y2019/A03.hs b/hs/src/Aoc/Y2019/A03.hs
new file mode 100644
index 0000000..b697709
--- /dev/null
+++ b/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