```{-# 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
```