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

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

Day 13 asks us questions about packets traveling through
a periodic scanner.
-}
module Main where

import Advent.Format ( format )
import Data.List ( foldl', find )

-- | The scanners are represented by a pair of the number of
-- time units it will take a packet to reach that scanner and
-- the number of cells the scanner traverses.
type Scanners = [(Int,Int)]

-- | Compute the solutions to day 13. Input can be ovverridden via
-- command-line arguments.
main :: IO ()
IO ()
main =
  do [(Int, Int)]
input <- [format|2017 13 (%u: %u%n)*|]
     Int -> IO ()
forall a. Show a => a -> IO ()
print ([(Int, Int)] -> Int
part1 [(Int, Int)]
input)
     Maybe Int -> IO ()
forall a. Show a => a -> IO ()
print ([(Int, Int)] -> Maybe Int
part2 [(Int, Int)]
input)


-- | Returns true when the scanner will be at position 0 at the
-- given time-step.
--
-- >>> collides 6 4
-- True
-- >>> collides 5 4
-- False
collides ::
  Int {- ^ time step     -} ->
  Int {- ^ scanner depth -} ->
  Bool
collides :: Int -> Int -> Bool
collides Int
i Int
x = Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` ((Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

-- | Sum of the product of index and size of scanners that detect
-- the packet.
--
-- >>> part1 [(0,3),(1,2),(4,4),(6,4)]
-- 24
part1 :: Scanners -> Int
part1 :: [(Int, Int)] -> Int
part1 [(Int, Int)]
xs = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
x | (Int
i,Int
x) <- [(Int, Int)]
xs, Int -> Int -> Bool
collides Int
i Int
x ]

-- | Finds the smallest offset at which time a packet could traverse
-- the scanners without collision.
--
-- >>> part2 [(0,3),(1,2),(4,4),(6,4)]
-- Just 10
part2 :: Scanners -> Maybe Int
part2 :: [(Int, Int)] -> Maybe Int
part2 [(Int, Int)]
xs = (Int -> Bool) -> [Int] -> Maybe Int
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ([(Int, Int)] -> Int -> Bool
safeStart [(Int, Int)]
xs) [Int
0..Int
periodInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
  where
    period :: Int
period = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Integral a => a -> a -> a
lcm Int
1 [ (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2 | (Int
_,Int
x) <- [(Int, Int)]
xs ]

-- | Check that a packet delayed by a certain amount of time will
-- successfully clear the scanners.
safeStart :: Scanners -> Int {- ^ delay -} -> Bool
safeStart :: [(Int, Int)] -> Int -> Bool
safeStart [(Int, Int)]
xs Int
off = Bool -> Bool
not (((Int, Int) -> Bool) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(Int
i,Int
x) -> Int -> Int -> Bool
collides (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) Int
x) [(Int, Int)]
xs)