-- |
-- Module      : AOC.Challenge.Day25
-- License     : BSD3
--
-- Stability   : experimental
-- Portability : non-portable
--
-- Day 25.  See "AOC.Solver" for the types used in this module!

module AOC.Challenge.Day25 (
    day25a
  ) where

import           AOC.Common                         (_ListTup)
import           AOC.Solver                         ((:~>)(..))
import           Control.Lens                       (preview)
import           Control.Monad                      ((<=<))
import           Math.NumberTheory.Moduli           (Mod, PrimitiveRoot, (^%), getVal, isMultElement, discreteLogarithm, isPrimitiveRoot)
import           Math.NumberTheory.Moduli.Singleton (CyclicGroup, cyclicGroup)
import           Numeric.Natural                    (Natural)
import           Text.Read                          (readMaybe)

type Magic = 20201227

magicGroup :: CyclicGroup Integer Magic
Just CyclicGroup Integer Magic
magicGroup = Maybe (CyclicGroup Integer Magic)
forall a (m :: Nat).
(Integral a, UniqueFactorisation a, KnownNat m) =>
Maybe (CyclicGroup a m)
cyclicGroup

primBase :: PrimitiveRoot Magic
Just PrimitiveRoot Magic
primBase = CyclicGroup Integer Magic
-> Mod Magic -> Maybe (PrimitiveRoot Magic)
forall a (m :: Nat).
(Integral a, UniqueFactorisation a) =>
CyclicGroup a m -> Mod m -> Maybe (PrimitiveRoot m)
isPrimitiveRoot CyclicGroup Integer Magic
magicGroup Mod Magic
7

findSecret :: Mod Magic -> Maybe Natural
findSecret :: Mod Magic -> Maybe Natural
findSecret = (MultMod Magic -> Natural)
-> Maybe (MultMod Magic) -> Maybe Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CyclicGroup Integer Magic
-> PrimitiveRoot Magic -> MultMod Magic -> Natural
forall (m :: Nat).
CyclicGroup Integer m -> PrimitiveRoot m -> MultMod m -> Natural
discreteLogarithm CyclicGroup Integer Magic
magicGroup PrimitiveRoot Magic
primBase)
           (Maybe (MultMod Magic) -> Maybe Natural)
-> (Mod Magic -> Maybe (MultMod Magic))
-> Mod Magic
-> Maybe Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod Magic -> Maybe (MultMod Magic)
forall (m :: Nat). KnownNat m => Mod m -> Maybe (MultMod m)
isMultElement

day25a :: (Mod Magic, Mod Magic) :~> Integer
day25a :: (Mod Magic, Mod Magic) :~> Integer
day25a = MkSol :: forall a b.
(String -> Maybe a)
-> ((?dyno::DynoMap) => a -> Maybe b) -> (b -> String) -> a :~> b
MkSol
    { sParse :: String -> Maybe (Mod Magic, Mod Magic)
sParse = Getting
  (First (Mod Magic, Mod Magic)) [Mod Magic] (Mod Magic, Mod Magic)
-> [Mod Magic] -> Maybe (Mod Magic, Mod Magic)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting
  (First (Mod Magic, Mod Magic)) [Mod Magic] (Mod Magic, Mod Magic)
forall a. Prism' [a] (a, a)
_ListTup
           ([Mod Magic] -> Maybe (Mod Magic, Mod Magic))
-> (String -> Maybe [Mod Magic])
-> String
-> Maybe (Mod Magic, Mod Magic)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (String -> Maybe (Mod Magic)) -> [String] -> Maybe [Mod Magic]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Integer -> Mod Magic) -> Maybe Integer -> Maybe (Mod Magic)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Mod Magic
forall a. Num a => Integer -> a
fromInteger (Maybe Integer -> Maybe (Mod Magic))
-> (String -> Maybe Integer) -> String -> Maybe (Mod Magic)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe)
             ([String] -> Maybe [Mod Magic])
-> (String -> [String]) -> String -> Maybe [Mod Magic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
    , sShow :: Integer -> String
sShow  = Integer -> String
forall a. Show a => a -> String
show
    , sSolve :: (?dyno::DynoMap) => (Mod Magic, Mod Magic) -> Maybe Integer
sSolve = \(Mod Magic
x, Mod Magic
y) -> Mod Magic -> Integer
forall (m :: Nat). Mod m -> Integer
getVal (Mod Magic -> Integer)
-> (Natural -> Mod Magic) -> Natural -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mod Magic
y Mod Magic -> Natural -> Mod Magic
forall (m :: Nat) a.
(KnownNat m, Integral a) =>
Mod m -> a -> Mod m
^%) (Natural -> Integer) -> Maybe Natural -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod Magic -> Maybe Natural
findSecret Mod Magic
x
    }