diff --git a/Data/Mod.hs b/Data/Mod.hs --- a/Data/Mod.hs +++ b/Data/Mod.hs @@ -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#) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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? diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -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 + ] diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -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`. diff --git a/mod.cabal b/mod.cabal --- a/mod.cabal +++ b/mod.cabal @@ -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 package. category: Math, Number Theory author: Andrew Lelechenko -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 diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -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