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

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

-}
module Main where

import Advent.Format (format)
import GHC.Natural (Natural)
import GHC.Num.Integer (integerPowMod#)

-- | >>> :main
-- 8997277
main :: IO ()
IO ()
main =
 do (Integer
row,Integer
col) <- [format|2015 25 To continue, please consult the code grid in the manual.  Enter the code at row %lu, column %lu.%n|]
    Integer -> IO ()
forall a. Show a => a -> IO ()
print (Integer -> Integer -> Integer
code Integer
row Integer
col)

-- | Compute the value at a location on Santa's infinite sheet of paper. 
code ::
  Integer {- ^ row    -} ->
  Integer {- ^ column -} ->
  Integer {- ^ cell value -}
code :: Integer -> Integer -> Integer
code Integer
row Integer
col
  = Integer
20151125
  Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> Integer -> Natural -> Integer
powModInteger Integer
252533 (Integer -> Integer -> Integer
cell (Integer
rowInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1) (Integer
colInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)) Natural
33554393
  Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
33554393

powModInteger :: Integer -> Integer -> Natural -> Integer 
powModInteger :: Integer -> Integer -> Natural -> Integer
powModInteger Integer
x Integer
y Natural
m =
  case Integer -> Integer -> Natural -> (# Natural | () #)
integerPowMod# Integer
x Integer
y Natural
m of
    (# Natural
x | #) -> Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
x
    (# | ()
_ #) -> String -> Integer
forall a. HasCallStack => String -> a
error String
"powModInteger: bad argument"

-- | Compute zero-indexed cell of diagonally filled table using zero-indexed row, column.
cell ::
  Integer {- ^ row    -} ->
  Integer {- ^ column -} ->
  Integer
cell :: Integer -> Integer -> Integer
cell Integer
r Integer
c = Integer -> Integer
sum1N (Integer
rInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
c) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
c

-- | Compute sum of non-negative integers from 0 to the given upper bound.
sum1N :: Integer {- ^ upper bound -} -> Integer
sum1N :: Integer -> Integer
sum1N Integer
n = Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*(Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot`Integer
2