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
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
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
pow :: Group a => a -> Integer -> a
pow g 0 = zero
pow g n | n > 0 = g <+> pow g (n1)
| otherwise = pow (neg g) (abs n)
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)
multiGen :: (Group a, Eq a) => [a] -> [a]
multiGen = nub . concatMap gen
order :: (Group a, Eq a) => a -> Int
order = length . gen
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 ]
product :: Group a => [a] -> [a] -> [a]
product as bs = [ a <+> b | a <- as , b <- bs ]
quotient :: Group a => [a] -> [a] -> [[a]]
quotient gs hs = [ leftCoset g hs | g <- gs ]
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