Day 3a

1 files changed, 55 insertions, 0 deletions

diff --git a/2019/3.hs b/2019/3.hs
new file mode 100644
index 0000000..7f0180a
--- /dev/null
+++ b/2019/3.hs
@@ -0,0 +1,55 @@
+module Main where
+
+import Data.Char
+import Data.List
+import qualified Data.Set as Set
+
+import Input
+
+
+data Pt = Pt Int Int deriving (Show, Eq, Ord)
+data Dir = U | L | D | R deriving (Show)
+data Seg = Seg Pt Dir Int deriving (Show)
+
+direction :: Dir -> Pt
+direction U = Pt 0 1
+direction R = Pt 1 0
+direction D = Pt 0 (-1)
+direction L = Pt (-1) 0
+
+add :: Pt -> Pt -> Pt
+add (Pt x y) (Pt a b) = Pt (x + a) (y + b)
+
+scale :: Int -> Pt -> Pt
+scale n (Pt x y) = Pt (n * x) (n * y)
+
+parse :: String -> [(Dir, Int)]
+parse "" = []
+parse (c:s) =
+    let dir = case c of
+                  'U' -> U
+                  'R' -> R
+                  'D' -> D
+                  'L' -> L
+                  _ -> undefined
+        (ns, r) = span isDigit s
+    in (dir, read ns) : parse (dropWhile (== ',') r)
+
+process :: Pt -> [(Dir, Int)] -> [Seg]
+process _ [] = []
+process pt ((dir, n) : rest) =
+    Seg pt dir n : process (add pt (scale n (direction dir))) rest
+
+points :: Seg -> [Pt]
+points (Seg pt dir n) =
+    let delta = direction dir
+    in [add pt (scale k delta) | k <- [1..n]]
+
+manhattan :: Pt -> Int
+manhattan (Pt x y) = abs x + abs y
+
+main :: IO ()
+main = do
+    ls <- map (process (Pt 0 0) . parse) <$> getInput 3
+    let pts = Set.toList (foldl1 Set.intersection (map (Set.fromList . concatMap points) ls))
+    print (manhattan (head (sortOn manhattan pts)))