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

<https://adventofcode.com/2015/day/14>

>>> :{
:main +
  "time 1000\n\
  \Comet can fly 14 km/s for 10 seconds, but then must rest for 127 seconds.\n\
  \Dancer can fly 16 km/s for 11 seconds, but then must rest for 162 seconds.\n"
:}
1120
689

-}
module Main where

import Advent (format, partialSums)
import Data.List (transpose)
import Data.Maybe (fromMaybe)

data Reindeer = Reindeer
  { Reindeer -> Int
speed     :: Int   -- ^ units of distance flown per second
  , Reindeer -> Int
stamina   :: Int   -- ^ number of seconds flown before rest
  , Reindeer -> Int
breaktime :: Int   -- ^ number of seconds rested before flying
  }

-- |
-- >>> :main
-- 2660
-- 1256
main :: IO ()
IO ()
main =
 do (Maybe Int
mbtime,[([Char], Int, Int, Int)]
input) <- [format|2015 14 (time %u%n|)(%s can fly %u km/s for %u seconds, but then must rest for %u seconds.%n)*|]
    let time :: Int
time = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
2503 Maybe Int
mbtime
    let rs :: [Reindeer]
rs = [Reindeer{Int
speed :: Int
stamina :: Int
breaktime :: Int
speed :: Int
stamina :: Int
breaktime :: Int
..} | ([Char]
_, Int
speed, Int
stamina, Int
breaktime) <- [([Char], Int, Int, Int)]
input]    
    let race :: [[Int]]
race = (Reindeer -> [Int]) -> [Reindeer] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
time ([Int] -> [Int]) -> (Reindeer -> [Int]) -> Reindeer -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reindeer -> [Int]
positions) [Reindeer]
rs
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (([Int] -> Int) -> [[Int]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Int
forall a. HasCallStack => [a] -> a
last [[Int]]
race))
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([[Int]] -> [Int]
scores [[Int]]
race))

-- | Compute the position of each reindeer at each second of the race
positions :: Reindeer -> [Int]
positions :: Reindeer -> [Int]
positions Reindeer
r
  = [Int] -> [Int]
forall a. Num a => [a] -> [a]
partialSums
  ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. HasCallStack => [a] -> [a]
cycle
  ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (Reindeer -> Int
stamina   Reindeer
r) (Reindeer -> Int
speed Reindeer
r) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (Reindeer -> Int
breaktime Reindeer
r) Int
0

-- | Given a list of race positions return a list of scores
scores :: [[Int]] -> [Int]
scores :: [[Int]] -> [Int]
scores = ([Int] -> Int) -> [[Int]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([[Int]] -> [Int]) -> ([[Int]] -> [[Int]]) -> [[Int]] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Int]] -> [[Int]]
forall a. [[a]] -> [[a]]
transpose ([[Int]] -> [[Int]]) -> ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> [Int]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> [Int]
awardPoints ([[Int]] -> [[Int]]) -> ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Int]] -> [[Int]]
forall a. [[a]] -> [[a]]
transpose

-- | Map each position to 1 point if it's in the lead or 0 otherwise
awardPoints ::
  [Int] {- ^ positions -} ->
  [Int] {- ^ points    -}
awardPoints :: [Int] -> [Int]
awardPoints [Int]
posns = [ if Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
best then Int
1 else Int
0 | Int
p <- [Int]
posns ]
  where
  best :: Int
best = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
posns