{-# 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 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, ~~ 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
~~