WIP: Group heirarchy

groups.cabal

@@ -1,7 +1,7 @@
 name:                groups
 version:             0.4.1.0
 synopsis:            Haskell 98 groups
-description:         
+description:
   Haskell 98 groups. A group is a monoid with invertibility.
 license:             BSD3
 license-file:        LICENSE
@@ -14,6 +14,6 @@ cabal-version:       >=1.8
 
 library
   exposed-modules:     Data.Group
-  -- other-modules:       
+  -- other-modules:
   build-depends:       base <5
   hs-source-dirs:      src

src/Data/Group.hs

@@ -1,76 +1,136 @@
+{-|
+Module      : Data.Group
+Copyright   : (C) 2013 Nathan van Doorn
+License     : BSD-3
+Maintainer  : [email protected]
+
+The laws for 'RegularSemigroup' and 'InverseSemigroup' are from
+<https://www.youtube.com/watch?v=HGi5AxmQUwU Ed Kmett's talk at Lambda World 2018>.
+-}
+
 module Data.Group where
 
 import Data.Monoid
 
--- |A 'Group' is a 'Monoid' plus a function, 'invert', such that: 
+-- | A 'RegularSemigroup' is a 'Semigroup' where every element @x@ has
+-- at least one element @inv x@ such that:
+--
+-- @
+--     x \<> 'inv' x \<>     x =     x
+-- 'inv' x \<>     x \<> 'inv' x = 'inv' x
+-- @
+class Semigroup g => RegularSemigroup g where
+  invert :: g -> g
+
+-- | An 'InverseSemigroup' is a 'RegularSemigroup' with the additional
+-- restriction that inverses are unique.
 --
--- @a \<> invert a == mempty@
+-- Equivalently:
 --
--- @invert a \<> a == mempty@
-class Monoid m => Group m where
-  invert :: m -> m
+-- 1. Any idempotent @y@ is of the form @x \<> inv x@ for some x.
+-- 2. All idempotents commute. (<https://math.stackexchange.com/questions/1093328/do-the-idempotents-in-an-inverse-semigroup-commute/1093476#1093476 Partial proof>)
+class RegularSemigroup g => InverseSemigroup g
+
+-- | A 'Group' adds the conditions that:
+--
+-- @
+-- a     \<> 'inv' a == 'mempty'
+-- 'inv' a \<>     a == 'mempty'
+-- @
+class (InverseSemigroup g, Monoid g) => Group g where
   -- |@'pow' a n == a \<> a \<> ... \<> a @
   --
   -- @ (n lots of a) @
   --
   -- If n is negative, the result is inverted.
-  pow :: Integral x => m -> x -> m
+  pow :: Integral x => g -> x -> g
   pow x0 n0 = case compare n0 0 of
     LT -> invert . f x0 $ negate n0
     EQ -> mempty
     GT -> f x0 n0
     where
-      f x n 
+      f x n
         | even n = f (x `mappend` x) (n `quot` 2)
         | n == 1 = x
         | otherwise = g (x `mappend` x) (n `quot` 2) x
       g x n c
         | even n = g (x `mappend` x) (n `quot` 2) c
         | n == 1 = x `mappend` c
         | otherwise = g (x `mappend` x) (n `quot` 2) (x `mappend` c)
-
-instance Group () where
+{-# DEPRECATED invert "use inv from RegularSemigroup instead" #-}
+
+instance RegularSemigroup () where
   invert () = ()
-  pow () _ = ()
 
-instance Num a => Group (Sum a) where
+instance Num a => RegularSemigroup (Sum a) where
   invert = Sum . negate . getSum
   {-# INLINE invert #-}
-  pow (Sum a) b = Sum (a * fromIntegral b)
-
-instance Fractional a => Group (Product a) where
+
+instance Fractional a => RegularSemigroup (Product a) where
   invert = Product . recip . getProduct
   {-# INLINE invert #-}
-  pow (Product a) b = Product (a ^^ b)
 
-instance Group a => Group (Dual a) where
+instance RegularSemigroup a => RegularSemigroup (Dual a) where
   invert = Dual . invert . getDual
   {-# INLINE invert #-}
+
+instance RegularSemigroup b => RegularSemigroup (a -> b) where
+  invert f = invert . f
+
+instance (RegularSemigroup a, RegularSemigroup b) => RegularSemigroup (a, b) where
+  invert (a, b) = (invert a, invert b)
+
+instance (RegularSemigroup a, RegularSemigroup b, RegularSemigroup c) => RegularSemigroup (a, b, c) where
+  invert (a, b, c) = (invert a, invert b, invert c)
+
+instance (RegularSemigroup a, RegularSemigroup b, RegularSemigroup c, RegularSemigroup d) => RegularSemigroup (a, b, c, d) where
+  invert (a, b, c, d) = (invert a, invert b, invert c, invert d)
+
+instance (RegularSemigroup a, RegularSemigroup b, RegularSemigroup c, RegularSemigroup d, RegularSemigroup e) => RegularSemigroup (a, b, c, d, e) where
+  invert (a, b, c, d, e) = (invert a, invert b, invert c, invert d, invert e)
+
+instance InverseSemigroup ()
+instance Num a => InverseSemigroup (Sum a)
+instance Fractional a => InverseSemigroup (Product a)
+instance InverseSemigroup a => InverseSemigroup (Dual a)
+instance InverseSemigroup b => InverseSemigroup (a -> b)
+instance (InverseSemigroup a, InverseSemigroup b) => InverseSemigroup (a, b)
+instance (InverseSemigroup a, InverseSemigroup b, InverseSemigroup c) => InverseSemigroup (a, b, c)
+instance (InverseSemigroup a, InverseSemigroup b, InverseSemigroup c, InverseSemigroup d) => InverseSemigroup (a, b, c, d)
+instance (InverseSemigroup a, InverseSemigroup b, InverseSemigroup c, InverseSemigroup d, InverseSemigroup e) => InverseSemigroup (a, b, c, d, e)
+
+instance Group () where
+  pow () _ = ()
+
+instance Num a => Group (Sum a) where
+  pow (Sum a) b = Sum (a * fromIntegral b)
+
+instance Fractional a => Group (Product a) where
+  pow (Product a) b = Product (a ^^ b)
+
+instance Group a => Group (Dual a) where
   pow (Dual a) n = Dual (pow a n)
 
 instance Group b => Group (a -> b) where
-  invert f = invert . f
   pow f n e = pow (f e) n
 
 instance (Group a, Group b) => Group (a, b) where
-  invert (a, b) = (invert a, invert b)
   pow (a, b) n = (pow a n, pow b n)
-  
+
 instance (Group a, Group b, Group c) => Group (a, b, c) where
-  invert (a, b, c) = (invert a, invert b, invert c)
   pow (a, b, c) n = (pow a n, pow b n, pow c n)
 
 instance (Group a, Group b, Group c, Group d) => Group (a, b, c, d) where
-  invert (a, b, c, d) = (invert a, invert b, invert c, invert d)
   pow (a, b, c, d) n = (pow a n, pow b n, pow c n, pow d n)
 
 instance (Group a, Group b, Group c, Group d, Group e) => Group (a, b, c, d, e) where
-  invert (a, b, c, d, e) = (invert a, invert b, invert c, invert d, invert e)
   pow (a, b, c, d, e) n = (pow a n, pow b n, pow c n, pow d n, pow e n)
 
 -- |An 'Abelian' group is a 'Group' that follows the rule:
--- 
--- @a \<> b == b \<> a@
+--
+-- @
+-- a \<> b == b \<> a
+-- @
 class Group g => Abelian g
 
 instance Abelian ()
@@ -91,13 +151,15 @@ instance (Abelian a, Abelian b, Abelian c, Abelian d) => Abelian (a, b, c, d)
 
 instance (Abelian a, Abelian b, Abelian c, Abelian d, Abelian e) => Abelian (a, b, c, d, e)
 
--- | A 'Group' G is 'Cyclic' if there exists an element x of G such that for all y in G, there exists an n, such that
+-- | A 'Group' G is 'Cyclic' if there exists an element x of G such
+-- that for all y in G, there exists an n, such that:
 --
--- @y = pow x n@
+-- @
+-- y = pow x n
+-- @
 class Group a => Cyclic a where
   generator :: a
 
 generated :: Cyclic a => [a]
 generated =
   iterate (mappend generator) mempty
-