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

<https://adventofcode.com/2023/day/6>

This problem asks us to consider the time we should spend
charging up a toy car to beat a target distance. The distance
the car will travel is a quadratic equation. What we end up
doing is finding the distance between the roots of the function.

-- >>> :{
:main +
"Time:      7  15   30
Distance:  9  40  200
"
:}
288
71503

-}
module Main where

import Advent (format, binSearchLargest)

-- |
--
-- >>> :main
-- 281600
-- 33875953
main :: IO ()
IO ()
main =
 do ([[Char]]
times, [[Char]]
distances) <- [format|2023 6 Time:( +%s)*%nDistance:( +%s)*%n|]
    let input1 :: [(Int, Int)]
input1 = [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
forall a. Read a => [Char] -> a
read [[Char]]
times) (([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
forall a. Read a => [Char] -> a
read [[Char]]
distances)
        input2 :: (Int, Int)
input2 = ([Char] -> Int
forall a. Read a => [Char] -> a
read ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]]
times), [Char] -> Int
forall a. Read a => [Char] -> a
read ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]]
distances))
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
ways [(Int, Int)]
input1))
    Int -> IO ()
forall a. Show a => a -> IO ()
print ((Int, Int) -> Int
ways (Int, Int)
input2)

ways :: (Int, Int) -> Int
ways :: (Int, Int) -> Int
ways (Int
t, Int
d)
  | Int -> Bool
valid Int
mid = Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
tooLo
  | Bool
otherwise = Int
0
  where
    valid :: Int -> Bool
valid Int
hold = (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hold) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
hold Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
d
    mid :: Int
mid = Int
t Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 -- the midpoint is the best we can get
    tooLo :: Int
tooLo = (Int -> Bool) -> Int -> Int -> Int
binSearchLargest (Bool -> Bool
not (Bool -> Bool) -> (Int -> Bool) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool
valid)   Int
0 Int
mid
    hi :: Int
hi    = (Int -> Bool) -> Int -> Int -> Int
binSearchLargest        Int -> Bool
valid  Int
mid   Int
t