Merge pull request #102 from tau3/feature/89/coprimes

feature/89/coprimes

.gitignore

@@ -1,3 +1,4 @@
 *.hi
 *.o
 stack.yaml
+dist

Math/NumberTheory/GCD.hs

@@ -26,14 +26,24 @@
 {-# LANGUAGE LambdaCase   #-}
 {-# LANGUAGE MagicHash    #-}
 
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+
 module Math.NumberTheory.GCD
     ( binaryGCD
     , extendedGCD
     , coprime
     , splitIntoCoprimes
+    , Coprimes
+    , toList
+    , singleton
+    , insert
     ) where
 
 import Data.Bits
+import Data.Semigroup
+
+import qualified Data.Map.Strict as Map
+
 import GHC.Word
 import GHC.Int
 
@@ -252,6 +262,31 @@ cw16 (W16# x#) (W16# y#) = coprimeWord# x# y#
 cw32 :: Word32 -> Word32 -> Bool
 cw32 (W32# x#) (W32# y#) = coprimeWord# x# y#
 
+
+newtype Coprimes a b = Coprimes { unCoprimes :: Map.Map a b } deriving (Eq, Show)
+
+singleton :: a -> b -> Coprimes a b
+singleton a b = Coprimes (Map.singleton a b)
+
+toList :: Coprimes a b -> [(a, b)]
+toList x = Map.assocs $ unCoprimes x
+
+insert :: (Integral a, Bits a, Eq b, Num b) => a -> b -> Coprimes a b -> Coprimes a b
+insert a b cs@(Coprimes m) = if isCoprimeBase
+  then Coprimes (Map.insert a b m)
+  else splitIntoCoprimes ps
+  where isCoprimeBase = all (coprime a) (Map.keys m)
+        ps' = toList cs
+        ps = (a, b) : ps'
+
+instance (Integral a, Eq b, Num b) => Semigroup (Coprimes a b) where
+  (Coprimes l) <> (Coprimes r) = splitIntoCoprimes allTuples
+    where allTuples = (Map.assocs l) ++ (Map.assocs r)
+
+instance (Integral a, Eq b, Num b) => Monoid (Coprimes a b) where
+  mempty = Coprimes Map.empty
+  mappend = (<>)
+
 -- | The input list is assumed to be a factorisation of some number
 -- into a list of powers of (possibly, composite) non-zero factors. The output
 -- list is a factorisation of the same number such that all factors
@@ -261,11 +296,14 @@ cw32 (W32# x#) (W32# y#) = coprimeWord# x# y#
 -- composite factor.
 --
 -- > > splitIntoCoprimes [(140, 1), (165, 1)]
--- > [(5,2),(28,1),(33,1)]
+-- > Coprimes {unCoprimes = fromList [(5,2),(28,1),(33,1)]}
 -- > > splitIntoCoprimes [(360, 1), (210, 1)]
--- > [(2,4),(3,3),(5,2),(7,1)]
-splitIntoCoprimes :: (Integral a, Eq b, Num b) => [(a, b)] -> [(a, b)]
-splitIntoCoprimes xs = if any ((== 0) . fst) ys then [(0, 1)] else go ys
+-- > Coprimes {unCoprimes = fromList [(2,4),(3,3),(5,2),(7,1)]}
+splitIntoCoprimes :: (Integral a, Eq b, Num b) => [(a, b)] -> Coprimes a b
+splitIntoCoprimes xs = Coprimes (Map.fromList $ splitIntoCoprimes' xs)
+
+splitIntoCoprimes' :: (Integral a, Eq b, Num b) => [(a, b)] -> [(a, b)]
+splitIntoCoprimes' xs = if any ((== 0) . fst) ys then [(0, 1)] else go ys
   where
     ys = filter (/= (0, 0)) xs
 

Math/NumberTheory/Prefactored.hs

@@ -12,6 +12,8 @@
 {-# LANGUAGE CPP          #-}
 {-# LANGUAGE TypeFamilies #-}
 
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+
 module Math.NumberTheory.Prefactored
   ( Prefactored(prefValue, prefFactors)
   , fromValue
@@ -20,7 +22,9 @@ module Math.NumberTheory.Prefactored
 
 import Control.Arrow
 
-import Math.NumberTheory.GCD (splitIntoCoprimes)
+import Data.Semigroup
+
+import Math.NumberTheory.GCD (Coprimes, splitIntoCoprimes, toList, singleton)
 import Math.NumberTheory.UniqueFactorisation
 
 -- | A container for a number and its pairwise coprime (but not neccessarily prime)
@@ -79,7 +83,7 @@ import Math.NumberTheory.UniqueFactorisation
 data Prefactored a = Prefactored
   { prefValue   :: a
     -- ^ Number itself.
-  , prefFactors :: [(a, Word)]
+  , prefFactors :: Coprimes a Word
     -- ^ List of pairwise coprime (but not neccesarily prime) factors,
     -- accompanied by their multiplicities.
   } deriving (Show)
@@ -89,7 +93,7 @@ data Prefactored a = Prefactored
 -- > > fromValue 123
 -- > Prefactored {prefValue = 123, prefFactors = [(123, 1)]}
 fromValue :: a -> Prefactored a
-fromValue a = Prefactored a [(a, 1)]
+fromValue a = Prefactored a (singleton a 1)
 
 -- | Create 'Prefactored' from a given list of pairwise coprime
 -- (but not neccesarily prime) factors with multiplicities.
@@ -108,18 +112,18 @@ instance (Integral a, UniqueFactorisation a) => Num (Prefactored a) where
   Prefactored v1 _ - Prefactored v2 _
     = fromValue (v1 - v2)
   Prefactored v1 f1 * Prefactored v2 f2
-    = Prefactored (v1 * v2) (splitIntoCoprimes (f1 ++ f2))
+    = Prefactored (v1 * v2) (f1 <> f2)
   negate (Prefactored v f) = Prefactored (negate v) f
   abs (Prefactored v f)    = Prefactored (abs v) f
-  signum (Prefactored v _) = Prefactored (signum v) []
+  signum (Prefactored v _) = Prefactored (signum v) mempty
   fromInteger n = fromValue (fromInteger n)
 
 type instance Prime (Prefactored a) = Prime a
 
 instance UniqueFactorisation a => UniqueFactorisation (Prefactored a) where
   unPrime p = fromValue (unPrime p)
   factorise (Prefactored _ f)
-    = concatMap (\(x, xm) -> map (second (* xm)) (factorise x)) f
-  isPrime (Prefactored _ f) = case f of
+    = concatMap (\(x, xm) -> map (second (* xm)) (factorise x)) (toList f)
+  isPrime (Prefactored _ f) = case toList f of
     [(n, 1)] -> isPrime n
     _        -> Nothing

Math/NumberTheory/Primes/Factorisation/Montgomery.hs

@@ -64,7 +64,7 @@ import Data.Semigroup
 import GHC.TypeNats.Compat
 
 import Math.NumberTheory.Curves.Montgomery
-import Math.NumberTheory.GCD (splitIntoCoprimes)
+import Math.NumberTheory.GCD (splitIntoCoprimes, toList)
 import Math.NumberTheory.Moduli.Class
 import Math.NumberTheory.Powers.General     (highestPower, largePFPower)
 import Math.NumberTheory.Powers.Squares     (integerSquareRoot')
@@ -216,7 +216,7 @@ curveFactorisation primeBound primeTest prng seed mbdigs n
             SomeMod sm -> case montgomeryFactorisation b1 b2 sm of
               Nothing -> workFact m b1 b2 (count - 1)
               Just d  -> do
-                let cs = splitIntoCoprimes [(d, 1), (m `quot` d, 1)]
+                let cs = toList $ splitIntoCoprimes [(d, 1), (m `quot` d, 1)]
                 -- Since all @cs@ are coprime, we can factor each of
                 -- them and just concat results, without summing up
                 -- powers of the same primes in different elements.

test-suite/Math/NumberTheory/GCDTests.hs

@@ -11,7 +11,7 @@
 {-# LANGUAGE CPP                 #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-unused-imports #-}
 
 module Math.NumberTheory.GCDTests
   ( testSuite
@@ -22,6 +22,7 @@ import Test.Tasty.HUnit
 
 import Control.Arrow
 import Data.Bits
+import Data.Semigroup
 import Data.List (tails)
 import Numeric.Natural
 
@@ -48,21 +49,21 @@ coprimeProperty :: (Integral a, Bits a) => AnySign a -> AnySign a -> Bool
 coprimeProperty (AnySign a) (AnySign b) = coprime a b == (gcd a b == 1)
 
 splitIntoCoprimesProperty1 :: [(Positive Natural, Power Word)] -> Bool
-splitIntoCoprimesProperty1 fs' = factorback fs == factorback (splitIntoCoprimes fs)
+splitIntoCoprimesProperty1 fs' = factorback fs == factorback (toList $ splitIntoCoprimes fs)
   where
     fs = map (getPositive *** getPower) fs'
     factorback = product . map (uncurry (^))
 
 splitIntoCoprimesProperty2 :: [(Positive Natural, Power Word)] -> Bool
-splitIntoCoprimesProperty2 fs' = multiplicities fs <= multiplicities (splitIntoCoprimes fs)
+splitIntoCoprimesProperty2 fs' = multiplicities fs <= multiplicities (toList $ splitIntoCoprimes fs)
   where
     fs = map (getPositive *** getPower) fs'
     multiplicities = sum . map snd . filter ((/= 1) . fst)
 
 splitIntoCoprimesProperty3 :: [(Positive Natural, Power Word)] -> Bool
 splitIntoCoprimesProperty3 fs' = and [ coprime x y | (x : xs) <- tails fs, y <- xs ]
   where
-    fs = map fst $ splitIntoCoprimes $ map (getPositive *** getPower) fs'
+    fs = map fst $ toList $ splitIntoCoprimes $ map (getPositive *** getPower) fs'
 
 -- | Check that evaluation never freezes.
 splitIntoCoprimesProperty4 :: [(Integer, Word)] -> Bool
@@ -82,6 +83,33 @@ splitIntoCoprimesSpecialCase2 :: Assertion
 splitIntoCoprimesSpecialCase2 =
   assertBool "should not fail" $ splitIntoCoprimesProperty4 [(0, 1), (-2, 0)]
 
+toListReturnsCorrectValues :: Assertion
+toListReturnsCorrectValues =
+  assertEqual "should be equal" (toList $ splitIntoCoprimes [(140, 1), (165, 1)]) [(5,2),(28,1),(33,1)]
+
+unionReturnsCorrectValues :: Assertion
+unionReturnsCorrectValues =
+  let a = splitIntoCoprimes [(700, 1), (165, 1)] -- [(5,3),(28,1),(33,1)]
+      b = splitIntoCoprimes [(360, 1), (210, 1)] -- [(2,4),(3,3),(5,2),(7,1)]
+      expected = [(2,6),(3,4),(5,5),(7,2),(11,1)]
+      actual = toList (a <> b)
+  in assertEqual "should be equal" expected actual
+
+insertReturnsCorrectValuesWhenCoprimeBase :: Assertion
+insertReturnsCorrectValuesWhenCoprimeBase =
+  let a = insert 5 2 (singleton 4 3)
+      expected = [(4,3), (5,2)]
+      actual = toList a :: [(Int, Int)]
+  in assertEqual "should be equal" expected actual
+
+insertReturnsCorrectValuesWhenNotCoprimeBase :: Assertion
+insertReturnsCorrectValuesWhenNotCoprimeBase =
+  let a = insert 2 4 (insert 7 1 (insert 5 2 (singleton 4 3)))
+      actual = toList a :: [(Int, Int)]
+      expected = [(2,10), (5,2), (7,1)]
+  in assertEqual "should be equal" expected actual
+
+
 testSuite :: TestTree
 testSuite = testGroup "GCD"
   [ testSameIntegralProperty "binaryGCD"   binaryGCDProperty
@@ -96,4 +124,10 @@ testSuite = testGroup "GCD"
     , testCase          "does not freeze 2"                   splitIntoCoprimesSpecialCase2
     , testSmallAndQuick "does not freeze random"              splitIntoCoprimesProperty4
     ]
+  , testGroup "Coprimes"
+    [  testCase         "test equality"                       toListReturnsCorrectValues
+    ,  testCase         "test union"                          unionReturnsCorrectValues
+    ,  testCase         "test insert with coprime base"       insertReturnsCorrectValuesWhenCoprimeBase
+    ,  testCase         "test insert with non-coprime base"   insertReturnsCorrectValuesWhenNotCoprimeBase
+    ]
   ]

test-suite/Math/NumberTheory/PrefactoredTests.hs

@@ -23,7 +23,7 @@ import Data.Bits (Bits)
 import Data.List (tails)
 import Numeric.Natural
 
-import Math.NumberTheory.GCD (coprime, splitIntoCoprimes)
+import Math.NumberTheory.GCD (coprime, splitIntoCoprimes, toList)
 import Math.NumberTheory.Prefactored
 import Math.NumberTheory.TestUtils
 
@@ -33,7 +33,7 @@ isValid pref
   && and [ coprime g h | ((g, _) : gs) <- tails fs, (h, _) <- gs ]
   where
     n  = prefValue   pref
-    fs = prefFactors pref
+    fs = toList $ prefFactors pref
 
 fromValueProperty :: Integer -> Bool
 fromValueProperty n = isValid pref && prefValue pref == n
@@ -44,7 +44,7 @@ fromFactorsProperty :: [(Integer, Power Word)] -> Bool
 fromFactorsProperty fs' = isValid pref && abs (prefValue pref) == abs (product (map (uncurry (^)) fs))
   where
     fs   = map (second getPower) fs'
-    pref = fromFactors (splitIntoCoprimes fs)
+    pref = fromFactors (toList $ splitIntoCoprimes fs)
 
 plusProperty :: Integer -> Integer -> Bool
 plusProperty x y = isValid z && prefValue z == x + y