blob: b0f8e714c2dee24f5f13a2951e26422d71479909 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
module Main where
import Data.Char
import Data.List
import qualified Data.Map.Strict as Map
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
data Hit = Hit {hitPt :: Pt, hitIdx :: Int} deriving (Show)
instance Eq Hit where Hit p _ == Hit q _ = p == q
instance Ord Hit where compare (Hit p _) (Hit q _) = compare p q
points2 :: Int -> [Seg] -> [Hit]
points2 _ [] = []
points2 start (Seg pt dir n : segs) =
let delta = direction dir
in [Hit (add pt (scale k delta)) (start + k) | k <- [1..n]] ++ points2 (start + n) segs
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)))
let idxMap1 = Map.fromList . reverse $ [(hitPt h, hitIdx h) | h <- points2 0 (ls !! 0)]
idxMap2 = Map.fromList . reverse $ [(hitPt h, hitIdx h) | h <- points2 0 (ls !! 1)]
print $ minimum (zipWith (+) (map (idxMap1 Map.!) pts) (map (idxMap2 Map.!) pts))
|
