module Algebra.PrincipalIdealDomain (
C,
extendedGCD,
gcd,
lcm,
euclid,
extendedEuclid,
extendedGCDMulti,
diophantine,
diophantineMin,
diophantineMulti,
chineseRemainder,
chineseRemainderMulti,
propMaximalDivisor,
propGCDDiophantine,
propExtendedGCDMulti,
propDiophantine,
propDiophantineMin,
propDiophantineMulti,
propDiophantineMultiMin,
propChineseRemainder,
propDivisibleGCD,
propDivisibleLCM,
propGCDIdentity,
propGCDCommutative,
propGCDAssociative,
propGCDHomogeneous,
propGCD_LCM,
) where
import qualified Algebra.Units as Units
import qualified Algebra.IntegralDomain as Integral
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import qualified Algebra.ZeroTestable as ZeroTestable
import qualified Algebra.Laws as Laws
import Algebra.Units (stdAssociate, stdUnitInv)
import Algebra.IntegralDomain (mod, safeDiv, divMod, divides, divModZero)
import Algebra.Ring (one, (*), scalarProduct)
import Algebra.Additive (zero, (+), ())
import Algebra.ZeroTestable (isZero)
import NumericPrelude.Condition (toMaybe)
import Control.Monad (foldM, liftM)
import Data.List (mapAccumL, mapAccumR, unfoldr)
import PreludeBase
import Prelude (Integer, Int)
import qualified Prelude as P
import Test.QuickCheck ((==>), Property)
class (Units.C a, ZeroTestable.C a) => C a where
extendedGCD :: a -> a -> (a,(a,a))
extendedGCD = extendedEuclid divMod
gcd :: a -> a -> a
gcd x y = fst $ extendedGCD x y
lcm :: a -> a -> a
lcm x y = safeDiv x (gcd x y) * y
euclid :: (Units.C a, ZeroTestable.C a) =>
(a -> a -> a) -> a -> a -> a
euclid genMod =
let aux x y =
if isZero y
then stdAssociate x
else aux y (x `genMod` y)
in aux
extendedEuclid :: (Units.C a, ZeroTestable.C a) =>
(a -> a -> (a,a)) -> a -> a -> (a,(a,a))
extendedEuclid genDivMod =
let aux x y =
if isZero y
then (stdAssociate x, (stdUnitInv x, zero))
else
let (d,m) = x `genDivMod` y
(g,(a,b)) = aux y m
in (g,(b,ab*d))
in aux
extendedGCDMulti :: C a => [a] -> (a,[a])
extendedGCDMulti xs =
let (g,cs) = mapAccumL extendedGCD zero xs
in (g, snd $ mapAccumR (\acc (c0,c1) -> (acc*c0,acc*c1)) one cs)
diophantine :: C a => a -> a -> a -> Maybe (a,a)
diophantine z x y =
fmap snd $ diophantineAux z x y
diophantineMin :: C a => a -> a -> a -> Maybe (a,a)
diophantineMin z x y =
fmap (uncurry (minimizeFirstOperand (x,y))) $
diophantineAux z x y
minimizeFirstOperand :: C a => (a,a) -> a -> (a,a) -> (a,a)
minimizeFirstOperand (x,y) g (a,b) =
if isZero g
then (zero,zero)
else
let xl = safeDiv x g
yl = safeDiv y g
(d,aRed) = divModZero a yl
in (aRed, b + d*xl)
diophantineAux :: C a => a -> a -> a -> Maybe (a, (a,a))
diophantineAux z x y =
let (g,(a,b)) = extendedGCD x y
(q,r) = divModZero z g
in toMaybe (isZero r) (g, (q*a, q*b))
diophantineMulti :: C a => a -> [a] -> Maybe [a]
diophantineMulti z xs =
let (g,as) = extendedGCDMulti xs
(q,r) = divModZero z g
in toMaybe (isZero r) (map (q*) as)
diophantineMultiMin :: C a => a -> [a] -> Maybe [a]
diophantineMultiMin z xs =
do as <- diophantineMulti z xs
return $ unfoldr
(\as' -> case as' of
((x0,a0):(x1,a1):aRest) ->
let (b0,b1) = minimizeFirstOperand (x0,x1) (gcd x0 x1) (a0,a1)
in Just (b0, (x1,b1):aRest)
(_,a):[] -> Just (a,[])
[] -> Nothing) $
zip xs as
chineseRemainder :: C a => (a,a) -> (a,a) -> Maybe (a,a)
chineseRemainder (m0,a0) (m1,a1) =
liftM (\(k,_) -> let m = lcm m0 m1 in (m, mod (a0k*m0) m)) $
diophantineMin (a0a1) m0 m1
chineseRemainderMulti :: C a => [(a,a)] -> Maybe (a,a)
chineseRemainderMulti congs =
case congs of
[] -> Nothing
(c:cs) -> foldM chineseRemainder c cs
instance C Integer where
gcd = euclid mod
instance C Int where
gcd = euclid mod
propGCDIdentity :: (Eq a, C a) => a -> Bool
propGCDAssociative :: (Eq a, C a) => a -> a -> a -> Bool
propGCDCommutative :: (Eq a, C a) => a -> a -> Bool
propGCDDiophantine :: (Eq a, C a) => a -> a -> Bool
propExtendedGCDMulti :: (Eq a, C a) => [a] -> Bool
propDiophantineGen :: (Eq a, C a) =>
(a -> a -> a -> Maybe (a,a)) -> a -> a -> a -> a -> Bool
propDiophantine :: (Eq a, C a) => a -> a -> a -> a -> Bool
propDiophantineMin :: (Eq a, C a) => a -> a -> a -> a -> Bool
propDiophantineMultiGen :: (Eq a, C a) =>
(a -> [a] -> Maybe [a]) -> [(a,a)] -> Bool
propDiophantineMulti :: (Eq a, C a) => [(a,a)] -> Bool
propDiophantineMultiMin :: (Eq a, C a) => [(a,a)] -> Bool
propDivisibleGCD :: C a => a -> a -> Bool
propDivisibleLCM :: C a => a -> a -> Bool
propGCD_LCM :: (Eq a, C a) => a -> a -> Bool
propGCDHomogeneous :: (Eq a, C a) => a -> a -> a -> Bool
propMaximalDivisor :: C a => a -> a -> a -> Property
propChineseRemainder :: (Eq a, C a) => a -> a -> [a] -> Property
propMaximalDivisor x y z =
divides z x && divides z y ==> divides z (gcd x y)
propGCDDiophantine x y =
let (g,(a,b)) = extendedGCD x y
in g == gcd x y && g == a*x+b*y
propExtendedGCDMulti xs =
let (g,as) = extendedGCDMulti xs
in g == scalarProduct as xs &&
(isZero g || all (divides g) xs)
propDiophantineGen dio a b x y =
let z = a*x+b*y
in maybe False (\(a',b') -> z == a'*x+b'*y) (dio z x y)
propDiophantine = propDiophantineGen diophantine
propDiophantineMin = propDiophantineGen diophantineMin
propDiophantineMultiGen dio axs =
let (as,xs) = unzip axs
z = scalarProduct as xs
in maybe False (\as' -> z == scalarProduct as' xs) (dio z xs)
propDiophantineMulti = propDiophantineMultiGen diophantineMulti
propDiophantineMultiMin = propDiophantineMultiGen diophantineMultiMin
propDivisibleGCD x y = divides (gcd x y) x
propDivisibleLCM x y = divides x (lcm x y)
propGCDIdentity = Laws.identity gcd zero . stdAssociate
propGCDCommutative = Laws.commutative gcd
propGCDAssociative = Laws.associative gcd
propGCDHomogeneous = Laws.leftDistributive (*) gcd . stdAssociate
propGCD_LCM x y = gcd x y * lcm x y == x * y
propChineseRemainder k x ms =
not (null ms) && all (not . isZero) ms ==>
let congs = zip ms (map (mod x) ms)
in maybe False
(\(mGlob,y) ->
let yk = y+mGlob*k
in all (\(m,a) -> Integral.sameResidueClass m a yk) congs)
(chineseRemainderMulti congs)