constructive-algebra 0.1.6 → 0.2.0

raw patch · 19 files changed

+335/−156 lines, 19 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• constructive-algebra.cabal +5/−3
• examples/Z_Examples.hs +21/−0
• src/Algebra/EllipticCurve.hs +1/−1
• src/Algebra/Ideal.hs +0/−1
• src/Algebra/Structures/BezoutDomain.hs +41/−49
• src/Algebra/Structures/CommutativeRing.hs +1/−1
• src/Algebra/Structures/EuclideanDomain.hs +2/−2
• src/Algebra/Structures/Field.hs +1/−1
• src/Algebra/Structures/FieldOfFractions.hs +1/−1
• src/Algebra/Structures/GCDDomain.hs +1/−1
• src/Algebra/Structures/Group.hs +108/−0
• src/Algebra/Structures/IntegralDomain.hs +1/−1
• src/Algebra/Structures/Module.hs +63/−0
• src/Algebra/Structures/PruferDomain.hs +61/−80
• src/Algebra/Structures/Ring.hs +15/−11
• src/Algebra/UPoly.hs +6/−2
• src/Algebra/Z.hs +3/−0
• src/Algebra/ZSqrt5.hs +3/−1
• src/Algebra/Zn.hs +1/−1

@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.1.6+Version:             0.2.0  Synopsis:            A library of constructive algebra. Description:         @@ -26,7 +26,7 @@  Author:              Anders Mortberg, Bassel Mannaa -Maintainer:          mortberg@student.chalmers.se+Maintainer:          mortberg@chalmers.se  -- A copyright notice. -- Copyright:           @@ -48,10 +48,12 @@  Library   -- Modules exported by the library.-  Exposed-modules:     Algebra.Structures.Ring, +  Exposed-modules:     Algebra.Structures.Group, +                       Algebra.Structures.Ring,                        Algebra.Structures.CommutativeRing,                        Algebra.Structures.IntegralDomain,                         Algebra.Structures.Field,+                       Algebra.Structures.Module,                        Algebra.Structures.BezoutDomain,                        Algebra.Structures.PruferDomain,                        Algebra.Structures.EuclideanDomain,

@@ -4,6 +4,7 @@ import Test.QuickCheck  import Algebra.Structures.BezoutDomain+import Algebra.Structures.PruferDomain import Algebra.Structures.StronglyDiscrete import Algebra.Structures.Coherent import Algebra.Ideal@@ -46,3 +47,23 @@  ex8 :: Matrix Z ex8 = computePLM_B (Id [2,3,4])++-------------------------------------------------------------------------------+-- Prufer domain++ex9 :: (Z,Z,Z)+ex9 = calcUVW 2 3++ex10 :: Matrix Z+ex10 = solvePD (Vec [1,2,3])++-------------------------------------------------------------------------------+-- Chinese remainder theorem++-- Solve the system:+-- x = 12 mod 31+-- x = 20 mod 41+--+-- Every solution x can be written x = 1004 + 1271*n+ex11 :: (Z,Z)+ex11 = crt [12,20] [31,41]

@@ -4,7 +4,7 @@  import Test.QuickCheck -import Algebra.Structures.Field hiding ((<*), (*>))+import Algebra.Structures.Field -- hiding ((<*), (*>)) import Algebra.Structures.EuclideanDomain (quotient, genEuclidAlg) import Algebra.Structures.BezoutDomain (toPrincipal) import Algebra.Structures.PruferDomain

@@ -11,7 +11,6 @@  import Algebra.Structures.CommutativeRing - ------------------------------------------------------------------------------- -- | Ideals characterized by their list of generators. 

@@ -1,14 +1,15 @@+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-} -- | Representation of Bezout domains. That is non-Noetherian analogues of  -- principal ideal domains. This means that all finitely generated ideals are -- principal. ---{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances #-} module Algebra.Structures.BezoutDomain   ( BezoutDomain(..)-  , propBezoutDomain-  , dividesB+  , propToPrincipal, propIsSameIdeal, propBezoutDomain+  , dividesB, gcdB   , intersectionB, intersectionBWitness   , solveB+  , crt   ) where  import Test.QuickCheck @@ -16,7 +17,6 @@ import Algebra.Structures.IntegralDomain import Algebra.Structures.Coherent import Algebra.Structures.EuclideanDomain-import Algebra.Structures.PruferDomain import Algebra.Structures.StronglyDiscrete import Algebra.Matrix import Algebra.Ideal@@ -38,9 +38,11 @@ class IntegralDomain a => BezoutDomain a where   toPrincipal :: Ideal a -> (Ideal a,[a],[a]) +-- | Test that the generated ideal is principal. propToPrincipal :: (BezoutDomain a, Eq a) => Ideal a -> Bool propToPrincipal = isPrincipal . (\(a,_,_) -> a) . toPrincipal +-- | Test that the generated ideal generate the same elements as the given. propIsSameIdeal :: (BezoutDomain a, Eq a) => Ideal a -> Bool propIsSameIdeal (Id as) =   let (Id [a], us, vs) = toPrincipal (Id as) @@ -61,6 +63,11 @@ dividesB a b = a == x || a == neg x     where (Id [x],_,_) = toPrincipal (Id [a,b]) +-- TODO: Add error cases...+gcdB :: BezoutDomain a => a -> a -> a+gcdB a b = g+  where (Id [g],_,_) = toPrincipal (Id [a,b])+ ------------------------------------------------------------------------------- -- Euclidean domain -> Bezout domain @@ -145,50 +152,35 @@     -- x = qg = q (sum (ai * xi)) = sum (q * ai * xi)     witness = handleZero xs (map (q1 <*>) as) ------------------------------------------------------------------------------------ | Bezout domain -> Prüfer domain----{--Prufer: forall a b exists u v w t.  u+t = 1 &  ua = vb & wa = tb -We consider only domain.-We assume we have the Bezout condition: given a, b we can find g,a1,b1,c,d s.t.--a = g a1-b = g b1-1 = c a1 + d b1--We try then --u = d b1-t = c a1--We should find v such that-a d b1 = b v-this simplifies to -g a1 d b1 = g b1 v-and we can take -v = a1 d-Similarly we can take -w = b1 c--We have shown that Bezout domain -> Prufer domain.--}-instance (BezoutDomain a, Eq a) => PruferDomain a where-  calcUVW a b | a == zero = (one,zero,zero)-              | b == zero = (zero,zero,zero)-              | otherwise = fromUVWTtoUVW (u,v,w,t)-    where-    -- Compute g, a1 and b1 such that:-    -- a = g*a1-    -- b = g*b1-    (g,[_,_],[a1,b1])  = toPrincipal (Id [a,b])-    -    -- Compute c and d such that:-    -- 1 = a1*c + a2*d-    (_,[c,d],_) = toPrincipal (Id [a1,b1])+-------------------------------------------------------------------------------+-- | Chinese remainder theorem+-- +-- Given a_1,...,a_n and m_1,...,m_n such that gcd(m_i,m_j) = 1.+-- Let m = m_1*...*m_n compute a such that:+-- +-- (1) a = a_i (mod m_i) +-- +-- (2) If b is such that+--      +--        b = a_i (mod m_i)+-- +--     then a = b (mod m)+--+-- The function return (a,m).+crt :: (BezoutDomain a, Eq a) => [a] -> [a] -> (a,a)+crt as ms+  | length as /= length ms = error "crt: Input lists need to have same length"+  | not (and [ gcdB m1 m2 == one | m1 <- ms, m2 <- ms, m1 /= m2 ]) = +      error "crt: All ms need to be relatively prime"+  | otherwise = crt' as ms+  where+  m = productRing ms -    u = d <*> b1-    t = c <*> a1-    v = d <*> a1-    w = c <*> b1+  crt' :: (BezoutDomain a, Eq a) => [a] -> [a] -> (a,a)+  crt' [] []                 = error "crt: Empty input"+  crt' [a] [m]               = (a,m)+  crt' [a1,a2] [m1,m2]       = let (_,[c1,c2],_) = toPrincipal (Id [m1,m2])+                               in (a1 <+> m1 <*> c1 <*> (a2 <-> a1), m1 <*> m2)+  crt' (a1:a2:as) (m1:m2:ms) = let (a',m') = crt' [a1,a2] [m1,m2]+                               in crt' (a':as) (m':ms)

@@ -1,7 +1,7 @@ module Algebra.Structures.CommutativeRing   ( module Algebra.Structures.Ring   , CommutativeRing(..)-  , propCommutativeRing+  , propMulComm, propCommutativeRing   ) where  import Test.QuickCheck

@@ -3,7 +3,7 @@ -- module Algebra.Structures.EuclideanDomain    ( EuclideanDomain(..)-  , propEuclideanDomain+  , propD, propQuotRem, propEuclideanDomain   , modulo, quotient, divides    , euclidAlg, genEuclidAlg   , lcmE, genLcmE@@ -27,7 +27,7 @@   d :: a -> Integer   quotientRemainder :: a -> a -> (a,a) --- Check both that |a| <= |ab| and |a| >= 0 for all a,b+-- | Check both that |a| <= |ab| and |a| >= 0 for all a,b. propD :: (EuclideanDomain a, Eq a) => a -> a -> Bool propD a b =    a == zero || b == zero || (d a <= d (a <*> b) && d a >= 0 && d b >= 0)

@@ -1,7 +1,7 @@ module Algebra.Structures.Field   ( module Algebra.Structures.IntegralDomain   , Field(inv)-  , propField+  , propMulInv, propField   , (</>)   ) where 

@@ -3,7 +3,7 @@ module Algebra.Structures.FieldOfFractions   ( FieldOfFractions(..)   , toFieldOfFractions, fromFieldOfFractions-  , reduce+  , reduce, propReduce   ) where  import Test.QuickCheck

@@ -7,7 +7,7 @@ {-# LANGUAGE FlexibleInstances, UndecidableInstances #-} module Algebra.Structures.GCDDomain    ( GCDDomain(gcd')-  , propGCDDomain+  , propGCD, propGCDDomain   ) where  import Test.QuickCheck

@@ -0,0 +1,108 @@+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}+module Algebra.Structures.Group+  ( Group(..)+  , propAssoc, propId, propInv, propGroup+  , AbelianGroup(..)+  , propComm, propAbelianGroup+  , sumGroup+  ) where++import qualified Algebra.Structures.CommutativeRing as R++import Test.QuickCheck+import Data.List++class Group a where+  (<+>) :: a -> a -> a+  zero  :: a+  neg   :: a -> a++propAssoc :: (Group a, Eq a) => a -> a -> a -> Bool+propAssoc a b c = (a <+> b) <+> c == a <+> (b <+> c)++propId :: (Group a, Eq a) => a -> Bool+propId a = a <+> zero == a && zero <+> a == a++propInv :: (Group a, Eq a) => a -> Bool+propInv a = neg a <+> a == zero && a <+> neg a == zero++propGroup :: (Group a, Eq a) => a -> a -> a -> Property+propGroup a b c = propAssoc a b c .&. propId a .&. propInv a++-- | Abelian groups:++class Group a => AbelianGroup a where++propComm :: (AbelianGroup a, Eq a) => a -> a -> Bool+propComm x y = x <+> y == y <+> x++propAbelianGroup :: (AbelianGroup a, Eq a) => a -> a -> a -> Property+propAbelianGroup a b c = propGroup a b c .&. propComm a b++sumGroup :: AbelianGroup a => [a] -> a+sumGroup xs = foldr (<+>) zero xs++-- | Pairs of groups:+instance (Group a, Group b) => Group (a,b) where+  zero            = (zero,zero)+  (a,b) <+> (c,d) = (a <+> c, b <+> d)+  neg (a,b)       = (neg a, neg b)+++instance R.Ring a => Group a where+  (<+>) = (R.<+>) +  zero  = R.zero+  neg   = R.neg++instance (Group a, R.Ring a) => AbelianGroup a++-------------------------------------------------------------------------------+-- Functions on groups:++-- | pow g n computes the n:th power of g, g^n+pow :: Group a => a -> Integer -> a+pow g 0 = zero+pow g n | n > 0     = g <+> pow g (n-1)+        | otherwise = pow (neg g) (abs n)++-- | gen g constructs the cyclic group <g> generated by g+gen :: (Group a, Eq a) => a -> [a]+gen g = reverse $ gen' 0 []+  where +  gen' n xs | elem (pow g n) xs = xs+            | otherwise         = gen' (n+1) (pow g n : xs)++-- | Generalization for multiple generators, <S> where S = {g_1,g_2,...}+multiGen :: (Group a, Eq a) => [a] -> [a]+multiGen = nub . concatMap gen++order :: (Group a, Eq a) => a -> Int+order = length . gen++-- | Compute the right and left cosets of a subset hs in the group G with +--   respect to an element g in G +rightCoset :: Group a => [a] -> a -> [a]+rightCoset hs g = [ h <+> g | h <- hs ]++leftCoset :: Group a => a -> [a] -> [a]+leftCoset g hs = [ g <+> h | h <- hs ]++-- | The product of two subgroups of G+product :: Group a => [a] -> [a] -> [a]+product as bs = [ a <+> b | a <- as , b <- bs ]++-- | Quotient groups, G/H, assumes that H is normal+--   This version does not respect possible duplicates+quotient :: Group a => [a] -> [a] -> [[a]]+quotient gs hs = [ leftCoset g hs | g <- gs ]++-- This version remove duplicates, for example:+-- > quotient z4 subZ4 +-- [[Z4 0,Z4 2],[Z4 1,Z4 3],[Z4 2,Z4 0],[Z4 3,Z4 1]]+-- > quotientGroups z4 subZ4 +-- [[Z4 0,Z4 2],[Z4 1,Z4 3]]+quotientGroups :: (Ord a, Group a) => [a] -> [a] -> [[a]]+quotientGroups gs hs = nub [ sort (leftCoset g hs) | g <- gs ]++(//) :: (Ord a, Group a) => [a] -> [a] -> [[a]]+(//) = quotientGroups

@@ -1,7 +1,7 @@ module Algebra.Structures.IntegralDomain   ( module Algebra.Structures.CommutativeRing   , IntegralDomain-  , propIntegralDomain+  , propZeroDivisors, propIntegralDomain   ) where  import Test.QuickCheck

@@ -0,0 +1,63 @@+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}+module Algebra.Structures.Module +  ( Module(..), (<*)+  , propScalarMul, propScalarAdd, propScalarAssoc, propModule+  ) where++import Algebra.Structures.Group as G+import Algebra.Structures.CommutativeRing as R -- hiding ((<*),(*>))+import Algebra.Z+import Algebra.Zn++import Test.QuickCheck++infixl 7 *>+infixl 7 <*++-- Consider only the commutative case, it would be possible to implement left+-- and right modules instead.++-- A module over a commutative ring r.+class (CommutativeRing r, AbelianGroup m) => Module r m where+  (*>) :: r -> m -> m++propScalarMul :: (Module r m, Eq m) => r -> m -> m -> Bool+propScalarMul r x y = r *> (x G.<+> y) == (r *> x) G.<+> (r *> y)++propScalarAdd :: (Module r m, Eq m) => r -> r -> m -> Bool+propScalarAdd r s x = (r R.<+> s) *> x == (r *> x) G.<+> (s *> x)++propScalarAssoc :: (Module r m, Eq m) => r -> r -> m -> Bool+propScalarAssoc r s x = (r <*> s) *> x == r *> (s *> x)++propModule :: (Module r m, Eq m) => r -> r -> m -> m -> Property+propModule r s x y =+  case (propScalarMul r x y, propScalarAdd r s x, propScalarAssoc r s x) of+    (True,True,True) -> whenFail (return ()) True+    (False,_,_)      -> whenFail (print "propScalarMul") False+    (_,False,_)      -> whenFail (print "propScalarAdd") False+    (_,_,False)      -> whenFail (print "propScalarAssoc") False++-- Since the ring is commutative we can turn this around.+(<*) :: Module r m => m -> r -> m+(<*) = flip (*>)++-- Z-module+instance AbelianGroup m => Module Z m where+  n *> x | n > 0  = sumGroup (replicate (fromInteger n) x)+         | n == 0 = G.zero+         | n < 0  = G.neg (abs n *> x)+++-- Sinze Z3 is an abelian group we get that it is a Z module for free:++test1 :: Z3+test1 = (2 :: Z) *> 5++test2 = quickCheck (propModule :: Z -> Z -> Z3 -> Z3 -> Property)++-- Vector spaces:+-- +-- There should be some nice way to do type-class aliases, something like:+--+-- type VectorSpace k m = Field k => Module k m

@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-} -- | Prufer domains are non-Noetherian analogues of Dedekind domains. That is -- integral domains in which every finitely generated ideal is invertible. This  -- implementation is mainly based on:@@ -5,8 +6,9 @@ -- http:\/\/hlombardi.free.fr\/liens\/salouThesis.pdf -- module Algebra.Structures.PruferDomain -  ( PruferDomain(..), propCalcUVW, propPruferDomain-  , calcUVWT, propCalcUVWT, fromUVWTtoUVW+  ( PruferDomain(..)+  , propCalcUVW, propPruferDomain+  , calcUVW_B, calcUVWT, propCalcUVWT, fromUVWTtoUVW   , computePLM_PD   , invertIdeal   , intersectionPD, intersectionPDWitness, solvePD@@ -16,6 +18,7 @@ import Data.List (nub, (\\))  import Algebra.Structures.IntegralDomain+import Algebra.Structures.BezoutDomain import Algebra.Structures.Coherent import Algebra.Ideal import Algebra.Matrix@@ -50,10 +53,63 @@ propCalcUVWT a b = u <*> a == v <*> b && w <*> a == t <*> b && u <+> t == one   where (u,v,w,t) = calcUVWT a b --- | Go back to the original definition (yes the name is stupid :P).-fromUVWTtoUVW :: PruferDomain a => (a,a,a,a) -> (a,a,a)+-- | Go back to the original definition.+fromUVWTtoUVW :: (a,a,a,a) -> (a,a,a) fromUVWTtoUVW (u,v,w,t) = (u,v,w)  ++--------------------------------------------------------------------------------+-- | Bezout domain -> Prüfer domain+--+{-+Prufer: forall a b exists u v w t.  u+t = 1 &  ua = vb & wa = tb++We consider only domain.+We assume we have the Bezout condition: given a, b we can find g,a1,b1,c,d s.t.++a = g a1+b = g b1+1 = c a1 + d b1++We try then ++u = d b1+t = c a1++We should find v such that+a d b1 = b v+this simplifies to +g a1 d b1 = g b1 v+and we can take +v = a1 d+Similarly we can take +w = b1 c++We have shown that Bezout domain -> Prufer domain.++instance (BezoutDomain a, Eq a) => PruferDomain a where+-}++-- | Proof that all Bezout domains are Prufer domains.+calcUVW_B :: (BezoutDomain a, Eq a) => a -> a -> (a,a,a)+calcUVW_B a b | a == zero = (one,zero,zero)+              | b == zero = (zero,zero,zero)+              | otherwise = fromUVWTtoUVW (u,v,w,t)+    where+    -- Compute g, a1 and b1 such that:+    -- a = g*a1+    -- b = g*b1+    (g,[_,_],[a1,b1])  = toPrincipal (Id [a,b])+    +    -- Compute c and d such that:+    -- 1 = a1*c + a2*d+    (_,[c,d],_) = toPrincipal (Id [a1,b1])++    u = d <*> b1+    t = c <*> a1+    v = d <*> a1+    w = c <*> b1+ ------------------------------------------------------------------------------- -- Coherence @@ -145,81 +201,6 @@    addZ n l x = replicate n zero ++ x : replicate (l-n-1) zero -{--intersectionPD :: (PruferDomain a, Eq a) => Ideal a -> Ideal a -> (Ideal a,[[a]],[[a]])-intersectionPD (Id xs) (Id ys) -  | xs' == [] || ys' == [] = zeroIdealWitnesses xs ys -  | otherwise              = (Id k, [handleZero xs as], [handleZero ys bs])-  where-  -- Compute <x1,...,xn> and <y1,...,ym>-  xs' = filter (/= zero) xs-  ys' = filter (/= zero) ys--  -- Compute <z_1...z_k>, k = n+m-  ij  = Id xs' `addId` Id ys'--  -- Compute <a_11,...,a_k1>-  inv = fromId $ invertIdeal ij---  k  = undefined-  as = undefined-  bs = undefined---- Handle the zeroes specially. If the first element in xs is a zero--- then the witness should be zero otherwise use the computed witness. -handleZero :: (Ring a, Eq a) => [a] -> [a] -> [a]-handleZero xs [] -  | all (==zero) xs = xs-  | otherwise       = error "intersectionPD: This should be impossible"-handleZero (x:xs) (a:as) -  | x == zero = zero : handleZero xs (a:as)-  | otherwise = a    : handleZero xs as-handleZero [] _  = error "intersectionPD: This should be impossible"--}-{--intersectionPDWitness :: (PruferDomain a, Eq a) => Ideal a -> Ideal a -> (Ideal a,[[a]],[[a]])-intersectionPDWitness (Id is) (Id js) = case foldr combine ([],[],[]) int of-  ([],_,_)   -> zeroIdealWitnesses is js-  (xs,ys,zs) -> (Id xs,ys,zs)-  where-  -- Compute the inverse of I+J:-  inv = fromId $ invertIdeal (Id is `addId` Id js)--  is' = one : tail is--  -- Compute lengths-  li  = length is'-  lj  = length js--  -- Compute the intersection with witnesses and remove all zeroes and duplicates-  int = nub [ (i <*> j <*> k, addZ m li (j <*> k), addZ n lj (i <*> k))-            | (m,i) <- zip [0..] is'-            , (n,j) <- zip [0..] js-            , k <- inv -            , i <*> j <*> k /= zero ]-  l   = length int--  addZ n l x = replicate n zero ++ (x:replicate (l-n-1) zero)--  combine (x,y,z) (xs,ys,zs) = (x:xs,y:ys,z:zs)--  as = filter (/= zero) $ concat -     $ drop (length (is \\ js)) -     $ unMVec -     $ transpose -     $ computePLM_PD -     $ Id is `addId` Id js--  -- concatMap (replicate (length ys)) as of-  -  asdf ys = [ addZ i li a | (i,_) <- zip [0..] is, a <- as ]--  -- case  of -  -- case [ concatMap (addZ i (length is)) a | (i,a) <- zip [0..] (replicate (length ys) as) ] of---    [[]] -> [ is ]---    x    -> x -- map (filter (/= zero)) x--} intersectionPD :: (PruferDomain a, Eq a) => Ideal a -> Ideal a -> Ideal a intersectionPD i j = fst3 (intersectionPDWitness i j)   where fst3 (x,_,_) = x@@ -229,4 +210,4 @@ solvePD x = solveWithIntersection x intersectionPDWitness  -- instance (PruferDomain a, Eq a) => Coherent a where---   solve x = solveWithIntersection x intersectIdeals+--   solve = solvePD

@@ -1,8 +1,10 @@ -- | The representation of the ring structure. module Algebra.Structures.Ring    ( Ring(..)+  , propAddAssoc, propAddIdentity, propAddInv, propAddComm+  , propMulAssoc, propMulIdentity, propRightDist, propLeftDist   , propRing-  , (<->), (<^>), (*>), (<*)+  , (<->), (<^>) -- , (*>), (<*)   , sumRing, productRing   ) where @@ -11,8 +13,8 @@  infixl 8 <^> infixl 7 <*>-infixl 7 *>-infixl 7 <*+-- infixl 7 *>+-- infixl 7 <* infixl 6 <+> infixl 6 <-> @@ -40,37 +42,37 @@ ------------------------------------------------------------------------------- -- Properties --- Addition satisfy the same properties as a commutative group+-- | Addition is associative. propAddAssoc :: (Ring a, Eq a) => a -> a -> a -> (Bool,String) propAddAssoc a b c = ((a <+> b) <+> c == a <+> (b <+> c), "propAddAssoc") --- Zero is the additive identity+-- | Zero is the additive identity. propAddIdentity :: (Ring a, Eq a) => a -> (Bool,String) propAddIdentity a = (a <+> zero == a && zero <+> a == a, "propAddIdentity") --- Negation is the additive inverse+-- | Negation give the additive inverse. propAddInv :: (Ring a, Eq a) => a -> (Bool,String) propAddInv a = (neg a <+> a == zero && a <+> neg a == zero, "propAddInv") --- Addition is commutative+-- | Addition is commutative. propAddComm :: (Ring a, Eq a) => a -> a -> (Bool,String) propAddComm x y = (x <+> y == y <+> x, "propAddComm") --- Multiplication is associative+-- | Multiplication is associative. propMulAssoc :: (Ring a, Eq a) => a -> a -> a -> (Bool,String) propMulAssoc a b c = ((a <*> b) <*> c == a <*> (b <*> c), "propMulAssoc") --- Multiplication is right-distributive over addition+-- | Multiplication is right-distributive over addition. propRightDist :: (Ring a, Eq a) => a -> a -> a -> (Bool,String) propRightDist a b c =    ((a <+> b) <*> c == (a <*> c) <+> (b <*> c), "propRightDist") --- Multiplication is left-ditributive over addition+-- | Multiplication is left-ditributive over addition. propLeftDist :: (Ring a, Eq a) => a -> a -> a -> (Bool,String) propLeftDist a b c =   (a <*> (b <+> c) == (a <*> b) <+> (a <*> c), "propLeftDist") --- One is multiplicative identity+-- | One is the multiplicative identity. propMulIdentity :: (Ring a, Eq a) => a -> (Bool,String) propMulIdentity a = (one <*> a == a && a <*> one == a, "propMulIdentity") @@ -110,6 +112,7 @@              then error "<^>: Input should be positive"              else x <*> x <^> (y-1) +{- -- | Multiply from left with an integer; n *> x means x + x + ... + x, n times. (*>) :: Ring a => Integer -> a -> a 0 *> _ = zero@@ -121,3 +124,4 @@ _ <* 0 = zero x <* n | n > 0     = x <+> x <* (n-1)        | otherwise = neg (x <* abs n) -- error "<*: Negative input"+-}       

@@ -17,6 +17,7 @@ import Algebra.Structures.Field import Algebra.Structures.BezoutDomain import Algebra.Structures.EuclideanDomain+import Algebra.Structures.PruferDomain import Algebra.Structures.StronglyDiscrete import Algebra.Ideal import Algebra.Q@@ -30,7 +31,7 @@ -- | The degree of the polynomial. deg :: CommutativeRing r => UPoly r x -> Integer deg (UP xs) | length xs < 2 = 0-            | otherwise = (toInteger $ length xs) - 1+            | otherwise     = toInteger (length xs) - 1  -- | Useful shorthand for Q[x]. type Qx = UPoly Q X_@@ -58,7 +59,7 @@  -- | Formal derivative of polynomials in k[x]. deriv :: CommutativeRing r => UPoly r x -> UPoly r x-deriv (UP ps) = UP $ zipWith (*>) [1..] (tail ps)+deriv (UP ps) = UP $ zipWith (\x -> sumRing . replicate x) [1..] (tail ps)  -- | Funny integration: integrate :: (Enum b, Field b, Integral k, Field k, Fractional b) => UPoly k x -> UPoly b x@@ -130,6 +131,9 @@     qr q r | d g <= d r = qr (q <+> monomial (lt r </> lt g) (d r - d g))                             (r <-> monomial (lt r </> lt g) (d r - d g) <*> g)            | otherwise = (q,r)++instance (Field k, Eq k) => PruferDomain (UPoly k x) where+  calcUVW = calcUVW_B  -- Now that we know that the polynomial ring k[x] is a Bezout domain it is -- possible to implement membership in an ideal of k[x]. f is a member of the

@@ -71,6 +71,9 @@ propPLMZ id = propPLM id (computePLM_B id)  -- Prufer domain+instance PruferDomain Z where+  calcUVW = calcUVW_B+ propPruferDomainZ :: Z -> Z -> Z -> Property propPruferDomainZ = propPruferDomain 

@@ -5,7 +5,9 @@  import Test.QuickCheck -import Algebra.Structures.IntegralDomain++import Algebra.Structures.IntegralDomain -- hiding ((*>),(<*))+import Algebra.Structures.Module import Algebra.Structures.EuclideanDomain (quotient, genEuclidAlg) import Algebra.Structures.BezoutDomain (toPrincipal) import Algebra.Structures.PruferDomain

@@ -5,7 +5,7 @@ -- testing used for instantiating integral domain and field type classes. The  -- primality testing is very slow, but it seem to be working fine for relatively -- small numbers.-module Algebra.Zn (Zn(..)) where+module Algebra.Zn (Zn(..), Z3) where  import Data.TypeLevel hiding ((+),(-),(*),mod,Eq,(==)) import Control.Monad (liftM)