mod 0.1.2.1 → 0.1.2.2
raw patch · 6 files changed
+203/−156 lines, 6 filesdep +tasty-benchdep −timedep ~base
Dependencies added: tasty-bench
Dependencies removed: time
Dependency ranges changed: base
Files
- Data/Mod.hs +12/−5
- README.md +5/−5
- bench/Bench.hs +128/−138
- changelog.md +4/−0
- mod.cabal +3/−3
- test/Test.hs +51/−5
Data/Mod.hs view
@@ -93,8 +93,8 @@ succ x = if x == maxBound then throw Overflow else coerce (succ @Natural) x pred x = if x == minBound then throw Underflow else coerce (pred @Natural) x - toEnum = fromIntegral- fromEnum = fromIntegral . unMod+ toEnum = (fromIntegral :: Int -> Mod m)+ fromEnum = (fromIntegral :: Natural -> Int) . unMod enumFrom x = enumFromTo x maxBound enumFromThen x y = enumFromThenTo x y (if y >= x then maxBound else minBound)@@ -293,8 +293,15 @@ mx ^% a | a < 0 = case invertMod mx of Nothing -> throw DivideByZero- Just my -> Mod $ powModNatural (unMod my) (fromIntegral (-a)) (natVal mx)- | otherwise = Mod $ powModNatural (unMod mx) (fromIntegral a) (natVal mx)+ Just my -> Mod $ powModNatural (unMod my) (fromIntegral' (-a)) (natVal mx)+ | otherwise = Mod $ powModNatural (unMod mx) (fromIntegral' a) (natVal mx)+ where+#if __GLASGOW_HASKELL__ == 900 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1+ -- Cannot use fromIntegral because of https://gitlab.haskell.org/ghc/ghc/-/issues/19411+ fromIntegral' = fromInteger . toInteger+#else+ fromIntegral' = fromIntegral+#endif {-# INLINABLE [1] (^%) #-} {-# SPECIALISE [1] (^%) ::@@ -355,7 +362,7 @@ pokeElemOff (Ptr addr#) off (0 :: Word) NatJ# bn -> do l <- exportBigNatToAddr bn addr# 0#- forM_ [fromIntegral l .. (sz `shiftL` lgWordSize) - 1] $ \off ->+ forM_ [(fromIntegral :: Word -> Int) l .. (sz `shiftL` lgWordSize) - 1] $ \off -> pokeElemOff (Ptr addr#) off (0 :: Word8) where sz = I# (sizeofBigNat# m#)
README.md view
@@ -86,7 +86,7 @@ and your moduli fit into `Word`, try `Data.Mod.Word`, which is a drop-in replacement of `Data.Mod`,-but offers almost twice faster addition and multiplication, and much less allocations.+offering better performance and much less allocations. ## Benchmarks @@ -95,10 +95,10 @@ | Discipline | `Data.Mod.Word` | `Data.Mod` | `modular` | `modular-arithmetic` | `finite-typelits` | `finite-field` | :---------- | :--------------: | :---------: | :-------: | :------------------: | :---------------: | :------------:-| Sum | 0.4x | 1x | 4.5x | 6.1x | 3.3x | 5.0x-| Product | 0.6x | 1x | 3.6x | 5.4x | 3.1x | 4.5x-| Inversion | 0.8x | 1x | N/A | 6.1x | N/A | 4.1x-| Power | 0.9x | 1x | 6.0x | 1.8x | 1.9x | 2.1x+| Sum | 0.25x | 1x | 11.4x | 5.7x | 8.9x | 8.6x+| Product | 0.95x | 1x | 9.6x | 4.8x | 7.0x | 7.0x+| Inversion | 0.95x | 1x | N/A | 2.6x | N/A | 3.0x+| Power | 0.90x | 1x | 6.9x | 3.8x | 5.0x | 4.9x ## What's next?
bench/Bench.hs view
@@ -1,13 +1,17 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-name-shadowing #-} module Main where -import Data.Maybe-import Data.Time.Clock-import System.IO+import Data.Proxy+import Test.Tasty.Bench import qualified Data.Mod import qualified Data.Mod.Word@@ -24,180 +28,166 @@ import qualified Numeric.Modular #endif -import Text.Printf--normalize :: NominalDiffTime -> NominalDiffTime -> String-normalize unit t = printf "%.2fx" (fromRational (toRational t / toRational unit) :: Double)--benchAddition :: IO ()-benchAddition = do- putStrLn "Sum"-- t0 <- getCurrentTime- print (sum [1..10^8] :: Data.Mod.Mod 1000000007)- t1 <- getCurrentTime- let unit = diffUTCTime t1 t0-- t0 <- getCurrentTime- print (sum [1..10^8] :: Data.Mod.Word.Mod 1000000007)- t1 <- getCurrentTime- putStrLn $ "Data.Mod.Word " ++ normalize unit (diffUTCTime t1 t0)+type P = 20000003 - putStrLn "Data.Mod 1x"+#ifdef MIN_VERSION_modular+forceModular :: Numeric.Modular.Mod P -> Numeric.Modular.Mod P+forceModular a = (a == a) `seq` a+#endif +benchSum :: Benchmark+benchSum = bgroup "Sum"+ [ measure "Data.Mod" (Proxy @Data.Mod.Mod)+ , cmp $ measure "Data.Mod.Word" (Proxy @Data.Mod.Word.Mod) #ifdef MIN_VERSION_finite_field- t0 <- getCurrentTime- print (sum [1..10^8] :: Data.FiniteField.PrimeField.PrimeField 1000000007)- t1 <- getCurrentTime- putStrLn $ "finite-field " ++ normalize unit (diffUTCTime t1 t0)+ , cmp $ measure "finite-field" (Proxy @Data.FiniteField.PrimeField.PrimeField) #endif- #ifdef MIN_VERSION_finite_typelits- t0 <- getCurrentTime- print (sum [1..10^8] :: Data.Finite.Finite 1000000007)- t1 <- getCurrentTime- putStrLn $ "finite-typelits " ++ normalize unit (diffUTCTime t1 t0)+ , cmp $ measure "finite-typelits" (Proxy @Data.Finite.Finite) #endif- #ifdef MIN_VERSION_modular_arithmetic- t0 <- getCurrentTime- print (sum [1..10^8] :: Data.Modular.Mod Integer 1000000007)- t1 <- getCurrentTime- putStrLn $ "modular-arithmetic " ++ normalize unit (diffUTCTime t1 t0)+ , cmp $ measure "modular-arithmetic" (Proxy @(Data.Modular.Mod Integer)) #endif- #ifdef MIN_VERSION_modular- t0 <- getCurrentTime- print (sum (map fromIntegral [1..10^8]) :: Numeric.Modular.Mod 1000000007)- t1 <- getCurrentTime- putStrLn $ "modular " ++ normalize unit (diffUTCTime t1 t0)+ , cmp $ bench "modular" $ nf (show . sumNModular) lim #endif--benchProduct :: IO ()-benchProduct = do- putStrLn "Product"+ ]+ where+ cmp = bcompare "$NF == \"Data.Mod\" && $(NF-1) == \"Sum\""+ lim = 20000000 - t0 <- getCurrentTime- print (product [1..10^8] :: Data.Mod.Mod 1000000007)- t1 <- getCurrentTime- let unit = diffUTCTime t1 t0+ measure :: (Eq (t P), Num (t P)) => String -> Proxy t -> Benchmark+ measure name p = bench name $ whnf (sumN p) lim+ {-# INLINE measure #-} - t0 <- getCurrentTime- print (product [1..10^8] :: Data.Mod.Word.Mod 1000000007)- t1 <- getCurrentTime- putStrLn $ "Data.Mod.Word " ++ normalize unit (diffUTCTime t1 t0)+ sumN :: (Eq (t P), Num (t P)) => Proxy t -> Int -> t P+ sumN = const $ \n -> go 0 (fromIntegral n)+ where+ go !acc 0 = acc+ go acc n = go (acc + n) (n - 1)+ {-# INLINE sumN #-} - putStrLn "Data.Mod 1x"+#ifdef MIN_VERSION_modular+ sumNModular :: Int -> Numeric.Modular.Mod P+ sumNModular = \n -> go 0 (fromIntegral n)+ where+ go acc@(forceModular -> !_) 0 = acc+ go acc n = go (acc + n) (n - 1)+ {-# INLINE sumNModular #-}+#endif +benchProduct :: Benchmark+benchProduct = bgroup "Product"+ [ measure "Data.Mod" (Proxy @Data.Mod.Mod)+ , cmp $ measure "Data.Mod.Word" (Proxy @Data.Mod.Word.Mod) #ifdef MIN_VERSION_finite_field- t0 <- getCurrentTime- print (product [1..10^8] :: Data.FiniteField.PrimeField.PrimeField 1000000007)- t1 <- getCurrentTime- putStrLn $ "finite-field " ++ normalize unit (diffUTCTime t1 t0)+ , cmp $ measure "finite-field" (Proxy @Data.FiniteField.PrimeField.PrimeField) #endif- #ifdef MIN_VERSION_finite_typelits- t0 <- getCurrentTime- print (product [1..10^8] :: Data.Finite.Finite 1000000007)- t1 <- getCurrentTime- putStrLn $ "finite-typelits " ++ normalize unit (diffUTCTime t1 t0)+ , cmp $ measure "finite-typelits" (Proxy @Data.Finite.Finite) #endif- #ifdef MIN_VERSION_modular_arithmetic- t0 <- getCurrentTime- print (product [1..10^8] :: Data.Modular.Mod Integer 1000000007)- t1 <- getCurrentTime- putStrLn $ "modular-arithmetic " ++ normalize unit (diffUTCTime t1 t0)+ , cmp $ measure "modular-arithmetic" (Proxy @(Data.Modular.Mod Integer)) #endif- #ifdef MIN_VERSION_modular- t0 <- getCurrentTime- print (product (map fromIntegral [1..10^8]) :: Numeric.Modular.Mod 1000000007)- t1 <- getCurrentTime- putStrLn $ "modular " ++ normalize unit (diffUTCTime t1 t0)+ , cmp $ bench "modular" $ nf (show . productNModular) lim #endif--benchInversion :: IO ()-benchInversion = do- putStrLn "Inversion"+ ]+ where+ cmp = bcompare "$NF == \"Data.Mod\" && $(NF-1) == \"Product\""+ lim = 20000000 - t0 <- getCurrentTime- print (sum (map (fromJust . Data.Mod.invertMod) [1..10^7]) :: Data.Mod.Mod 1000000007)- t1 <- getCurrentTime- let unit = diffUTCTime t1 t0+ measure :: (Eq (t P), Num (t P)) => String -> Proxy t -> Benchmark+ measure name p = bench name $ whnf (productN p) lim+ {-# INLINE measure #-} - t0 <- getCurrentTime- print (sum (map (fromJust . Data.Mod.Word.invertMod) [1..10^7]) :: Data.Mod.Word.Mod 1000000007)- t1 <- getCurrentTime- putStrLn $ "Data.Mod.Word " ++ normalize unit (diffUTCTime t1 t0)+ productN :: (Eq (t P), Num (t P)) => Proxy t -> Int -> t P+ productN = const $ \n -> go 1 (fromIntegral n)+ where+ go !acc 0 = acc+ go acc n = go (acc * n) (n - 1)+ {-# INLINE productN #-} - putStrLn "Data.Mod 1x"+#ifdef MIN_VERSION_modular+ productNModular :: Int -> Numeric.Modular.Mod P+ productNModular = \n -> go 1 (fromIntegral n)+ where+ go acc@(forceModular -> !_) 0 = acc+ go acc n = go (acc * n) (n - 1)+ {-# INLINE productNModular #-}+#endif +benchInversion :: Benchmark+benchInversion = bgroup "Inversion"+ [ measure "Data.Mod" (Proxy @Data.Mod.Mod)+ , cmp $ measure "Data.Mod.Word" (Proxy @Data.Mod.Word.Mod) #ifdef MIN_VERSION_finite_field- t0 <- getCurrentTime- print (sum (map recip [1..10^7]) :: Data.FiniteField.PrimeField.PrimeField 1000000007)- t1 <- getCurrentTime- putStrLn $ "finite-field " ++ normalize unit (diffUTCTime t1 t0)+ , cmp $ measure "finite-field" (Proxy @Data.FiniteField.PrimeField.PrimeField) #endif- #ifdef MIN_VERSION_modular_arithmetic- t0 <- getCurrentTime- print (sum (map Data.Modular.inv [1..10^7]) :: Data.Modular.Mod Integer 1000000007)- t1 <- getCurrentTime- putStrLn $ "modular-arithmetic " ++ normalize unit (diffUTCTime t1 t0)+ , cmp $ measure "modular-arithmetic" (Proxy @(Data.Modular.Mod Integer)) #endif--benchPower :: IO ()-benchPower = do- putStrLn "Power"-- t0 <- getCurrentTime- print (sum (map (2 ^) [1..10^6]) :: Data.Mod.Mod 1000000007)- t1 <- getCurrentTime- let unit = diffUTCTime t1 t0+ ]+ where+ cmp = bcompare "$NF == \"Data.Mod\" && $(NF-1) == \"Inversion\""+ lim = 1500000 - t0 <- getCurrentTime- print (sum (map (2 ^) [1..10^6]) :: Data.Mod.Word.Mod 1000000007)- t1 <- getCurrentTime- putStrLn $ "Data.Mod.Word " ++ normalize unit (diffUTCTime t1 t0)+ measure :: (Eq (t P), Fractional (t P)) => String -> Proxy t -> Benchmark+ measure name p = bench name $ whnf (invertN p) lim+ {-# INLINE measure #-} - putStrLn "Data.Mod 1x"+ invertN :: (Eq (t P), Fractional (t P)) => Proxy t -> Int -> t P+ invertN = const $ \n -> go 0 (fromIntegral n)+ where+ go !acc 0 = acc+ go acc n = go (acc + recip n) (n - 1)+ {-# INLINE invertN #-} +benchPower :: Benchmark+benchPower = bgroup "Power"+ [ measure "Data.Mod" (Proxy @Data.Mod.Mod)+ , cmp $ measure "Data.Mod.Word" (Proxy @Data.Mod.Word.Mod) #ifdef MIN_VERSION_finite_field- t0 <- getCurrentTime- print (sum (map (2 ^) [1..10^6]) :: Data.FiniteField.PrimeField.PrimeField 1000000007)- t1 <- getCurrentTime- putStrLn $ "finite-field " ++ normalize unit (diffUTCTime t1 t0)+ , cmp $ measure "finite-field" (Proxy @Data.FiniteField.PrimeField.PrimeField) #endif- #ifdef MIN_VERSION_finite_typelits- t0 <- getCurrentTime- print (sum (map (2 ^) [1..10^6]) :: Data.Finite.Finite 1000000007)- t1 <- getCurrentTime- putStrLn $ "finite-typelits " ++ normalize unit (diffUTCTime t1 t0)+ , cmp $ measure "finite-typelits" (Proxy @Data.Finite.Finite) #endif- #ifdef MIN_VERSION_modular_arithmetic- t0 <- getCurrentTime- print (sum (map (2 ^) [1..10^6]) :: Data.Modular.Mod Integer 1000000007)- t1 <- getCurrentTime- putStrLn $ "modular-arithmetic " ++ normalize unit (diffUTCTime t1 t0)+ , cmp $ measure "modular-arithmetic" (Proxy @(Data.Modular.Mod Integer)) #endif+#ifdef MIN_VERSION_modular+ , cmp $ bench "modular" $ nf (show . powerNModular) lim+#endif+ ]+ where+ cmp = bcompare "$NF == \"Data.Mod\" && $(NF-1) == \"Power\""+ lim = 1000000 + measure :: (Eq (t P), Num (t P)) => String -> Proxy t -> Benchmark+ measure name p = bench name $ whnf (powerN p) lim+ {-# INLINE measure #-}++ powerN :: (Eq (t P), Num (t P)) => Proxy t -> Int -> t P+ powerN = const $ go 0+ where+ go !acc 0 = acc+ go acc n = go (acc + 2 ^ n) (n - 1)+ {-# INLINE powerN #-}+ #ifdef MIN_VERSION_modular- t0 <- getCurrentTime- print (sum (map (2 ^) [1..10^6]) :: Numeric.Modular.Mod 1000000007)- t1 <- getCurrentTime- putStrLn $ "modular " ++ normalize unit (diffUTCTime t1 t0)+ powerNModular :: Int -> Numeric.Modular.Mod P+ powerNModular = go 0+ where+ go acc@(forceModular -> !_) 0 = acc+ go acc n = go (acc + 2 ^ n) (n - 1)+ {-# INLINE powerNModular #-} #endif main :: IO ()-main = do- hSetBuffering stdout LineBuffering- benchAddition- putStrLn ""- benchProduct- putStrLn ""- benchInversion- putStrLn ""- benchPower+main = defaultMain+ [ benchSum+ , benchProduct+ , benchInversion+ , benchPower+ ]
changelog.md view
@@ -1,3 +1,7 @@+# 0.1.2.2++* Work around an issue with [`fromIntegral`](https://gitlab.haskell.org/ghc/ghc/-/issues/19411) in GHC 9.0.1.+ # 0.1.2.1 * Support `integer-gmp-1.1`.
mod.cabal view
@@ -1,5 +1,5 @@ name: mod-version: 0.1.2.1+version: 0.1.2.2 cabal-version: >=1.10 build-type: Simple license: MIT@@ -15,7 +15,7 @@ Originally part of <https://hackage.haskell.org/package/arithmoi arithmoi> package. category: Math, Number Theory author: Andrew Lelechenko <andrew.lelechenko@gmail.com>-tested-with: GHC ==8.2.2 GHC ==8.4.4 GHC ==8.6.5 GHC ==8.8.3 GHC ==8.10.1+tested-with: GHC ==8.2.2 GHC ==8.4.4 GHC ==8.6.5 GHC ==8.8.3 GHC ==8.10.4 GHC ==9.0.1 extra-source-files: changelog.md README.md@@ -80,7 +80,7 @@ -- finite-typelits, -- modular, -- modular-arithmetic,- time+ tasty-bench >= 0.2.5 type: exitcode-stdio-1.0 main-is: Bench.hs default-language: Haskell2010
test/Test.hs view
@@ -5,7 +5,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -module Main where+module Main (main) where import Data.Bits import Data.Mod@@ -63,6 +63,8 @@ [ testProperty "fromInteger" fromIntegerRandomProp , testProperty "invertMod" invertModRandomProp , testProperty "powMod" powModRandomProp+ , testProperty "powMod on sum" powModRandomAdditiveProp+ , testProperty "powMod special case" powModCase ] , testGroup "Word.Mod 1" $@@ -94,6 +96,8 @@ , testProperty "invertMod" invertModWordRandomProp , testProperty "invertMod near maxBound" invertModWordRandomPropNearMaxBound , testProperty "powMod" powModWordRandomProp+ , testProperty "powMod on sum" powModWordRandomAdditiveProp+ , testProperty "powMod special case" powModWordCase ] ] @@ -210,8 +214,8 @@ -- powMod powModRandomProp :: Positive Integer -> Integer -> Int -> Property-powModRandomProp (Positive m) n k = m > 1 ==> case someNatVal (fromInteger m) of- SomeNat (Proxy :: Proxy m) -> powModProp (fromInteger n :: Mod m) k+powModRandomProp (Positive m) x n = m > 1 ==> case someNatVal (fromInteger m) of+ SomeNat (Proxy :: Proxy m) -> powModProp (fromInteger x :: Mod m) n powModProp :: KnownNat m => Mod m -> Int -> Property powModProp x n@@ -220,9 +224,25 @@ Nothing -> property True Just x' -> x ^% n === getProduct (stimes (-n) (Product x')) +powModRandomAdditiveProp :: Positive Integer -> Integer -> Huge Integer -> Huge Integer -> Property+powModRandomAdditiveProp (Positive m) x (Huge n1) (Huge n2) = m > 1 ==> case someNatVal (fromInteger m) of+ SomeNat (Proxy :: Proxy m) -> powModAdditiveProp (fromInteger x :: Mod m) n1 n2++powModAdditiveProp :: KnownNat m => Mod m -> Integer -> Integer -> Property+powModAdditiveProp x n1 n2+ | invertMod x == Nothing, n1 < 0 || n2 < 0+ = property True+ | otherwise+ = (x ^% n1) * (x ^% n2) === x ^% (n1 + n2)++powModCase :: Property+powModCase = once $ 0 ^% n === (0 :: Mod 2)+ where+ n = 1 `shiftL` 64 :: Integer+ powModWordRandomProp :: Word -> Integer -> Int -> Property-powModWordRandomProp m n k = m > 1 ==> case someNatVal (fromIntegral m) of- SomeNat (Proxy :: Proxy m) -> powModWordProp (fromInteger n :: Word.Mod m) k+powModWordRandomProp m x k = m > 1 ==> case someNatVal (fromIntegral m) of+ SomeNat (Proxy :: Proxy m) -> powModWordProp (fromInteger x :: Word.Mod m) k powModWordProp :: KnownNat m => Word.Mod m -> Int -> Property powModWordProp x n@@ -230,3 +250,29 @@ | otherwise = case Word.invertMod x of Nothing -> property True Just x' -> x Word.^% n === getProduct (stimes (-n) (Product x'))++powModWordRandomAdditiveProp :: Word -> Integer -> Huge Integer -> Huge Integer -> Property+powModWordRandomAdditiveProp m x (Huge n1) (Huge n2) = m > 1 ==> case someNatVal (fromIntegral m) of+ SomeNat (Proxy :: Proxy m) -> powModWordAdditiveProp (fromInteger x :: Word.Mod m) n1 n2++powModWordAdditiveProp :: KnownNat m => Word.Mod m -> Integer -> Integer -> Property+powModWordAdditiveProp x n1 n2+ | Word.invertMod x == Nothing, n1 < 0 || n2 < 0+ = property True+ | otherwise+ = (x Word.^% n1) * (x Word.^% n2) === x Word.^% (n1 + n2)++powModWordCase :: Property+powModWordCase = once $ 0 Word.^% n === (0 :: Word.Mod 2)+ where+ n = 1 `shiftL` 64 :: Integer++newtype Huge a = Huge { getHuge :: a }+ deriving (Show)++instance (Bits a, Num a, Arbitrary a) => Arbitrary (Huge a) where+ arbitrary = do+ Positive l <- arbitrary+ ds <- vector l+ return $ Huge $ foldl1 (\acc n -> acc `shiftL` 63 + n) ds+ shrink (Huge n) = Huge <$> shrink n