group-theory-0.2.2: The theory of groups
Copyright(c) 2020-2021 Emily Pillmore
LicenseBSD-style
MaintainerEmily Pillmore <emilypi@cohomolo.gy>, Reed Mullanix <reedmullanix@gmail.com>
Stabilitystable
Portabilitynon-portable
Safe HaskellSafe
LanguageHaskell2010

Data.Group

Description

This module contains definitions for Group and Abelian, along with the relevant combinators.

Synopsis

Groups

The typeclass of groups (types with an associative binary operation that has an identity, and all inverses, i.e. a Monoid with all inverses), representing the structural symmetries of a mathematical object.

Instances should satisfy the following:

Right identity
x <> mempty = x
Left identity
mempty <> x = x
Associativity
x <> (y <> z) = (x <> y) <> z
Concatenation
mconcat = foldr (<>) mempty
Right inverses
x <> invert x = mempty
Left inverses
invert x <> x = mempty

Some types can be viewed as a group in more than one way, e.g. both addition and multiplication on numbers. In such cases we often define newtypes and make those instances of Group, e.g. Sum and Product. Often in practice such differences between addition and multiplication-like operations matter (e.g. when defining rings), and so, classes "additive" (the underlying operation is addition-like) and "multiplicative" group classes are provided in vis AdditiveGroup and MultiplicativeGroup.

Categorically, Groups may be viewed single-object groupoids.

class Monoid m => Group m where #

A Group is a Monoid plus a function, invert, such that:

a <> invert a == mempty
invert a <> a == mempty

Minimal complete definition

invert

Methods

invert :: m -> m #

(~~) :: m -> m -> m infixl 7 #

Group subtraction: x ~~ y == x <> invert y

pow :: Integral x => m -> x -> m #

pow a n == a <> a <> ... <> a
 (n lots of a)

If n is negative, the result is inverted.

Instances

Instances details
Group () 
Instance details

Defined in Data.Group

Methods

invert :: () -> () #

(~~) :: () -> () -> () #

pow :: Integral x => () -> x -> () #

Group a => Group (Identity a)

Identity lifts groups pointwise (at only one point).

Instance details

Defined in Data.Group

Methods

invert :: Identity a -> Identity a #

(~~) :: Identity a -> Identity a -> Identity a #

pow :: Integral x => Identity a -> x -> Identity a #

Group a => Group (Dual a) 
Instance details

Defined in Data.Group

Methods

invert :: Dual a -> Dual a #

(~~) :: Dual a -> Dual a -> Dual a #

pow :: Integral x => Dual a -> x -> Dual a #

Num a => Group (Sum a) 
Instance details

Defined in Data.Group

Methods

invert :: Sum a -> Sum a #

(~~) :: Sum a -> Sum a -> Sum a #

pow :: Integral x => Sum a -> x -> Sum a #

Fractional a => Group (Product a) 
Instance details

Defined in Data.Group

Methods

invert :: Product a -> Product a #

(~~) :: Product a -> Product a -> Product a #

pow :: Integral x => Product a -> x -> Product a #

Group a => Group (Down a) 
Instance details

Defined in Data.Group

Methods

invert :: Down a -> Down a #

(~~) :: Down a -> Down a -> Down a #

pow :: Integral x => Down a -> x -> Down a #

(Eq g, Group g) => Group (Abelianizer g) Source # 
Instance details

Defined in Data.Group

Ord a => Group (FreeAbelianGroup a) Source # 
Instance details

Defined in Data.Group.Free.Internal

Group (FreeGroup a) Source # 
Instance details

Defined in Data.Group.Free

Methods

invert :: FreeGroup a -> FreeGroup a #

(~~) :: FreeGroup a -> FreeGroup a -> FreeGroup a #

pow :: Integral x => FreeGroup a -> x -> FreeGroup a #

Group (FA a) Source # 
Instance details

Defined in Data.Group.Free.Church

Methods

invert :: FA a -> FA a #

(~~) :: FA a -> FA a -> FA a #

pow :: Integral x => FA a -> x -> FA a #

Group (FG a) Source # 
Instance details

Defined in Data.Group.Free.Church

Methods

invert :: FG a -> FG a #

(~~) :: FG a -> FG a -> FG a #

pow :: Integral x => FG a -> x -> FG a #

Group (Permutation a) Source # 
Instance details

Defined in Data.Group.Permutation

Group b => Group (a -> b) 
Instance details

Defined in Data.Group

Methods

invert :: (a -> b) -> a -> b #

(~~) :: (a -> b) -> (a -> b) -> a -> b #

pow :: Integral x => (a -> b) -> x -> a -> b #

(Group a, Group b) => Group (a, b) 
Instance details

Defined in Data.Group

Methods

invert :: (a, b) -> (a, b) #

(~~) :: (a, b) -> (a, b) -> (a, b) #

pow :: Integral x => (a, b) -> x -> (a, b) #

Group a => Group (Op a b) 
Instance details

Defined in Data.Group

Methods

invert :: Op a b -> Op a b #

(~~) :: Op a b -> Op a b -> Op a b #

pow :: Integral x => Op a b -> x -> Op a b #

Group (Proxy x)

Trivial group, Functor style.

Instance details

Defined in Data.Group

Methods

invert :: Proxy x -> Proxy x #

(~~) :: Proxy x -> Proxy x -> Proxy x #

pow :: Integral x0 => Proxy x -> x0 -> Proxy x #

(Group g, Group h) => Group (FreeProduct g h) Source # 
Instance details

Defined in Data.Group.Free.Product

Methods

invert :: FreeProduct g h -> FreeProduct g h #

(~~) :: FreeProduct g h -> FreeProduct g h -> FreeProduct g h #

pow :: Integral x => FreeProduct g h -> x -> FreeProduct g h #

(Group a, Group b, Group c) => Group (a, b, c) 
Instance details

Defined in Data.Group

Methods

invert :: (a, b, c) -> (a, b, c) #

(~~) :: (a, b, c) -> (a, b, c) -> (a, b, c) #

pow :: Integral x => (a, b, c) -> x -> (a, b, c) #

Group a => Group (Const a x)

Const lifts groups into a functor.

Instance details

Defined in Data.Group

Methods

invert :: Const a x -> Const a x #

(~~) :: Const a x -> Const a x -> Const a x #

pow :: Integral x0 => Const a x -> x0 -> Const a x #

(Group (f a), Group (g a)) => Group ((f :*: g) a)

Product of groups, Functor style.

Instance details

Defined in Data.Group

Methods

invert :: (f :*: g) a -> (f :*: g) a #

(~~) :: (f :*: g) a -> (f :*: g) a -> (f :*: g) a #

pow :: Integral x => (f :*: g) a -> x -> (f :*: g) a #

(Group a, Group b, Group c, Group d) => Group (a, b, c, d) 
Instance details

Defined in Data.Group

Methods

invert :: (a, b, c, d) -> (a, b, c, d) #

(~~) :: (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d) #

pow :: Integral x => (a, b, c, d) -> x -> (a, b, c, d) #

Group (f (g a)) => Group ((f :.: g) a) 
Instance details

Defined in Data.Group

Methods

invert :: (f :.: g) a -> (f :.: g) a #

(~~) :: (f :.: g) a -> (f :.: g) a -> (f :.: g) a #

pow :: Integral x => (f :.: g) a -> x -> (f :.: g) a #

(Group a, Group b, Group c, Group d, Group e) => Group (a, b, c, d, e) 
Instance details

Defined in Data.Group

Methods

invert :: (a, b, c, d, e) -> (a, b, c, d, e) #

(~~) :: (a, b, c, d, e) -> (a, b, c, d, e) -> (a, b, c, d, e) #

pow :: Integral x => (a, b, c, d, e) -> x -> (a, b, c, d, e) #

Group combinators

minus :: Group a => a -> a -> a Source #

Group subtraction.

This function denotes principled Group subtraction, where a minus b translates into a <> invert b. This is because subtraction as an operator is non-associative, but the operation described in terms of addition and inversion is.

gtimes :: (Group a, Integral n) => n -> a -> a Source #

An alias to pow.

Similar to stimes from Semigroup, but handles negative powers by using invert appropriately.

Examples:

Expand
>>> gtimes 2 (Sum 3)
Sum {getSum = 6}
>>> gtimes (-3) (Sum 3)
Sum {getSum = -9}

(><) :: Group a => a -> a -> a infixr 6 Source #

Apply (<>), commuting its arguments. When the group is abelian, a <> b is identically b <> a.

Conjugation

conjugate :: Group a => a -> a -> a Source #

Conjugate an element of a group by another element. When the group is abelian, conjugation is the identity.

Symbolically, this is \( (g,a) \mapsto gag^{-1} \).

Examples:

>>> let x = Sum (3 :: Int)
>>> conjugate x x
Sum {getSum = 3}

unconjugate :: Group a => a -> a -> a Source #

Apply an inverse conjugate to a conjugated element.

unconjugate . conjugate = id
conjugate . unconjugate = id

Examples:

>>> let x = Sum (3 :: Int)
>>> unconjugate x (conjugate x x)
Sum {getSum = 3}

pattern Conjugate :: Group a => (a, a) -> (a, a) Source #

Bidirectional pattern for conjugation by a group element

Note: When the underlying Group is abelian, this pattern is the identity.

Elements

pattern Inverse :: Group g => g -> g Source #

Bidirectional pattern for inverse elements.

pattern IdentityElem :: (Eq m, Monoid m) => m Source #

Bidirectional pattern for the identity element.

Abelianization

data Abelianizer a Source #

Quotient a pair of group elements by their commutator.

The of the quotient \( G / [G,G] \) forms an abelian group, and Abelianizer forms a functor from the category of groups to the category of Abelian groups. This functor is left adjoint to the inclusion functor \( Ab \rightarrow Grp \), forming a monad in \( Grp \).

Constructors

Quot 
Commuted a 

Instances

Instances details
Monad Abelianizer Source # 
Instance details

Defined in Data.Group

Methods

(>>=) :: Abelianizer a -> (a -> Abelianizer b) -> Abelianizer b #

(>>) :: Abelianizer a -> Abelianizer b -> Abelianizer b #

return :: a -> Abelianizer a #

Functor Abelianizer Source # 
Instance details

Defined in Data.Group

Methods

fmap :: (a -> b) -> Abelianizer a -> Abelianizer b #

(<$) :: a -> Abelianizer b -> Abelianizer a #

Applicative Abelianizer Source # 
Instance details

Defined in Data.Group

Methods

pure :: a -> Abelianizer a #

(<*>) :: Abelianizer (a -> b) -> Abelianizer a -> Abelianizer b #

liftA2 :: (a -> b -> c) -> Abelianizer a -> Abelianizer b -> Abelianizer c #

(*>) :: Abelianizer a -> Abelianizer b -> Abelianizer b #

(<*) :: Abelianizer a -> Abelianizer b -> Abelianizer a #

Foldable Abelianizer Source # 
Instance details

Defined in Data.Group

Methods

fold :: Monoid m => Abelianizer m -> m #

foldMap :: Monoid m => (a -> m) -> Abelianizer a -> m #

foldMap' :: Monoid m => (a -> m) -> Abelianizer a -> m #

foldr :: (a -> b -> b) -> b -> Abelianizer a -> b #

foldr' :: (a -> b -> b) -> b -> Abelianizer a -> b #

foldl :: (b -> a -> b) -> b -> Abelianizer a -> b #

foldl' :: (b -> a -> b) -> b -> Abelianizer a -> b #

foldr1 :: (a -> a -> a) -> Abelianizer a -> a #

foldl1 :: (a -> a -> a) -> Abelianizer a -> a #

toList :: Abelianizer a -> [a] #

null :: Abelianizer a -> Bool #

length :: Abelianizer a -> Int #

elem :: Eq a => a -> Abelianizer a -> Bool #

maximum :: Ord a => Abelianizer a -> a #

minimum :: Ord a => Abelianizer a -> a #

sum :: Num a => Abelianizer a -> a #

product :: Num a => Abelianizer a -> a #

Traversable Abelianizer Source # 
Instance details

Defined in Data.Group

Methods

traverse :: Applicative f => (a -> f b) -> Abelianizer a -> f (Abelianizer b) #

sequenceA :: Applicative f => Abelianizer (f a) -> f (Abelianizer a) #

mapM :: Monad m => (a -> m b) -> Abelianizer a -> m (Abelianizer b) #

sequence :: Monad m => Abelianizer (m a) -> m (Abelianizer a) #

GroupFoldable Abelianizer Source # 
Instance details

Defined in Data.Group.Foldable

Methods

goldMap :: Group g => (a -> g) -> Abelianizer a -> g Source #

toFG :: Abelianizer a -> FG a Source #

Eq a => Eq (Abelianizer a) Source # 
Instance details

Defined in Data.Group

Show a => Show (Abelianizer a) Source # 
Instance details

Defined in Data.Group

Semigroup g => Semigroup (Abelianizer g) Source # 
Instance details

Defined in Data.Group

Monoid g => Monoid (Abelianizer g) Source # 
Instance details

Defined in Data.Group

(Eq g, Group g) => Group (Abelianizer g) Source # 
Instance details

Defined in Data.Group

abelianize :: (Eq g, Group g) => g -> g -> Abelianizer g Source #

Quotient a pair of group elements by their commutator.

Ranging over the entire group, this operation constructs the quotient of the group by its commutator sub-group \( G / [G,G] \).

commutate :: Group g => g -> g -> g Source #

Take the commutator of two elements of a group.

pattern Abelianized :: (Eq g, Group g) => g -> (g, g) Source #

A unidirectional pattern synonym for elements of a group modulo commutators which are not the identity.

pattern Quotiented :: (Eq g, Group g) => (g, g) Source #

A unidirectional pattern synonym for elements of a group modulo commutators which are the identity.

Abelian groups

Commutative Groups.

Instances of Abelian satisfy the following laws:

Commutativity
x <> y = y <> x

class Group g => Abelian g #

An Abelian group is a Group that follows the rule:

a <> b == b <> a

Instances

Instances details
Abelian () 
Instance details

Defined in Data.Group

Abelian a => Abelian (Identity a) 
Instance details

Defined in Data.Group

Abelian a => Abelian (Dual a) 
Instance details

Defined in Data.Group

Num a => Abelian (Sum a) 
Instance details

Defined in Data.Group

Fractional a => Abelian (Product a) 
Instance details

Defined in Data.Group

Abelian a => Abelian (Down a) 
Instance details

Defined in Data.Group

Ord a => Abelian (FreeAbelianGroup a) Source # 
Instance details

Defined in Data.Group.Free.Internal

Abelian (FA a) Source # 
Instance details

Defined in Data.Group.Free.Church

Abelian b => Abelian (a -> b) 
Instance details

Defined in Data.Group

(Abelian a, Abelian b) => Abelian (a, b) 
Instance details

Defined in Data.Group

Abelian a => Abelian (Op a b) 
Instance details

Defined in Data.Group

Abelian (Proxy x) 
Instance details

Defined in Data.Group

(Abelian a, Abelian b, Abelian c) => Abelian (a, b, c) 
Instance details

Defined in Data.Group

Abelian a => Abelian (Const a x) 
Instance details

Defined in Data.Group

(Abelian (f a), Abelian (g a)) => Abelian ((f :*: g) a) 
Instance details

Defined in Data.Group

(Abelian a, Abelian b, Abelian c, Abelian d) => Abelian (a, b, c, d) 
Instance details

Defined in Data.Group

Abelian (f (g a)) => Abelian ((f :.: g) a) 
Instance details

Defined in Data.Group

(Abelian a, Abelian b, Abelian c, Abelian d, Abelian e) => Abelian (a, b, c, d, e) 
Instance details

Defined in Data.Group