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