{-# LANGUAGE TypeFamilies #-}
{-|
== Modular arithmetic

MInt is a newtype of Int for arithmetic modulo a known fixed prime.
For a more general type see Mod.hs.

Instances of Eq, Num, Fractional exist for MInt. All the usual operations take O(1) time, except for
recip which takes O(log m) time.
An instance of Enum exists for MInt. The enum is cyclic, it wraps to 0 after m-1.
Unboxed array support is available via Unbox.

-}

{-
Implementation notes:
* MInt is a newtype of Int, change to Int64 if running on 32-bit.
-}

module MInt
    ( MInt(..)
    , mm
    ) where

import Control.DeepSeq
import Data.Ratio

import Array ( Unbox(..) )

-- | The prime modulus.
mm :: Int
mm :: Int
mm = Int
1000000007
-- m = 998244353

-- | Int type for arithmetic modulo a fixed prime mm.
newtype MInt = MInt { MInt -> Int
unMInt :: Int } deriving (MInt -> MInt -> Bool
(MInt -> MInt -> Bool) -> (MInt -> MInt -> Bool) -> Eq MInt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MInt -> MInt -> Bool
$c/= :: MInt -> MInt -> Bool
== :: MInt -> MInt -> Bool
$c== :: MInt -> MInt -> Bool
Eq, Eq MInt
Eq MInt
-> (MInt -> MInt -> Ordering)
-> (MInt -> MInt -> Bool)
-> (MInt -> MInt -> Bool)
-> (MInt -> MInt -> Bool)
-> (MInt -> MInt -> Bool)
-> (MInt -> MInt -> MInt)
-> (MInt -> MInt -> MInt)
-> Ord MInt
MInt -> MInt -> Bool
MInt -> MInt -> Ordering
MInt -> MInt -> MInt
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MInt -> MInt -> MInt
$cmin :: MInt -> MInt -> MInt
max :: MInt -> MInt -> MInt
$cmax :: MInt -> MInt -> MInt
>= :: MInt -> MInt -> Bool
$c>= :: MInt -> MInt -> Bool
> :: MInt -> MInt -> Bool
$c> :: MInt -> MInt -> Bool
<= :: MInt -> MInt -> Bool
$c<= :: MInt -> MInt -> Bool
< :: MInt -> MInt -> Bool
$c< :: MInt -> MInt -> Bool
compare :: MInt -> MInt -> Ordering
$ccompare :: MInt -> MInt -> Ordering
$cp1Ord :: Eq MInt
Ord, Int -> MInt -> ShowS
[MInt] -> ShowS
MInt -> String
(Int -> MInt -> ShowS)
-> (MInt -> String) -> ([MInt] -> ShowS) -> Show MInt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MInt] -> ShowS
$cshowList :: [MInt] -> ShowS
show :: MInt -> String
$cshow :: MInt -> String
showsPrec :: Int -> MInt -> ShowS
$cshowsPrec :: Int -> MInt -> ShowS
Show)

instance Num MInt where
    MInt Int
a + :: MInt -> MInt -> MInt
+ MInt Int
b = Int -> MInt
MInt (Int -> MInt) -> Int -> MInt
forall a b. (a -> b) -> a -> b
$ let c :: Int
c = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b in if Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mm then Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mm else Int
c
    MInt Int
a - :: MInt -> MInt -> MInt
- MInt Int
b = Int -> MInt
MInt (Int -> MInt) -> Int -> MInt
forall a b. (a -> b) -> a -> b
$ let c :: Int
c = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
b in if Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
mm else Int
c
    MInt Int
a * :: MInt -> MInt -> MInt
* MInt Int
b = Int -> MInt
MInt (Int -> MInt) -> Int -> MInt
forall a b. (a -> b) -> a -> b
$ Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
b Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
mm
    abs :: MInt -> MInt
abs             = MInt -> MInt
forall a. a -> a
id
    signum :: MInt -> MInt
signum          = Int -> MInt
MInt (Int -> MInt) -> (MInt -> Int) -> MInt -> MInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
signum (Int -> Int) -> (MInt -> Int) -> MInt -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MInt -> Int
unMInt
    fromInteger :: Integer -> MInt
fromInteger     = Int -> MInt
MInt (Int -> MInt) -> (Integer -> Int) -> Integer -> MInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> (Integer -> Integer) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mm)

instance Fractional MInt where
    recip :: MInt -> MInt
recip          = (MInt -> Int -> MInt
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
mm Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2))
    fromRational :: Rational -> MInt
fromRational Rational
r = Integer -> MInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
r) MInt -> MInt -> MInt
forall a. Fractional a => a -> a -> a
/ Integer -> MInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r)

instance Enum MInt where
    toEnum :: Int -> MInt
toEnum                 = Int -> MInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromEnum :: MInt -> Int
fromEnum               = MInt -> Int
unMInt
    enumFromTo :: MInt -> MInt -> [MInt]
enumFromTo MInt
x MInt
y         = (MInt -> Bool) -> [MInt] -> [MInt]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (MInt -> MInt -> Bool
forall a. Eq a => a -> a -> Bool
/= MInt
y MInt -> MInt -> MInt
forall a. Num a => a -> a -> a
+ MInt
1) [MInt
x..]
    enumFromThenTo :: MInt -> MInt -> MInt -> [MInt]
enumFromThenTo MInt
x1 MInt
x2 MInt
y = (MInt -> Bool) -> [MInt] -> [MInt]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (MInt -> MInt -> Bool
forall a. Eq a => a -> a -> Bool
/= MInt
y MInt -> MInt -> MInt
forall a. Num a => a -> a -> a
+ MInt
1) [MInt
x1, MInt
x2 ..]

instance Unbox MInt where
    type Unboxed MInt = Int

--------------------------------------------------------------------------------
-- For tests

instance NFData MInt where
    rnf :: MInt -> ()
rnf = MInt -> ()
forall a. a -> ()
rwhnf