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..74038c2 100644 --- a/src/Data/Group.hs +++ b/src/Data/Group.hs @@ -1,26 +1,55 @@ +{-| +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 + 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. () +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 @@ -28,49 +57,80 @@ 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 +{-# 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 -