X-Git-Url: https://git.njae.me.uk/?p=advent-of-code-18.git;a=blobdiff_plain;f=src%2Fadvent13%2Fadvent13.hs;h=c1bf4d8eb4e04055ac0333109ab36f1caa2af663;hp=354d24ace07566d4bc2c0bf5499275bf0dcdd930;hb=475f075633a2b578a919999b476c2aa137ebed41;hpb=5eaa0cf7eaef1a58be0f13c1273971bb118aa143

diff --git a/src/advent13/advent13.hs b/src/advent13/advent13.hs
index 354d24a..c1bf4d8 100644
--- a/src/advent13/advent13.hs
+++ b/src/advent13/advent13.hs
@@ -1,63 +1,140 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 
+import Prelude hiding (Left, Right)
 import Data.List
-import qualified Data.Set as S
+import Data.Tuple (swap)
+import qualified Data.Map.Strict as M
+import Data.Map.Strict ((!))
 
-data Cell = Empty | Horizontal | Vertical | Clockwise | Anticlockwise | Junction deriving (Show, Eq)
+import Debug.Trace
+
+type Coord = (Int, Int) -- x, y
+data Cell = Horizontal | Vertical | TopLeft | TopRight | Junction deriving (Show, Eq)
 data Direction = Up | Right | Down | Left deriving (Show, Eq, Ord, Enum, Bounded)
+data Decision = Anticlockwise | Straight | Clockwise deriving (Show, Eq, Ord, Enum, Bounded)
+data Cart = Cart Direction Decision deriving (Eq, Show)
+type Layout = M.Map Coord Cell
+type Carts = M.Map Coord Cart
+
 
 main :: IO ()
 main = do 
-    text <- TIO.readFile "data/advent12.txt"
-    let (initial, rules) = successfulParse text
-    let row = makeWorld 0 initial
-    print $ part1 rules row
-    print $ part2 rules row
-
-
+    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'
 
 -- Move in the current direction
-takeStep :: Direction -> Cell -> Int -> Int -> (Direction, Int, Int)
-takeStep Up x y = (x, y-1)
-takeStep Down x y = (x, y+1)
-takeStep Left x y = ( x-1, y)
-takeStep Right x y = (x+1, y)
+takeStep :: Direction -> Coord -> Coord
+takeStep Up (x, y) = (x, y-1)
+takeStep Down (x, y) = (x, y+1)
+takeStep Left (x, y) = ( x-1, y)
+takeStep Right (x, y) = (x+1, y)
+
+curve :: Direction -> Cell -> Direction 
+curve Up TopLeft = Left
+curve Down TopLeft = Right
+curve Left TopLeft = Up
+curve Right TopLeft = Down
+curve Up TopRight = Right
+curve Down TopRight = Left
+curve Left TopRight = Down
+curve Right TopRight = Up
+curve d _ = d
+
+junctionTurn :: Cell -> Direction -> Decision -> (Direction, Decision)
+junctionTurn Junction direction Anticlockwise = (predW direction, Straight)
+junctionTurn Junction direction Straight      = (direction,       Clockwise)
+junctionTurn Junction direction Clockwise     = (succW direction, Anticlockwise)
+junctionTurn _        direction decision      = (direction, decision)
 
 
 -- | a `succ` that wraps 
-turnCW :: (Bounded a, Enum a, Eq a) => a -> a 
-turnCW dir | dir == maxBound = minBound
-           | otherwise = succ dir
+succW :: (Bounded a, Enum a, Eq a) => a -> a 
+succW dir | dir == maxBound = minBound
+          | otherwise = succ dir
 
 -- | a `pred` that wraps
-turnACW :: (Bounded a, Enum a, Eq a) => a -> a
-turnACW dir | dir == minBound = maxBound
-            | otherwise = pred dir
-
-
-
--- Parse the input file
-
-type Parser = Parsec Void Text
-
-sc :: Parser ()
-sc = L.space (skipSome spaceChar) CA.empty CA.empty
-
-symb = L.symbol sc
-potP = (char '.' *> pure False) <|> (char '#' *> pure True)
-
-initialPrefix = symb "initial state:"
-ruleSepP = symb "=>"
-
-fileP = (,) <$> initialP <*> many ruleP
-initialP = initialPrefix *> many potP <* sc
-ruleP = Rule <$> ruleLHS <* ruleSepP <*> ruleRHS
-ruleLHS = count 5 potP <* sc
-ruleRHS = potP <* sc
+predW :: (Bounded a, Enum a, Eq a) => a -> a
+predW dir | dir == minBound = maxBound
+          | otherwise = pred dir
 
-successfulParse :: Text -> ([Bool], [Rule])
-successfulParse input = 
-        case parse fileP "input" input of
-                Left  _error -> ([], []) -- TIO.putStr $ T.pack $ parseErrorPretty err
-                Right world -> world