{-# LANGUAGE ImportQualifiedPost #-}
{-|
Module      : Main
Description : Day 13 solution
Copyright   : (c) Eric Mertens, 2018
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2018/day/13>

-}
module Main (main) where

import Data.Array.Unboxed qualified as A
import Data.Map (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (maybeToList)

import Advent.Coord
import Advent.Input (getInputArray)

-- | Turns determine the behavior at an intersection
data Turn = NextL | NextR | NextS deriving Int -> Turn -> ShowS
[Turn] -> ShowS
Turn -> String
(Int -> Turn -> ShowS)
-> (Turn -> String) -> ([Turn] -> ShowS) -> Show Turn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Turn -> ShowS
showsPrec :: Int -> Turn -> ShowS
$cshow :: Turn -> String
show :: Turn -> String
$cshowList :: [Turn] -> ShowS
showList :: [Turn] -> ShowS
Show

-- | Cart state includes the current direction of travel as well
-- as the next turn when an intersection is reached.
data Cart = Cart !Velocity !Turn deriving Int -> Cart -> ShowS
[Cart] -> ShowS
Cart -> String
(Int -> Cart -> ShowS)
-> (Cart -> String) -> ([Cart] -> ShowS) -> Show Cart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cart -> ShowS
showsPrec :: Int -> Cart -> ShowS
$cshow :: Cart -> String
show :: Cart -> String
$cshowList :: [Cart] -> ShowS
showList :: [Cart] -> ShowS
Show

-- | Velocities are stored row then column to match coordinates
type Velocity = Coord

-- | Road is a random-accessible representation of the track.
newtype Road = Road (A.UArray Coord Char)

-- | Carts are stored in a where they will naturally be ordered
-- in the way that the simulation calls for.
type CartQueue = Map Coord Cart


-- | Print the answers to day 13
--
-- >>> :main
-- 50,54
-- 50,100
main :: IO ()
IO ()
main =
 do Road
road <- UArray Coord Char -> Road
Road (UArray Coord Char -> Road) -> IO (UArray Coord Char) -> IO Road
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> IO (UArray Coord Char)
getInputArray Int
2018 Int
13
    let carts :: CartQueue
carts = Road -> CartQueue
findCarts Road
road
    String -> IO ()
putStrLn (Road -> CartQueue -> String
part1 Road
road CartQueue
carts)
    String -> IO ()
putStrLn (Road -> CartQueue -> String
part2 Road
road CartQueue
carts)

-- | Format a coordinate into X,Y notation.
--
-- >>> format (C 10 20)
-- "20,10"
format :: Coord -> String
format :: Coord -> String
format (C Int
y Int
x) = Int -> String
forall a. Show a => a -> String
show Int
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
y

-- | Run the simulation and report the location of the first collision.
part1 :: Road -> CartQueue -> String
part1 :: Road -> CartQueue -> String
part1 Road
road CartQueue
carts = Coord -> String
format ((Coord -> CartQueue -> CartQueue -> Coord)
-> Road -> CartQueue -> Coord
simulate (\Coord
pos CartQueue
_ CartQueue
_ -> Coord
pos) Road
road CartQueue
carts)

-- | Run the simulation and report the position of the final car.
part2 :: Road -> CartQueue -> String
part2 :: Road -> CartQueue -> String
part2 Road
road CartQueue
carts = Coord -> String
format ((Coord -> CartQueue -> CartQueue -> Coord)
-> Road -> CartQueue -> Coord
simulate Coord -> CartQueue -> CartQueue -> Coord
onCollision Road
road CartQueue
carts)
  where
    -- when a car collides, clear that location and resume the simulation
    onCollision :: Coord -> CartQueue -> CartQueue -> Coord
onCollision Coord
pos CartQueue
ready CartQueue
done =
      (Coord -> CartQueue -> CartQueue -> Coord)
-> Road -> CartQueue -> CartQueue -> Coord
tick Coord -> CartQueue -> CartQueue -> Coord
onCollision Road
road (Coord -> CartQueue -> CartQueue
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Coord
pos CartQueue
ready) (Coord -> CartQueue -> CartQueue
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Coord
pos CartQueue
done)

-- | Look up the road element at a particular coordinate
indexRoad :: Road -> Coord -> Char
indexRoad :: Road -> Coord -> Char
indexRoad (Road UArray Coord Char
v) Coord
c = UArray Coord Char
v UArray Coord Char -> Coord -> Char
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
A.! Coord
c

-- | Find all the initial locations and velocities of the carts.
findCarts :: Road -> CartQueue
findCarts :: Road -> CartQueue
findCarts (Road UArray Coord Char
rs) =
  [(Coord, Cart)] -> CartQueue
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (Coord
pos, Coord -> Turn -> Cart
Cart Coord
vel Turn
NextL)
    | (Coord
pos, Char
c) <- UArray Coord Char -> [(Coord, Char)]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
A.assocs UArray Coord Char
rs
    , Coord
vel <- Maybe Coord -> [Coord]
forall a. Maybe a -> [a]
maybeToList (Char -> Maybe Coord
charToVec Char
c)
    ]

-- | Run the simulation to completion. Take the collision behavior
-- as a parameter to allow part1 and part2 to share the same
-- simulation. When a cart collides with another control of
-- the simulation will switch to the collision parameter.
simulate ::
  (Coord -> CartQueue -> CartQueue -> Coord)
            {- ^ collision behavior: position, ready queue, done queue -} ->
  Road      {- ^ road                                                  -} ->
  CartQueue {- ^ starting cart states                                  -} ->
  Coord     {- ^ final cart position                                   -}
simulate :: (Coord -> CartQueue -> CartQueue -> Coord)
-> Road -> CartQueue -> Coord
simulate Coord -> CartQueue -> CartQueue -> Coord
onCollision Road
road CartQueue
carts
  | [Coord
pos] <- CartQueue -> [Coord]
forall k a. Map k a -> [k]
Map.keys CartQueue
carts = Coord
pos
  | Bool
otherwise               = (Coord -> CartQueue -> CartQueue -> Coord)
-> Road -> CartQueue -> CartQueue -> Coord
tick Coord -> CartQueue -> CartQueue -> Coord
onCollision Road
road CartQueue
carts CartQueue
forall k a. Map k a
Map.empty

-- | Run a single tick of the simulation.
tick ::
  (Coord -> CartQueue -> CartQueue -> Coord)
            {- ^ collision behavior: position, ready queue, done queue -} ->
  Road      {- ^ road                                                  -} ->
  CartQueue {- ^ carts ready to move                                   -} ->
  CartQueue {- ^ carts moved this tick                                 -} ->
  Coord     {- ^ final coordinate answer                               -}
tick :: (Coord -> CartQueue -> CartQueue -> Coord)
-> Road -> CartQueue -> CartQueue -> Coord
tick Coord -> CartQueue -> CartQueue -> Coord
onCollision Road
road CartQueue
carts CartQueue
done =
  case CartQueue -> Maybe ((Coord, Cart), CartQueue)
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey CartQueue
carts of
    Maybe ((Coord, Cart), CartQueue)
Nothing -> (Coord -> CartQueue -> CartQueue -> Coord)
-> Road -> CartQueue -> Coord
simulate Coord -> CartQueue -> CartQueue -> Coord
onCollision Road
road CartQueue
done
    Just ((Coord
pos, Cart
cart), CartQueue
carts')
      | Bool
collision -> Coord -> CartQueue -> CartQueue -> Coord
onCollision Coord
pos' CartQueue
carts' CartQueue
done
      | Bool
otherwise -> (Coord -> CartQueue -> CartQueue -> Coord)
-> Road -> CartQueue -> CartQueue -> Coord
tick Coord -> CartQueue -> CartQueue -> Coord
onCollision Road
road CartQueue
carts' (Coord -> Cart -> CartQueue -> CartQueue
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Coord
pos' Cart
cart' CartQueue
done)
      where
        collision :: Bool
collision     = Coord -> CartQueue -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Coord
pos' CartQueue
done Bool -> Bool -> Bool
|| Coord -> CartQueue -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Coord
pos' CartQueue
carts'
        (Coord
pos', Cart
cart') = Road -> Coord -> Cart -> (Coord, Cart)
drive Road
road Coord
pos Cart
cart

-- | Compute the next state of a cart when it is its turn to move
drive :: Road -> Coord -> Cart -> (Coord, Cart)
drive :: Road -> Coord -> Cart -> (Coord, Cart)
drive Road
road Coord
pos (Cart Coord
vel Turn
next) = (Coord
pos', Cart
cart')
  where
    pos' :: Coord
pos' = Coord
pos Coord -> Coord -> Coord
forall a. Num a => a -> a -> a
+ Coord
vel

    cart' :: Cart
cart' =
      case Road -> Coord -> Char
indexRoad Road
road Coord
pos' of
        Char
'\\' -> Coord -> Turn -> Cart
Cart (Coord -> Coord
invert Coord
vel) Turn
next
        Char
'/'  -> Coord -> Turn -> Cart
Cart (Coord -> Coord
invert' Coord
vel) Turn
next
        Char
'+'  -> Coord -> Turn -> Cart
Cart (Turn -> Coord -> Coord
turn Turn
next Coord
vel) (Turn -> Turn
nextTurn Turn
next)
        Char
_    -> Coord -> Turn -> Cart
Cart Coord
vel Turn
next

-- | Apply a turn to a velocity.
turn :: Turn -> Velocity -> Velocity
turn :: Turn -> Coord -> Coord
turn Turn
NextL = Coord -> Coord
turnLeft
turn Turn
NextR = Coord -> Coord
turnRight
turn Turn
NextS = Coord -> Coord
forall a. a -> a
id

-- | Advance a turn to the next one in sequence.
nextTurn :: Turn -> Turn
nextTurn :: Turn -> Turn
nextTurn Turn
NextL = Turn
NextS
nextTurn Turn
NextS = Turn
NextR
nextTurn Turn
NextR = Turn
NextL