module Algebra.Structures.Ring
( Ring(..)
, propRing
, (<->), (<^>), (*>)
, sumRing, productRing
) where
import Test.QuickCheck
infixl 8 <^>
infixl 7 <*>
infixl 7 *>
infixl 6 <+>
infixl 6 <->
class Ring a where
(<+>) :: a -> a -> a
(<*>) :: a -> a -> a
neg :: a -> a
zero :: a
one :: a
propAddAssoc :: (Ring a, Eq a) => a -> a -> a -> (Bool,String)
propAddAssoc a b c = ((a <+> b) <+> c == a <+> (b <+> c), "propAddAssoc")
propAddIdentity :: (Ring a, Eq a) => a -> (Bool,String)
propAddIdentity a = (a <+> zero == a && zero <+> a == a, "propAddIdentity")
propAddInv :: (Ring a, Eq a) => a -> (Bool,String)
propAddInv a = (neg a <+> a == zero && a <+> neg a == zero, "propAddInv")
propAddComm :: (Ring a, Eq a) => a -> a -> (Bool,String)
propAddComm x y = (x <+> y == y <+> x, "propAddComm")
propMulAssoc :: (Ring a, Eq a) => a -> a -> a -> (Bool,String)
propMulAssoc a b c = ((a <*> b) <*> c == a <*> (b <*> c), "propMulAssoc")
propRightDist :: (Ring a, Eq a) => a -> a -> a -> (Bool,String)
propRightDist a b c =
((a <+> b) <*> c == (a <*> c) <+> (b <*> c), "propRightDist")
propLeftDist :: (Ring a, Eq a) => a -> a -> a -> (Bool,String)
propLeftDist a b c =
(a <*> (b <+> c) == (a <*> b) <+> (a <*> c), "propLeftDist")
propMulIdentity :: (Ring a, Eq a) => a -> (Bool,String)
propMulIdentity a = (one <*> a == a && a <*> one == a, "propMulIdentity")
propRing :: (Ring a, Eq a) => a -> a -> a -> Property
propRing a b c = whenFail (print errorMsg) cond
where
(cond,errorMsg) =
propAddAssoc a b c &&& propAddIdentity a &&& propAddInv a &&&
propAddComm a b &&& propMulAssoc a b c &&& propRightDist a b c &&&
propLeftDist a b c &&& propMulIdentity a
(False,x) &&& _ = (False,x)
_ &&& (False,x) = (False,x)
_ &&& _ = (True,"")
(<->) :: Ring a => a -> a -> a
a <-> b = a <+> neg b
sumRing :: Ring a => [a] -> a
sumRing = foldr (<+>) zero
productRing :: Ring a => [a] -> a
productRing = foldr (<*>) one
(<^>) :: Ring a => a -> Integer -> a
x <^> 0 = one
x <^> y = if y < 0
then error "<^>: Input should be positive"
else x <*> x <^> (y1)
(*>) :: Ring a => Int -> a -> a
n *> x = sumRing $ replicate n x