+ text <- readFile "data/advent13.txt"
+ let (layout, carts) = parse text
+ -- print carts
+ -- print layout
+ -- print $ propogateUntilCollision (orderedCarts carts) layout carts
+ putStrLn $ showCoord $ part1 carts layout
+ putStrLn $ showCoord $ part2 carts layout
+
+
+part1 :: Carts -> Layout -> Coord
+part1 carts layout = collisionSite
+ where (collisionSite, _, _, _) = propogateUntilCollision (orderedCarts carts) layout carts
+
+part2 :: Carts -> Layout -> Coord
+part2 carts layout = propogateUntilOne (orderedCarts carts) layout carts
+
+showCoord :: Coord -> String
+showCoord (x, y) = show x ++ "," ++ show y
+
+
+-- Parsing
+parse :: String -> (Layout, Carts)
+parse text = foldl' parseRow (M.empty, M.empty) $ zip [0..] (lines text)
+
+parseRow (layout, carts) (y, row) = foldl' parseCellWithY (layout, carts) $ zip [0..] row
+ where parseCellWithY = parseCell y
+
+parseCell y (layout, carts) (x, cell) =
+ let here = (x, y)
+ in case cell of
+ '-' -> (M.insert here Horizontal layout, carts)
+ '|' -> (M.insert here Vertical layout, carts)
+ '\\' -> (M.insert here TopLeft layout, carts)
+ '/' -> (M.insert here TopRight layout, carts)
+ '+' -> (M.insert here Junction layout, carts)
+ '^' -> (M.insert here Vertical layout, M.insert here (Cart Up Anticlockwise) carts)
+ 'v' -> (M.insert here Vertical layout, M.insert here (Cart Down Anticlockwise) carts)
+ '<' -> (M.insert here Horizontal layout, M.insert here (Cart Left Anticlockwise) carts)
+ '>' -> (M.insert here Horizontal layout, M.insert here (Cart Right Anticlockwise) carts)
+ _ -> (layout, carts)
+
+
+-- Moving
+
+-- first argument is the carts left to move this tick.
+propogateUntilCollision :: [Coord] -> Layout -> Carts -> (Coord, Coord, [Coord], Carts)
+-- propogateUntilCollision cs _ carts | trace ("pUC " ++ show cs ++ " " ++ show carts) False = undefined
+-- finished this tick
+propogateUntilCollision [] layout carts =
+ if M.size carts <= 1
+ then (survivingCoord, survivingCoord, [], carts) -- empty coords list asserts finished a tick with only one cart remaining.
+ else propogateUntilCollision (orderedCarts carts) layout carts -- start the next tick
+ where survivingCoord = head $ M.keys carts
+-- not finished this tick, so move this cart then move the rest
+propogateUntilCollision (c:cs) layout carts =
+ if c' `M.member` carts
+ then (c', c, cs, carts)
+ else propogateUntilCollision cs layout carts'
+ where cart = carts!c
+ (c', cart') = moveOnce c cart layout
+ carts' = M.insert c' cart' $ M.delete c carts
+
+orderedCarts :: Carts -> [Coord]
+orderedCarts carts = sortOn swap $ M.keys carts
+
+-- move a cart, without getting as far as collision detection
+moveOnce :: Coord -> Cart -> Layout -> (Coord, Cart)
+moveOnce coord (Cart direction decision) layout = (coord', (Cart direction'' decision'))
+ where coord' = takeStep direction coord
+ direction' = (curve direction (layout!coord'))
+ (direction'', decision') = junctionTurn (layout!coord') direction' decision
+
+-- keep moving carts until only one left
+-- move carts until there's a collision; remove those carts then carry on
+propogateUntilOne :: [Coord] -> Layout -> Carts -> Coord
+propogateUntilOne coords layout carts =
+ if null coords' -- only when finished a tick and only one cart remaining.
+ then c1
+ else propogateUntilOne coords'' layout carts''
+ where (c1, c2, coords', carts') = propogateUntilCollision coords layout carts
+ carts'' = M.delete c1 $ M.delete c2 carts'
+ coords'' = filter (/= c1) $ filter (/= c2) coords'