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

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

Day 15 has us comparing two number sequence generators together to find
pairs that match on the lowest 16 bits.

-}
module Main where

import Advent (countBy, format)
import Data.Bits ((.&.))

-- | Print the solution to Day 15. Input file can be overridden with
-- command-line arguments.
main :: IO ()
IO ()
main =
  do (startA, startB) <- [format|2017 15 Generator A starts with %u%nGenerator B starts with %u%n|]

     print $ countBy (uncurry match) $ take 40e6
       $ zip (iterate nextA startA)
             (iterate nextB startB)

     print $ countBy (uncurry match) $ take 5e6
       $ zip (filter (isDivisibleBy 4) (iterate nextA startA))
             (filter (isDivisibleBy 8) (iterate nextB startB))

-- | Check if the first 16-bits of a pairs of numbers match.
match :: Int -> Int -> Bool
match :: Int -> Int -> Bool
match Int
x Int
y = Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xffff Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xffff

-- | Step functions for the generators.
nextA, nextB  :: Int -> Int
nextA :: Int -> Int
nextA Int
x = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16807 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
0x7fffffff
nextB :: Int -> Int
nextB Int
x = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
48271 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
0x7fffffff

-- | Returns true if the divisor evenly divides the dividend.
--
-- >>> isDivisibleBy 2 10
-- True
-- >>> isDivisibleBy 3 10
-- False
isDivisibleBy ::
  Int {- ^ divisor  -} ->
  Int {- ^ dividend -} ->
  Bool
isDivisibleBy :: Int -> Int -> Bool
isDivisibleBy Int
x Int
y = Int
y Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0