From 7f5859f112afb6adb15b2660b5bc93e6c552ad6c Mon Sep 17 00:00:00 2001 From: Jack Kelly Date: Tue, 5 Nov 2019 16:14:24 +1000 Subject: [PATCH 1/5] Whitespace cleanup --- groups.cabal | 4 ++-- src/Data/Group.hs | 13 ++++++------- 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/groups.cabal b/groups.cabal index 366e1f8..b9b7135 100644 --- a/groups.cabal +++ b/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 diff --git a/src/Data/Group.hs b/src/Data/Group.hs index 02b5064..82ae501 100644 --- a/src/Data/Group.hs +++ b/src/Data/Group.hs @@ -2,7 +2,7 @@ module Data.Group where import Data.Monoid --- |A 'Group' is a 'Monoid' plus a function, 'invert', such that: +-- |A 'Group' is a 'Monoid' plus a function, 'invert', such that: -- -- @a \<> invert a == mempty@ -- @@ -20,7 +20,7 @@ class Monoid m => Group m where 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 @@ -28,7 +28,7 @@ class Monoid m => Group m where | 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 invert () = () pow () _ = () @@ -37,7 +37,7 @@ instance Num a => Group (Sum a) where invert = Sum . negate . getSum {-# INLINE invert #-} pow (Sum a) b = Sum (a * fromIntegral b) - + instance Fractional a => Group (Product a) where invert = Product . recip . getProduct {-# INLINE invert #-} @@ -55,7 +55,7 @@ instance Group b => Group (a -> b) where 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) @@ -69,7 +69,7 @@ instance (Group a, Group b, Group c, Group d, Group e) => Group (a, b, c, d, 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@ class Group g => Abelian g @@ -100,4 +100,3 @@ class Group a => Cyclic a where generated :: Cyclic a => [a] generated = iterate (mappend generator) mempty - From ead51cb811aad8f1666d3e8faf6dada6ef5c0b5f Mon Sep 17 00:00:00 2001 From: Jack Kelly Date: Wed, 6 Nov 2019 13:31:35 +1000 Subject: [PATCH 2/5] Add module header --- src/Data/Group.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/Data/Group.hs b/src/Data/Group.hs index 82ae501..3993bd2 100644 --- a/src/Data/Group.hs +++ b/src/Data/Group.hs @@ -1,3 +1,10 @@ +{-| +Module : Data.Group +Copyright : (C) 2013 Nathan van Doorn +License : BSD-3 +Maintainer : nvd1234@gmail.com +-} + module Data.Group where import Data.Monoid From e12966155573b677f90021cef4e1855969eab4dd Mon Sep 17 00:00:00 2001 From: Jack Kelly Date: Wed, 6 Nov 2019 13:31:51 +1000 Subject: [PATCH 3/5] Wrap and reformat haddocks --- src/Data/Group.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/Data/Group.hs b/src/Data/Group.hs index 3993bd2..5657f7d 100644 --- a/src/Data/Group.hs +++ b/src/Data/Group.hs @@ -77,7 +77,9 @@ instance (Group a, Group b, Group c, Group d, Group e) => Group (a, b, c, d, e) -- |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 () @@ -98,9 +100,12 @@ 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 From 1189190f5bf955af89409b99eceaaaa1917f1360 Mon Sep 17 00:00:00 2001 From: Jack Kelly Date: Wed, 6 Nov 2019 13:32:12 +1000 Subject: [PATCH 4/5] Add RegularSemigroup and InverseSemigroup --- src/Data/Group.hs | 75 +++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 69 insertions(+), 6 deletions(-) diff --git a/src/Data/Group.hs b/src/Data/Group.hs index 5657f7d..4989e4f 100644 --- a/src/Data/Group.hs +++ b/src/Data/Group.hs @@ -3,25 +3,50 @@ Module : Data.Group Copyright : (C) 2013 Nathan van Doorn License : BSD-3 Maintainer : nvd1234@gmail.com + +The laws for 'RegularSemigroup' and 'InverseSemigroup' are from +. -} 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 + inv :: 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. () +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 + invert :: g -> g + invert = inv + -- |@'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 @@ -35,6 +60,44 @@ class Monoid m => Group m where | 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) +{-# DEPRECATED invert "use inv from RegularSemigroup instead" #-} + +instance RegularSemigroup () where + inv () = () + +instance Num a => RegularSemigroup (Sum a) where + inv = Sum . negate . getSum + +instance Fractional a => RegularSemigroup (Product a) where + inv = Product . recip . getProduct + +instance RegularSemigroup a => RegularSemigroup (Dual a) where + inv = Dual . inv . getDual + +instance RegularSemigroup b => RegularSemigroup (a -> b) where + inv f = inv . f + +instance (RegularSemigroup a, RegularSemigroup b) => RegularSemigroup (a, b) where + inv (a, b) = (inv a, inv b) + +instance (RegularSemigroup a, RegularSemigroup b, RegularSemigroup c) => RegularSemigroup (a, b, c) where + inv (a, b, c) = (inv a, inv b, inv c) + +instance (RegularSemigroup a, RegularSemigroup b, RegularSemigroup c, RegularSemigroup d) => RegularSemigroup (a, b, c, d) where + inv (a, b, c, d) = (inv a, inv b, inv c, inv d) + +instance (RegularSemigroup a, RegularSemigroup b, RegularSemigroup c, RegularSemigroup d, RegularSemigroup e) => RegularSemigroup (a, b, c, d, e) where + inv (a, b, c, d, e) = (inv a, inv b, inv c, inv d, inv 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 invert () = () From 6376de65e5dfd9952be50e3b42a966f186b93261 Mon Sep 17 00:00:00 2001 From: Jack Kelly Date: Fri, 8 Nov 2019 11:40:42 +1000 Subject: [PATCH 5/5] `Group#invert`: move to `RegularSemigroup`, remove `inv` --- src/Data/Group.hs | 38 +++++++++++++------------------------- 1 file changed, 13 insertions(+), 25 deletions(-) diff --git a/src/Data/Group.hs b/src/Data/Group.hs index 4989e4f..74038c2 100644 --- a/src/Data/Group.hs +++ b/src/Data/Group.hs @@ -20,7 +20,7 @@ import Data.Monoid -- 'inv' x \<> x \<> 'inv' x = 'inv' x -- @ class Semigroup g => RegularSemigroup g where - inv :: g -> g + invert :: g -> g -- | An 'InverseSemigroup' is a 'RegularSemigroup' with the additional -- restriction that inverses are unique. @@ -38,9 +38,6 @@ class RegularSemigroup g => InverseSemigroup g -- 'inv' a \<> a == 'mempty' -- @ class (InverseSemigroup g, Monoid g) => Group g where - invert :: g -> g - invert = inv - -- |@'pow' a n == a \<> a \<> ... \<> a @ -- -- @ (n lots of a) @ @@ -63,31 +60,34 @@ class (InverseSemigroup g, Monoid g) => Group g where {-# DEPRECATED invert "use inv from RegularSemigroup instead" #-} instance RegularSemigroup () where - inv () = () + invert () = () instance Num a => RegularSemigroup (Sum a) where - inv = Sum . negate . getSum + invert = Sum . negate . getSum + {-# INLINE invert #-} instance Fractional a => RegularSemigroup (Product a) where - inv = Product . recip . getProduct + invert = Product . recip . getProduct + {-# INLINE invert #-} instance RegularSemigroup a => RegularSemigroup (Dual a) where - inv = Dual . inv . getDual + invert = Dual . invert . getDual + {-# INLINE invert #-} instance RegularSemigroup b => RegularSemigroup (a -> b) where - inv f = inv . f + invert f = invert . f instance (RegularSemigroup a, RegularSemigroup b) => RegularSemigroup (a, b) where - inv (a, b) = (inv a, inv b) + invert (a, b) = (invert a, invert b) instance (RegularSemigroup a, RegularSemigroup b, RegularSemigroup c) => RegularSemigroup (a, b, c) where - inv (a, b, c) = (inv a, inv b, inv c) + 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 - inv (a, b, c, d) = (inv a, inv b, inv c, inv d) + 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 - inv (a, b, c, d, e) = (inv a, inv b, inv c, inv d, inv e) + invert (a, b, c, d, e) = (invert a, invert b, invert c, invert d, invert e) instance InverseSemigroup () instance Num a => InverseSemigroup (Sum a) @@ -100,42 +100,30 @@ instance (InverseSemigroup a, InverseSemigroup b, InverseSemigroup c, InverseSem instance (InverseSemigroup a, InverseSemigroup b, InverseSemigroup c, InverseSemigroup d, InverseSemigroup e) => InverseSemigroup (a, b, c, d, e) instance Group () where - invert () = () pow () _ = () instance Num a => Group (Sum a) where - invert = Sum . negate . getSum - {-# INLINE invert #-} pow (Sum a) b = Sum (a * fromIntegral b) instance Fractional a => Group (Product a) where - invert = Product . recip . getProduct - {-# INLINE invert #-} pow (Product a) b = Product (a ^^ b) instance Group a => Group (Dual a) where - invert = Dual . invert . getDual - {-# INLINE invert #-} 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: