packages feed

group-theory (empty) → 0.1.0.0

raw patch · 16 files changed

+2182/−0 lines, 16 filesdep +basedep +containersdep +doctestbuild-type:Customsetup-changed

Dependencies added: base, containers, doctest, group-theory

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for group-theory++## 0.1.0.0++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2020, Emily Pillmore++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Emily Pillmore nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,15 @@+group-theory+==========++[![Hackage](https://img.shields.io/hackage/v/group-theory.svg)](https://hackage.haskell.org/package/group-theory) ![Build Status](https://github.com/emilypi/group-theory/workflows/ci/badge.svg)++This is a package for exploring constructive group theory in Haskell.++Contact Information+-------------------++Contributions and bug reports are welcome!++Co-maintained by Emily Pillmore (@topos) and Reed Mullanix (@totbwf). Please feel free to contact either myself, or Reed through github or on the #haskell IRC channel on irc.freenode.net.++\- Emily
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main where++import Distribution.Extra.Doctest (defaultMainWithDoctests)++main :: IO ()+main = defaultMainWithDoctests "doctests"
+ group-theory.cabal view
@@ -0,0 +1,67 @@+cabal-version:   2.0+name:            group-theory+version:         0.1.0.0+synopsis:        The theory of groups+description:+  This package includes definitions for Groups (monoids with invertibility), including+  finite, fre, simple, cyclic, and permutation groups. Additionally, we add the concept+  of 'Cancelative' functors, building upon 'Alternative' applicative functors.++homepage:        https://github.com/emilypi/group-theory+bug-reports:     https://github.com/emilypi/group-theory/issues+license:         BSD3+license-file:    LICENSE+author:          Emily Pillmore+maintainer:      emilypi@cohomolo.gy+copyright:       (c) 2020 Emily Pillmore <emilypi@cohomolo.gy>+category:        Algebra, Math, Permutations, Groups+build-type:      Custom+extra-doc-files:+  CHANGELOG.md+  README.md++tested-with:     GHC ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.2++source-repository head+  type:     git+  location: https://github.com/emilypi/group-theory.git++custom-setup+  setup-depends:+      base           >=4.11 && <5+    , Cabal+    , cabal-doctest++library+  exposed-modules:+    Control.Applicative.Cancelative+    Data.Group+    Data.Group.Additive+    Data.Group.Cyclic+    Data.Group.Finite+    Data.Group.Foldable+    Data.Group.Free+    Data.Group.Free.Church+    Data.Group.Multiplicative+    Data.Group.Permutation++  build-depends:+      base        >=4.11 && <5+    , containers  >=0.5  && <0.7++  hs-source-dirs:   src+  default-language: Haskell2010+  ghc-options:      -Wall++test-suite doctests+  default-language:  Haskell2010+  type:              exitcode-stdio-1.0+  main-is:           doctests.hs+  build-depends:+      base          >=4.11 && <5+    , doctest+    , group-theory++  hs-source-dirs:    test+  ghc-options:       -Wall -threaded+  x-doctest-options: --fast
+ src/Control/Applicative/Cancelative.hs view
@@ -0,0 +1,107 @@+{-# language DefaultSignatures #-}+{-# language Safe #-}+-- |+-- Module       : Control.Applicative.Cancelative+-- Copyright    : (c) 2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>,+--                Reed Mullanix <reedmullanix@gmail.com>+--+-- Stability    : stable+-- Portability  : non-portable+--+-- This module contains definitions for 'Cancelative' functors+-- along with the relevant combinators.+--+module Control.Applicative.Cancelative+( -- * Cancelative+  Cancelative(..)+  -- ** Cancelative combinators+, cancel1+, annihalate+) where+++import Control.Applicative+import Data.Group+import Data.Group.Free+import Data.Group.Free.Church+import Data.Proxy++-- $setup+--+-- >>> import qualified Prelude+-- >>> import Data.Group+-- >>> import Data.Monoid+-- >>> import Data.Semigroup+-- >>> import Data.Word+-- >>> import Data.Group.Free+-- >>> import Data.Group.Foldable+-- >>> :set -XTypeApplications+-- >>> :set -XFlexibleContexts++-- -------------------------------------------------------------------- --+-- Cancelative functors++-- | A group on 'Applicative' functors.+--+-- 'Cancelative' functors have the following laws:+--+-- [Left Cancelation] @ 'cancel' a '<|>' a = 'empty' @+-- [Rigth Cancelation] @ a '<|>' 'cancel' a = 'empty' @+--+-- This is analogous to a group operation on applicative functors,+-- in the sense that 'Alternative' forms a monoid. A straight-+-- forward implementation exists whenever @f a@ forms a 'Group'+-- for all @a@, in which case, @cancel == invert@.+--+class Alternative f => Cancelative f where+  -- | Invert (or 'cancel') a 'Cancelative' functor, such that, if the+  -- functor is also a 'Data.Group.Foldable.GroupFoldable', then @'Data.Group.Foldable.gold' '.' 'cancel'@+  -- amounts to evaluating the inverse of a word in the functor.+  --+  -- === __Examples:__+  --+  -- >>> let x = FreeGroup [Left (Sum (2 :: Word8)), Right (Sum 3)]+  -- >>> cancel x+  -- FreeGroup {runFreeGroup = [Right (Sum {getSum = 2}),Left (Sum {getSum = 3})]}+  --+  cancel :: f a -> f a+  default cancel :: Group (f a) => f a -> f a+  cancel = invert+  {-# minimal cancel #-}++instance Cancelative FG where+  cancel = invert++instance Cancelative FA where+  cancel = invert++instance Cancelative FreeGroup where+  cancel = invert++instance Cancelative Proxy where+  cancel _ = Proxy++-- -------------------------------------------------------------------- --+-- Cancelative functor combinators++-- | Cancel a single element in a 'Cancelative' functor.+--+-- === __Examples:__+--+-- >>> let x = FreeGroup [Left (Sum (2 :: Word8)), Right (Sum 3)]+-- >>> gold x+-- Sum {getSum = 1}+-- >>> gold $ cancel1 (Sum 1) x+-- Sum {getSum = 0}+--+cancel1 :: (Group a, Cancelative f) => a -> f a -> f a+cancel1 a f = cancel (pure a) <|> f++-- | Annihalate a 'Traversable''s worth of elements in a 'Cancelative'+-- functor.+--+annihalate :: (Cancelative f, Traversable t) => (a -> f a) -> t a -> f (t a)+annihalate f = traverse (cancel . f)
+ src/Data/Group.hs view
@@ -0,0 +1,630 @@+{-# language BangPatterns #-}+{-# language CPP #-}+{-# language DerivingStrategies #-}+{-# language FlexibleInstances #-}+{-# language PatternSynonyms #-}+{-# language Safe #-}+#if MIN_VERSION_base(4,12,0)+{-# language TypeOperators #-}+#endif+{-# language ViewPatterns #-}+-- |+-- Module       : Data.Group+-- Copyright    : (c) 2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>,+--                Reed Mullanix <reedmullanix@gmail.com>+-- Stability    : stable+-- Portability  : non-portable+--+-- This module contains definitions for 'Group' and 'AbelianGroup',+-- along with the relevant combinators.+--+module Data.Group+( -- * Groups+  Group(..)+  -- * Group combinators+, (><)+  -- ** Conjugation+, conjugate+, unconjugate+, pattern Conjugate+  -- ** Order+, Order(..)+, pattern Infinitary+, pattern Finitary+, order+  -- ** Abelianization+, Abelianizer(..)+, abelianize+, commutate+, pattern Abelianized+, pattern Quotiented+  -- * Abelian groups+, AbelianGroup+) where+++import Data.Bool+import Data.Functor.Const+#if __GLASGOW_HASKELL__ > 804+import Data.Functor.Contravariant+#endif+import Data.Functor.Identity+import Data.Semigroup (stimes)+import Data.Int+import Data.Monoid+import Data.Ord+import Data.Proxy+import Data.Ratio+import Data.Word++import Numeric.Natural++#if MIN_VERSION_base(4,12,0)+import GHC.Generics+#endif++import Prelude hiding (negate, exponent)+import qualified Prelude++-- $setup+--+-- >>> import qualified Prelude+-- >>> import Data.Group+-- >>> import Data.Monoid+-- >>> import Data.Semigroup+-- >>> :set -XTypeApplications+-- >>> :set -XFlexibleContexts++infixr 6 ><++-- -------------------------------------------------------------------- --+-- 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 @newtype@s and make those instances+-- of 'Group', e.g. 'Data.Semigroup.Sum' and 'Data.Semigroup.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 'Data.Group.Additive.AdditiveGroup' and+-- 'Data.Group.Multiplicative.MultiplicativeGroup'.+--+-- Categorically, 'Group's may be viewed single-object groupoids.+--+class Monoid a => Group a where+  invert :: a -> a+  invert a = mempty `minus` a+  {-# inline invert #-}++  -- | Similar to 'stimes' from 'Data.Semigroup', but handles+  -- negative powers by using 'invert' appropriately.+  --+  -- === __Examples:__+  --+  -- >>> gtimes 2 (Sum 3)+  -- Sum {getSum = 6}+  -- >>> gtimes (-3) (Sum 3)+  -- Sum {getSum = -9}+  --+  gtimes :: (Integral n) => n -> a -> a+  gtimes n a+    | n == 0 = mempty+    | n > 0 = stimes n a+    | otherwise = stimes (abs n) (invert a)+  {-# inline gtimes #-}++  -- | '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.+  --+  minus :: a -> a -> a+  minus a b = a <> invert b+  {-# inline minus #-}+  {-# minimal invert | minus #-}+++instance Group () where+  invert = id+  {-# inline invert #-}++instance Group b => Group (a -> b) where+  invert f = invert . f+  {-# inline invert #-}++instance Group a => Group (Dual a) where+  invert (Dual a) = Dual (invert a)+  {-# inline invert #-}++instance Group a => Group (Down a) where+  invert (Down a) = Down (invert a)+  {-# inline invert #-}++instance Group a => Group (Endo a) where+  invert (Endo a) = Endo (invert . a)+  {-# inline invert #-}++#if __GLASGOW_HASKELL__ > 804+instance Group (Equivalence a) where+  invert (Equivalence p) = Equivalence $ \a b -> not (p a b)+  {-# inline invert #-}++instance Group (Comparison a) where+  invert (Comparison p) = Comparison $ \a b -> invert (p a b)+  {-# inline invert #-}++instance Group (Predicate a) where+  invert (Predicate p) = Predicate $ \a -> not (p a)+  {-# inline invert #-}++instance Group a => Group (Op a b) where+  invert (Op f) = Op $ invert . f+  {-# inline invert #-}+#endif++instance Group Any where+  invert (Any b) = Any $ bool True False b+  {-# inline invert #-}++instance Group All where+  invert (All b) = All $ bool True False b+  {-# inline invert #-}++instance Group (Sum Integer) where+  invert = Prelude.negate+  {-# inline invert #-}++instance Group (Sum Rational) where+  invert = Prelude.negate+  {-# inline invert #-}++instance Group (Sum Int) where+  invert = Prelude.negate+  {-# inline invert #-}++instance Group (Sum Int8) where+  invert = Prelude.negate+  {-# inline invert #-}++instance Group (Sum Int16) where+  invert = Prelude.negate+  {-# inline invert #-}++instance Group (Sum Int32) where+  invert = Prelude.negate+  {-# inline invert #-}++instance Group (Sum Int64) where+  invert = Prelude.negate+  {-# inline invert #-}++instance Group (Sum Word) where+  invert = Prelude.negate+  {-# inline invert #-}++instance Group (Sum Word8) where+  invert = Prelude.negate+  {-# inline invert #-}++instance Group (Sum Word16) where+  invert = Prelude.negate+  {-# inline invert #-}++instance Group (Sum Word32) where+  invert = Prelude.negate+  {-# inline invert #-}++instance Group (Sum Word64) where+  invert = Prelude.negate+  {-# inline invert #-}++instance Group (Sum (Ratio Int)) where+  invert = Sum . Prelude.negate . getSum+  {-# inline invert #-}++instance Group (Sum (Ratio Int8)) where+  invert = Sum . Prelude.negate . getSum+  {-# inline invert #-}++instance Group (Sum (Ratio Int16)) where+  invert = Sum . Prelude.negate . getSum+  {-# inline invert #-}++instance Group (Sum (Ratio Int32)) where+  invert = Sum . Prelude.negate . getSum+  {-# inline invert #-}++instance Group (Sum (Ratio Int64)) where+  invert = Sum . Prelude.negate . getSum+  {-# inline invert #-}++instance Group (Sum (Ratio Word)) where+  invert = Sum . Prelude.negate . getSum+  {-# inline invert #-}++instance Group (Sum (Ratio Word8)) where+  invert = Sum . Prelude.negate . getSum+  {-# inline invert #-}++instance Group (Sum (Ratio Word16)) where+  invert = Sum . Prelude.negate . getSum+  {-# inline invert #-}++instance Group (Sum (Ratio Word32)) where+  invert = Sum . Prelude.negate . getSum+  {-# inline invert #-}++instance Group (Sum (Ratio Word64)) where+  invert = Sum . Prelude.negate . getSum+  {-# inline invert #-}++instance Group (Product Rational) where+  invert = Product . Prelude.recip . getProduct+  {-# inline invert #-}++instance Group (Product (Ratio Natural)) where+  invert = Product . Prelude.recip . getProduct+  {-# inline invert #-}++instance Group (Product (Ratio Int)) where+  invert = Product . Prelude.recip . getProduct+  {-# inline invert #-}++instance Group (Product (Ratio Int8)) where+  invert = Product . Prelude.recip . getProduct+  {-# inline invert #-}++instance Group (Product (Ratio Int16)) where+  invert = Product . Prelude.recip . getProduct+  {-# inline invert #-}++instance Group (Product (Ratio Int32)) where+  invert = Product . Prelude.recip . getProduct+  {-# inline invert #-}++instance Group (Product (Ratio Int64)) where+  invert = Product . Prelude.recip . getProduct+  {-# inline invert #-}++instance Group (Product (Ratio Word)) where+  invert = Product . Prelude.recip . getProduct+  {-# inline invert #-}++instance Group (Product (Ratio Word8)) where+  invert = Product . Prelude.recip . getProduct+  {-# inline invert #-}++instance Group (Product (Ratio Word16)) where+  invert = Product . Prelude.recip . getProduct+  {-# inline invert #-}++instance Group (Product (Ratio Word32)) where+  invert = Product . Prelude.recip . getProduct+  {-# inline invert #-}++instance Group (Product (Ratio Word64)) where+  invert = Product . Prelude.recip . getProduct+  {-# inline invert #-}++instance Group a => Group (Const a b) where+  invert = Const . invert . getConst+  {-# inline invert #-}++instance Group a => Group (Identity a) where+  invert = Identity . invert . runIdentity+  {-# inline invert #-}++instance Group Ordering where+  invert LT = GT+  invert EQ = EQ+  invert GT = LT+  {-# inline invert #-}++instance (Group a, Group b) => Group (a,b) where+  invert ~(a,b) = (invert a, invert b)+  {-# inline invert #-}++instance Group a => Group (Proxy a) where+  invert _ = Proxy++instance (Group a, Group b, Group c) => Group (a,b,c) where+  invert ~(a,b,c) = (invert a, invert b, invert c)+  {-# inline invert #-}++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)+  {-# inline invert #-}++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)+  {-# inline invert #-}++#if MIN_VERSION_base(4,12,0)+instance (Group (f a), Group (g a)) => Group ((f :*: g) a) where+  invert (f :*: g) = invert f :*: invert g++instance Group (f (g a)) => Group ((f :.: g) a) where+  invert (Comp1 fg) = invert (Comp1 fg)+#endif++-- -------------------------------------------------------------------- --+-- Group combinators++-- | Apply @('<>')@, commuting its arguments. When the group is abelian,+-- @a <> b@ is identically @b <> a@.+--+(><) :: Group a => a -> a -> a+a >< b = b <> a+{-# inline (><) #-}++-- | 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}+--+-- >>> let x = All True+-- >>> conjugate (All False) x+-- All {getAll = False}+--+conjugate :: Group a => a -> a -> a+conjugate g a = (g <> a) `minus` g+{-# inline conjugate #-}++-- | 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}+--+unconjugate :: Group a => a -> a -> a+unconjugate g a = invert g <> a <> g++-- | Bidirectional pattern for conjugation by a group element+--+-- __Note:__ When the underlying 'Group' is abelian, this+-- pattern is the identity.+--+pattern Conjugate :: Group a => (a,a) -> (a,a)+pattern Conjugate t <- (\(g,a) -> (g, conjugate g a) -> t) where+  Conjugate (g,a) = (g, unconjugate g a)+{-# complete Conjugate #-}++-- -------------------------------------------------------------------- --+-- Group order++-- | The order of a group element.+--+-- The order of a group element can either be infinite,+-- as in the case of @All False@, or finite, as in the+-- case of @All True@.+--+data Order = Infinite | Finite !Natural+  deriving (Eq, Show)++-- | Unidirectional pattern synonym for the infinite order of a+-- group element.+--+pattern Infinitary :: (Eq g, Group g) => g+pattern Infinitary <- (order -> Infinite)++-- | Unidirectional pattern synonym for the finite order of a+-- group element.+--+pattern Finitary :: (Eq g, Group g) => Natural -> g+pattern Finitary n <- (order -> Finite n)++-- | Calculate the exponent of a particular element in a group.+--+-- __Warning:__ If 'order' expects a 'Data.Group.FiniteGroup', this is gauranteed+-- to terminate. However, this is not true of groups in general. This will+-- spin forever if you give it something like non-zero @Sum Integer@.+--+-- === __Examples__:+--+-- >>> order @(Sum Word8) 3+-- Finite 255+--+-- >>> order (Any False)+-- Finite 1+--+-- >>> order (All False)+-- Infinite+--+order :: (Eq g, Group g) => g -> Order+order a = go 0 a where+  go !n g+    -- guard against ().+    | g == mempty, n > 0 = Finite n+    -- guard against infinite cases like @All False@.+    | g == a, n > 0 = Infinite+    | otherwise = go (succ n) (g <> a)+{-# inline order #-}++-- -------------------------------------------------------------------- --+-- Abelianization++-- | 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 \).+--+data Abelianizer a = Quot | Commuted a+  deriving stock (Eq, Show)++instance Functor Abelianizer where+  fmap _ Quot = Quot+  fmap f (Commuted a) = Commuted (f a)++instance Applicative Abelianizer where+  pure = Commuted++  Quot <*> _ = Quot+  _ <*> Quot = Quot+  Commuted f <*> Commuted a = Commuted (f a)++instance Monad Abelianizer where+  return = pure+  (>>) = (*>)++  Quot >>= _ = Quot+  Commuted a >>= f = f a++instance Foldable Abelianizer where+  foldMap _ Quot = mempty+  foldMap f (Commuted a) = f a++instance Traversable Abelianizer where+  traverse _ Quot = pure Quot+  traverse f (Commuted a) = Commuted <$> f a++instance Semigroup g => Semigroup (Abelianizer g) where+  Quot <> t = t+  t <> Quot = t+  Commuted a <> Commuted b = Commuted (a <> b)++instance Monoid g => Monoid (Abelianizer g) where+  -- Normally we'd say 'Quot' but these are the same.+  mempty = Commuted mempty++instance (Eq g, Group g) => Group (Abelianizer g) where+  invert Quot = Quot+  invert (Commuted a) = Commuted (invert a)++-- | Take the commutator of two elements of a group.+--+commutate :: Group g => g -> g -> g+commutate g g' = g <> g' <> invert g <> invert g'+{-# inline commutate #-}++-- | 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] \).+--+abelianize :: (Eq g, Group g) => g -> g -> Abelianizer g+abelianize g g'+  | x == mempty = Quot+  | otherwise = Commuted x+  where+    x = commutate g g'+{-# inline abelianize #-}++-- | A unidirectional pattern synonym for elements of a group+-- modulo commutators which are __not__ the identity.+--+pattern Abelianized :: (Eq g, Group g) => g -> (g,g)+pattern Abelianized x <- (uncurry abelianize -> Commuted x)++-- | A unidirectional pattern synonym for elements of a group+-- modulo commutators which are the identity.+--+pattern Quotiented :: (Eq g, Group g) => (g,g)+pattern Quotiented <- (uncurry abelianize -> Quot)++-- -------------------------------------------------------------------- --+-- Abelian (commutative) groups++-- | Commutative 'Group's.+--+-- Instances of 'AbelianGroup' satisfy the following laws:+--+-- [Commutativity] @x <> y = y <> x@+--+class Group a => AbelianGroup a+instance AbelianGroup ()+instance AbelianGroup b => AbelianGroup (a -> b)+instance AbelianGroup a => AbelianGroup (Dual a)+instance AbelianGroup Any+instance AbelianGroup All+instance AbelianGroup (Sum Integer)+instance AbelianGroup (Sum Int)+instance AbelianGroup (Sum Int8)+instance AbelianGroup (Sum Int16)+instance AbelianGroup (Sum Int32)+instance AbelianGroup (Sum Int64)+instance AbelianGroup (Sum Word)+instance AbelianGroup (Sum Word8)+instance AbelianGroup (Sum Word16)+instance AbelianGroup (Sum Word32)+instance AbelianGroup (Sum Word64)+instance AbelianGroup (Sum (Ratio Integer))+instance AbelianGroup (Sum (Ratio Int))+instance AbelianGroup (Sum (Ratio Int8))+instance AbelianGroup (Sum (Ratio Int16))+instance AbelianGroup (Sum (Ratio Int32))+instance AbelianGroup (Sum (Ratio Int64))+instance AbelianGroup (Sum (Ratio Word))+instance AbelianGroup (Sum (Ratio Word8))+instance AbelianGroup (Sum (Ratio Word16))+instance AbelianGroup (Sum (Ratio Word32))+instance AbelianGroup (Sum (Ratio Word64))+instance AbelianGroup (Product (Ratio Integer))+instance AbelianGroup (Product (Ratio Int))+instance AbelianGroup (Product (Ratio Int8))+instance AbelianGroup (Product (Ratio Int16))+instance AbelianGroup (Product (Ratio Int32))+instance AbelianGroup (Product (Ratio Int64))+instance AbelianGroup (Product (Ratio Word))+instance AbelianGroup (Product (Ratio Word8))+instance AbelianGroup (Product (Ratio Word16))+instance AbelianGroup (Product (Ratio Word32))+instance AbelianGroup (Product (Ratio Word64))+instance AbelianGroup (Product (Ratio Natural))+instance AbelianGroup a => AbelianGroup (Const a b)+instance AbelianGroup a => AbelianGroup (Identity a)+instance AbelianGroup a => AbelianGroup (Proxy a)+instance AbelianGroup Ordering+instance (AbelianGroup a, AbelianGroup b) => AbelianGroup (a,b)+instance (AbelianGroup a, AbelianGroup b, AbelianGroup c) => AbelianGroup (a,b,c)+instance (AbelianGroup a, AbelianGroup b, AbelianGroup c, AbelianGroup d) => AbelianGroup (a,b,c,d)+instance (AbelianGroup a, AbelianGroup b, AbelianGroup c, AbelianGroup d, AbelianGroup e) => AbelianGroup (a,b,c,d,e)+instance AbelianGroup a => AbelianGroup (Down a)+instance AbelianGroup a => AbelianGroup (Endo a)+#if MIN_VERSION_base(4,12,0)+instance (AbelianGroup (f a), AbelianGroup (g a)) => AbelianGroup ((f :*: g) a)+instance AbelianGroup (f (g a)) => AbelianGroup ((f :.: g) a)+#endif++#if __GLASGOW_HASKELL__ > 804+instance AbelianGroup (Equivalence a)+instance AbelianGroup (Comparison a)+instance AbelianGroup (Predicate a)+instance AbelianGroup a => AbelianGroup (Op a b)+#endif++instance (Eq a, AbelianGroup a) => AbelianGroup (Abelianizer a)
+ src/Data/Group/Additive.hs view
@@ -0,0 +1,205 @@+{-# language CPP #-}+{-# language FlexibleInstances #-}+{-# language Safe #-}+-- |+-- Module       : Data.Group.Additive+-- Copyright    : (c) 2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>,+--                Reed Mullanix <reedmullanix@gmail.com>+--+-- Stability    : stable+-- Portability  : non-portable+--+-- This module contains definitions for 'AdditiveGroup' and 'AdditiveAbelianGroup',+-- along with the relevant combinators.+--+module Data.Group.Additive+( -- * Additive groups+  AdditiveGroup+  -- ** Combinators+, (-)+, (+)+, (×)+, copower+  -- * Additive abelian groups+, AdditiveAbelianGroup+) where+++#if __GLASGOW_HASKELL__ > 804+import Data.Functor.Contravariant+#endif+import Data.Functor.Const+import Data.Functor.Identity+import Data.Group+import Data.Int+import Data.Ord+import Data.Proxy+import Data.Ratio+import Data.Semigroup+import Data.Word++import Prelude hiding ((-), (+))++infixl 6 -, ++infixl 7 ×++-- $setup+--+-- >>> import qualified Prelude+-- >>> import Data.Group+-- >>> import Data.Monoid+-- >>> import Data.Semigroup+-- >>> :set -XTypeApplications++-- -------------------------------------------------------------------- --+-- Additive groups++-- | An additive group is a 'Group' whose operation can be thought of+-- as addition in some sense.+--+-- For example, the additive group of integers \( (ℤ, 0, +) \).+--+class Group g => AdditiveGroup g where++instance AdditiveGroup ()+instance AdditiveGroup b => AdditiveGroup (a -> b)+instance AdditiveGroup a => AdditiveGroup (Dual a)+instance AdditiveGroup a => AdditiveGroup (Down a)+instance AdditiveGroup Any+instance AdditiveGroup (Sum Integer)+instance AdditiveGroup (Sum Int)+instance AdditiveGroup (Sum Int8)+instance AdditiveGroup (Sum Int16)+instance AdditiveGroup (Sum Int32)+instance AdditiveGroup (Sum Int64)+instance AdditiveGroup (Sum Word)+instance AdditiveGroup (Sum Word8)+instance AdditiveGroup (Sum Word16)+instance AdditiveGroup (Sum Word32)+instance AdditiveGroup (Sum Word64)+instance AdditiveGroup (Sum (Ratio Integer))+instance AdditiveGroup (Sum (Ratio Int))+instance AdditiveGroup (Sum (Ratio Int8))+instance AdditiveGroup (Sum (Ratio Int16))+instance AdditiveGroup (Sum (Ratio Int32))+instance AdditiveGroup (Sum (Ratio Int64))+instance AdditiveGroup (Sum (Ratio Word))+instance AdditiveGroup (Sum (Ratio Word8))+instance AdditiveGroup (Sum (Ratio Word16))+instance AdditiveGroup (Sum (Ratio Word32))+instance AdditiveGroup (Sum (Ratio Word64))+instance (AdditiveGroup a, AdditiveGroup b) => AdditiveGroup (a,b)+instance (AdditiveGroup a, AdditiveGroup b, AdditiveGroup c) => AdditiveGroup (a,b,c)+instance (AdditiveGroup a, AdditiveGroup b, AdditiveGroup c, AdditiveGroup d) => AdditiveGroup (a,b,c,d)+instance (AdditiveGroup a, AdditiveGroup b, AdditiveGroup c, AdditiveGroup d, AdditiveGroup e) => AdditiveGroup (a,b,c,d,e)+instance AdditiveGroup a => AdditiveGroup (Const a b)+instance AdditiveGroup a => AdditiveGroup (Identity a)+instance AdditiveGroup a => AdditiveGroup (Proxy a)+instance AdditiveGroup a => AdditiveGroup (Endo a)+#if __GLASGOW_HASKELL__ > 804+instance AdditiveGroup a => AdditiveGroup (Op a b)+#endif++-- | Infix alias for 'minus'.+--+-- === __Examples__:+--+-- >>> let x = Sum (3 :: Int)+-- >>> x - x+-- Sum {getSum = 0}+--+-- >>> let x = Any True+-- >>> x - x+-- Any {getAny = True}+--+(-) :: AdditiveGroup a => a -> a -> a+(-) = minus+{-# inline (-) #-}++-- | Infix alias for 'copower'.+--+-- === __Examples__:+--+-- >>> let x = Sum (3 :: Int)+-- >>> 2 × x+-- Sum {getSum = 6}+--+(×) :: (Integral n, AdditiveGroup a) => n -> a -> a+(×) = copower+{-# inline (×) #-}++-- | Infix alias for additive @('<>')@.+--+-- === __Examples__:+--+-- >>> Sum (1 :: Int) + Sum (40 :: Int)+-- Sum {getSum = 41}+--+(+) :: AdditiveGroup g => g -> g -> g+(+) = (<>)+{-# inline (+) #-}++-- | Add an element of an additive group to itself @n@-many times.+--+-- This represents @ℕ@-indexed copowers of an element @g@ of+-- an additive group, i.e. iterated coproducts of group elements.+-- This is representable by the universal property+-- \( C(∐_n g, x) ≅ C(g, x)^n \).+--+-- === __Examples__:+--+-- >>> copower 2 (Sum (3 :: Int))+-- Sum {getSum = 6}+--+copower :: (Integral n, AdditiveGroup g) => n -> g -> g+copower = gtimes+{-# inline copower #-}++-- -------------------------------------------------------------------- --+-- Additive abelian groups++-- | An additive abelian group is an 'AbelianGroup' whose operation can be thought of+-- as commutative addition in some sense. Almost all additive groups are abelian.+--+class (AbelianGroup g, AdditiveGroup g) => AdditiveAbelianGroup g+instance AdditiveAbelianGroup ()+instance AdditiveAbelianGroup b => AdditiveAbelianGroup (a -> b)+instance AdditiveAbelianGroup a => AdditiveAbelianGroup (Dual a)+instance AdditiveAbelianGroup Any+instance AdditiveAbelianGroup (Sum Integer)+instance AdditiveAbelianGroup (Sum Int)+instance AdditiveAbelianGroup (Sum Int8)+instance AdditiveAbelianGroup (Sum Int16)+instance AdditiveAbelianGroup (Sum Int32)+instance AdditiveAbelianGroup (Sum Int64)+instance AdditiveAbelianGroup (Sum Word)+instance AdditiveAbelianGroup (Sum Word8)+instance AdditiveAbelianGroup (Sum Word16)+instance AdditiveAbelianGroup (Sum Word32)+instance AdditiveAbelianGroup (Sum Word64)+instance AdditiveAbelianGroup (Sum (Ratio Integer))+instance AdditiveAbelianGroup (Sum (Ratio Int))+instance AdditiveAbelianGroup (Sum (Ratio Int8))+instance AdditiveAbelianGroup (Sum (Ratio Int16))+instance AdditiveAbelianGroup (Sum (Ratio Int32))+instance AdditiveAbelianGroup (Sum (Ratio Int64))+instance AdditiveAbelianGroup (Sum (Ratio Word))+instance AdditiveAbelianGroup (Sum (Ratio Word8))+instance AdditiveAbelianGroup (Sum (Ratio Word16))+instance AdditiveAbelianGroup (Sum (Ratio Word32))+instance AdditiveAbelianGroup (Sum (Ratio Word64))+instance (AdditiveAbelianGroup a, AdditiveAbelianGroup b) => AdditiveAbelianGroup (a,b)+instance (AdditiveAbelianGroup a, AdditiveAbelianGroup b, AdditiveAbelianGroup c) => AdditiveAbelianGroup (a,b,c)+instance (AdditiveAbelianGroup a, AdditiveAbelianGroup b, AdditiveAbelianGroup c, AdditiveAbelianGroup d) => AdditiveAbelianGroup (a,b,c,d)+instance (AdditiveAbelianGroup a, AdditiveAbelianGroup b, AdditiveAbelianGroup c, AdditiveAbelianGroup d, AdditiveAbelianGroup e) => AdditiveAbelianGroup (a,b,c,d,e)+instance AdditiveAbelianGroup a => AdditiveAbelianGroup (Const a b)+instance AdditiveAbelianGroup a => AdditiveAbelianGroup (Identity a)+instance AdditiveAbelianGroup a => AdditiveAbelianGroup (Proxy a)+instance AdditiveAbelianGroup a => AdditiveAbelianGroup (Down a)+instance AdditiveAbelianGroup a => AdditiveAbelianGroup (Endo a)+#if __GLASGOW_HASKELL__ > 804+instance AdditiveAbelianGroup a => AdditiveAbelianGroup (Op a b)+#endif
+ src/Data/Group/Cyclic.hs view
@@ -0,0 +1,179 @@+{-# language BangPatterns #-}+{-# language FlexibleInstances #-}+{-# language Safe #-}+-- |+-- Module       : Data.Group.Cyclic+-- Copyright    : (c) 2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>,+--                Reed Mullanix <reedmullanix@gmail.com>+-- Stability    : stable+-- Portability  : non-portable+--+-- This module contains definitions for 'CyclicGroup'+-- along with the relevant combinators.+--+module Data.Group.Cyclic+( -- * Cyclic groups+  CyclicGroup(..)+  -- ** Combinators+, generate+, classify+) where++import Data.Functor.Const+import Data.Functor.Identity+import Data.Group+import Data.Int+import Data.List+import Data.Monoid+import Data.Ord+import Data.Proxy+import Data.Word++-- $setup+--+-- >>> import qualified Prelude+-- >>> import Data.Group+-- >>> import Data.Monoid+-- >>> import Data.Semigroup+-- >>> :set -XTypeApplications++-- -------------------------------------------------------------------- --+-- Cyclic groups++-- | A 'CyclicGroup' is a 'Group' that is generated by a single element.+-- This element is called a /generator/ of the group. There can be many+-- generators for a group, e.g., any representative of an equivalence+-- class of prime numbers of the integers modulo @n@, but to make things+-- easy, we ask for only one generator.+--+class Group g => CyclicGroup g where+  generator :: g+  {-# minimal generator #-}++instance CyclicGroup () where+  generator = ()+  {-# inline generator #-}++-- instance CyclicGroup b => CyclicGroup (a -> b) where+--   generator = const generator+--   {-# inlinable generator #-}++instance CyclicGroup a => CyclicGroup (Dual a) where+  generator = Dual (invert generator)+  {-# inlinable generator #-}++instance CyclicGroup (Sum Integer) where+  generator = 1+  {-# inline generator #-}++instance CyclicGroup (Sum Rational) where+  generator = 1+  {-# inline generator #-}++instance CyclicGroup (Sum Int) where+  generator = 1+  {-# inline generator #-}++instance CyclicGroup (Sum Int8) where+  generator = 1+  {-# inline generator #-}++instance CyclicGroup (Sum Int16) where+  generator = 1+  {-# inline generator #-}++instance CyclicGroup (Sum Int32) where+  generator = 1+  {-# inline generator #-}++instance CyclicGroup (Sum Int64) where+  generator = 1+  {-# inline generator #-}++instance CyclicGroup (Sum Word) where+  generator = 1+  {-# inline generator #-}++instance CyclicGroup (Sum Word8) where+  generator = 1+  {-# inline generator #-}++instance CyclicGroup (Sum Word16) where+  generator = 1+  {-# inline generator #-}++instance CyclicGroup (Sum Word32) where+  generator = 1+  {-# inline generator #-}++instance CyclicGroup (Sum Word64) where+  generator = 1+  {-# inline generator #-}++instance CyclicGroup a => CyclicGroup (Const a b) where+  generator = Const generator+  {-# inlinable generator #-}++instance CyclicGroup a => CyclicGroup (Identity a) where+  generator = Identity generator+  {-# inlinable generator #-}++instance CyclicGroup a => CyclicGroup (Proxy a) where+  generator = Proxy+  {-# inlinable generator #-}++instance (CyclicGroup a, CyclicGroup b) => CyclicGroup (a,b) where+  generator = (generator, generator)+  {-# inlinable generator #-}++instance (CyclicGroup a, CyclicGroup b, CyclicGroup c) => CyclicGroup (a,b,c) where+  generator = (generator, generator, generator)+  {-# inlinable generator #-}++instance (CyclicGroup a, CyclicGroup b, CyclicGroup c, CyclicGroup d) => CyclicGroup (a,b,c,d)  where+  generator = (generator, generator, generator, generator)+  {-# inlinable generator #-}++instance (CyclicGroup a, CyclicGroup b, CyclicGroup c, CyclicGroup d, CyclicGroup e) => CyclicGroup (a,b,c,d,e) where+  generator = (generator, generator, generator, generator, generator)+  {-# inlinable generator #-}++instance CyclicGroup a => CyclicGroup (Down a) where+  generator = Down generator+  {-# inline generator #-}++instance CyclicGroup a => CyclicGroup (Endo a) where+  generator = Endo $ const generator+  {-# inline generator #-}++-- -------------------------------------------------------------------- --+-- Cyclic group combinators++-- | Lazily generate all elements of a 'CyclicGroup' from its generator.+--+-- /Note/: fuses.+--+generate :: (Eq a, CyclicGroup a) => [a]+generate = unfoldr go (generator, 0 :: Integer)+  where+    go (a, !n)+      | a == mempty, n > 0 = Nothing+      | otherwise = Just (a, (a <> generator, succ n))+{-# noinline generate #-}++-- | Classify elements of a 'CyclicGroup'.+--+-- Apply a classifying function @a -> Bool@ to the elements+-- of a 'CyclicGroup' as generated by its designated generator.+--+-- === __Examples__:+--+-- >>> classify (< (3 :: Sum Word8))+-- [Sum {getSum = 1},Sum {getSum = 2}]+--+classify :: (Eq a, CyclicGroup a) => (a -> Bool) -> [a]+classify p = filter p generate+{-# inline classify #-}
+ src/Data/Group/Finite.hs view
@@ -0,0 +1,138 @@+{-# language CPP #-}+{-# language FlexibleInstances #-}+{-# language Safe #-}+-- |+-- Module       : Data.Group.Finite+-- Copyright    : (c) 2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>,+--                Reed Mullanix <reedmullanix@gmail.com>++-- Stability    : stable+-- Portability  : non-portable+--+-- This module contains definitions for 'FiniteGroup'+-- along with the relevant combinators.+--+module Data.Group.Finite+( -- * Finite groups+  FiniteGroup+  -- ** Finite group combinators+, safeOrder+  -- * Finite abelian groups+, FiniteAbelianGroup+) where++import Data.Functor.Const+import Data.Functor.Identity+import Data.Group+import Data.Int+import Data.Monoid+#if __GLASGOW_HASKELL__ >= 810+import Data.Ord+#endif+import Data.Proxy+import Data.Word++-- $setup+--+-- >>> import qualified Prelude+-- >>> import Data.Group+-- >>> import Data.Monoid+-- >>> import Data.Semigroup+-- >>> :set -XTypeApplications++-- -------------------------------------------------------------------- --+-- Finite groups++-- | A 'FiniteGroup' is a 'Group' whose underlying set is finite.+-- This is equivalently a group object in \( FinSet \).+--+-- Finite groups often arise when considering symmetry of mathematical+-- or physical objects, when those objects admit just a finite number of+-- structure-preserving transformations. Important examples of finite groups+-- include cyclic groups and permutation groups.+--+class (Group g, Bounded g) => FiniteGroup g where++instance FiniteGroup ()+instance FiniteGroup a => FiniteGroup (Dual a)+instance FiniteGroup a => FiniteGroup (Const a b)+instance FiniteGroup a => FiniteGroup (Identity a)+instance FiniteGroup a => FiniteGroup (Proxy a)+instance (FiniteGroup a, FiniteGroup b) => FiniteGroup (a,b)+instance (FiniteGroup a, FiniteGroup b, FiniteGroup c) => FiniteGroup (a,b,c)+instance (FiniteGroup a, FiniteGroup b, FiniteGroup c, FiniteGroup d) => FiniteGroup (a,b,c,d)+instance (FiniteGroup a, FiniteGroup b, FiniteGroup c, FiniteGroup d, FiniteGroup e) => FiniteGroup (a,b,c,d,e)+instance FiniteGroup Any+instance FiniteGroup All+instance FiniteGroup (Sum Int)+instance FiniteGroup (Sum Int8)+instance FiniteGroup (Sum Int16)+instance FiniteGroup (Sum Int32)+instance FiniteGroup (Sum Int64)+instance FiniteGroup (Sum Word)+instance FiniteGroup (Sum Word8)+instance FiniteGroup (Sum Word16)+instance FiniteGroup (Sum Word32)+instance FiniteGroup (Sum Word64)+instance FiniteGroup Ordering++#if __GLASGOW_HASKELL__ >= 810+instance FiniteGroup a => FiniteGroup (Down a)+#endif++-- -------------------------------------------------------------------- --+-- Finite group combinators++-- | A safe version of 'order' for 'FiniteGroup's.+--+-- This is gauranteed to terminate with either @Infinite@ or @Finite@.+--+-- === __Examples__:+--+-- >>> order @(Sum Word8) 3+-- Finite 255+--+-- >>> order (Any False)+-- Finite 1+--+-- >>> order (All False)+-- Infinite+--+safeOrder :: (Eq g, FiniteGroup g) => g -> Order+safeOrder = order+{-# inline safeOrder #-}++-- -------------------------------------------------------------------- --+-- Finite abelian groups++-- | Commutative 'FiniteGroup's+--+class FiniteGroup g => FiniteAbelianGroup g++instance FiniteAbelianGroup ()+instance FiniteAbelianGroup a => FiniteAbelianGroup (Dual a)+instance FiniteAbelianGroup (Sum Int)+instance FiniteAbelianGroup (Sum Int8)+instance FiniteAbelianGroup (Sum Int16)+instance FiniteAbelianGroup (Sum Int32)+instance FiniteAbelianGroup (Sum Int64)+instance FiniteAbelianGroup (Sum Word)+instance FiniteAbelianGroup (Sum Word8)+instance FiniteAbelianGroup (Sum Word16)+instance FiniteAbelianGroup (Sum Word32)+instance FiniteAbelianGroup (Sum Word64)+instance FiniteAbelianGroup a => FiniteAbelianGroup (Const a b)+instance FiniteAbelianGroup a => FiniteAbelianGroup (Identity a)+instance FiniteAbelianGroup a => FiniteAbelianGroup (Proxy a)+instance (FiniteAbelianGroup a, FiniteAbelianGroup b) => FiniteAbelianGroup (a,b)+instance (FiniteAbelianGroup a, FiniteAbelianGroup b, FiniteAbelianGroup c) => FiniteAbelianGroup (a,b,c)+instance (FiniteAbelianGroup a, FiniteAbelianGroup b, FiniteAbelianGroup c, FiniteAbelianGroup d) => FiniteAbelianGroup (a,b,c,d)+instance (FiniteAbelianGroup a, FiniteAbelianGroup b, FiniteAbelianGroup c, FiniteAbelianGroup d, FiniteAbelianGroup e) => FiniteAbelianGroup (a,b,c,d,e)+instance FiniteAbelianGroup Ordering++#if __GLASGOW_HASKELL__ >= 810+instance FiniteAbelianGroup a => FiniteAbelianGroup (Down a)+#endif
+ src/Data/Group/Foldable.hs view
@@ -0,0 +1,175 @@+{-# language CPP #-}+{-# language FlexibleInstances #-}+{-# language Safe #-}+#if MIN_VERSION_base(4,12,0)+{-# language TypeOperators #-}+#endif+-- |+-- Module       : Data.Group+-- Copyright    : (c) 2020 Reed Mullanix, Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Reed Mullanix <reedmullanix@gmail.com>,+--                Emily Pillmore <emilypi@cohomolo.gy>+--+-- Stability    : stable+-- Portability  : non-portable+--+-- This module provides definitions 'GroupFoldable',+-- along with useful combinators.+--+module Data.Group.Foldable+( -- * Group foldable+  GroupFoldable(..)+  -- ** Group foldable combinators+, gold+, goldr+, toFreeGroup+) where+++import Data.Functor.Compose+import Data.Functor.Const+import Data.Functor.Identity+import Data.Group+import Data.Group.Free+import Data.Group.Free.Church+import Data.Group.Permutation+import Data.Monoid++#if MIN_VERSION_base(4,12,0)+import GHC.Generics+#endif+++-- $setup+--+-- >>> import qualified Prelude+-- >>> import Data.Group+-- >>> import Data.Monoid+-- >>> import Data.Semigroup+-- >>> import Data.Word+-- >>> :set -XTypeApplications+-- >>> :set -XFlexibleContexts++-- -------------------------------------------------------------------- --+-- Group foldable++-- | The class of data structures that can be groupoidally folded.+--+-- 'GroupFoldable' has difficult-to-define laws in terms of Haskell,+-- but is well-understood categorically: 'GroupFoldable's are+-- functors (not necessarily 'Functor's) in the slice category \( [\mathcal{Hask}, \mathcal{Hask}] / F \),+-- where \( F \) is the free group functor in \( \mathcal{Hask} \). Hence, they are+-- defined by the natural transformations \( [\mathcal{Hask},\mathcal{Hask}](-, F) \) - i.e. 'toFG', or 'toFreeGroup'.+--+class GroupFoldable t where+  -- | Apply a 'Group' fold to some container.+  --+  -- This function takes a container that can be represented as a+  -- 'FreeGroup', and simplifies the container as a word in the+  -- free group, producing a final output according to some+  -- mapping of elements into the target group.+  --+  -- The name is a pun on 'Group' and 'Data.Foldable.fold'.+  --+  -- === __Examples__:+  --+  -- >>> let x = FreeGroup $ [Left (1 :: Sum Word8), Left 2, Right 2, Right 3]+  -- >>> goldMap id x+  -- Sum {getSum = 2}+  --+  -- >>> goldMap (\a -> if a < 2 then mempty else a) x+  -- Sum {getSum = 3}+  --+  goldMap :: Group g => (a -> g) -> t a -> g+  goldMap f t = runFG (toFG t) f+  {-# inline goldMap #-}++  -- | Translate a 'GroupFoldable' container into a Church-encoded+  -- free group.+  --+  -- Analagous to 'Data.Foldable.toList' for 'Foldable', if 'Data.Foldable.toList' respected the+  -- associativity of ⊥.+  --+  toFG :: t a -> FG a+  toFG t = FG $ \k -> goldMap k t+  {-# inline toFG #-}+  {-# minimal goldMap | toFG #-}++instance GroupFoldable FG where+  toFG = id++instance GroupFoldable FreeGroup where+  toFG = reflectFG++instance GroupFoldable Sum where+  goldMap f = f . getSum++instance GroupFoldable Product where+  goldMap f = f . getProduct++instance GroupFoldable Dual where+  goldMap f = f . getDual++instance GroupFoldable (Const a) where+  goldMap _ _ = mempty++instance GroupFoldable Identity where+  goldMap f = f . runIdentity++instance (GroupFoldable f, GroupFoldable g) => GroupFoldable (Compose f g) where+  goldMap f = goldMap (goldMap f) . getCompose++#if MIN_VERSION_base(4,12,0)+instance (GroupFoldable f, GroupFoldable g) => GroupFoldable (f :*: g) where+  goldMap f (a :*: b) = goldMap f a <> goldMap f b++instance (GroupFoldable f, GroupFoldable g) => GroupFoldable (f :+: g) where+  toFG (L1 l) = toFG l+  toFG (R1 r) = toFG r++instance (GroupFoldable f, GroupFoldable g) => GroupFoldable (f :.: g) where+  goldMap f = goldMap (goldMap f) . unComp1+#endif++instance GroupFoldable Abelianizer where+  goldMap _ Quot = mempty+  goldMap f (Commuted a) = f a++-- -------------------------------------------------------------------- --+-- Group foldable combinators++-- | Simplify a word in 'GroupFoldable' container as a word+-- in a 'FreeGroup'.+--+-- The name is a pun on 'Group' and 'Data.Foldable.fold'.+--+-- === __Examples__:+--+-- >>> let x = FreeGroup $ [Left (1 :: Sum Word8), Left 2, Right 2, Right 3]+-- >>> gold x+-- Sum {getSum = 2}+--+gold :: (GroupFoldable t, Group g) => t g -> g+gold = goldMap id+{-# inline gold #-}++-- | Convert a 'GroupFoldable' container into a 'FreeGroup'+--+toFreeGroup :: (GroupFoldable t, Group g) => t g -> FreeGroup g+toFreeGroup = reifyFG . toFG+{-# inline toFreeGroup #-}++-- | A right group fold from a 'GroupFoldable' container to its permutation group+--+-- Analogous to 'Data.Foldable.foldr' for monoidal 'Foldable's.+--+goldr+  :: GroupFoldable t+  => Group g+  => (a -> Permutation g)+  -> t a+  -> Permutation g+goldr = goldMap+{-# inline goldr #-}
+ src/Data/Group/Free.hs view
@@ -0,0 +1,171 @@+{-# language Safe #-}+-- |+-- Module       : Data.Group+-- Copyright    : (c) 2020 Reed Mullanix, Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Reed Mullanix <reedmullanix@gmail.com>,+--                Emily Pillmore <emilypi@cohomolo.gy>+--+-- Stability    : stable+-- Portability  : non-portable+--+-- This module provides definitions for 'FreeGroup's and 'FreeAbelianGroup's,+-- along with useful combinators.+--+module Data.Group.Free+( -- * Free groups+  FreeGroup(..)+  -- ** Free group combinators+, simplify+, interpret+, interpret'+, present+  -- * Free abelian groups+, FreeAbelianGroup(..)+  -- ** Free abelian group combinators+, abmap+, abjoin+, singleton+, abInterpret+) where++import Control.Applicative+import Control.Monad++import Data.Bifunctor+import Data.List (foldl')+import Data.Map (Map)+import qualified Data.Map.Strict as Map+import Data.Group++-- $setup+--+-- >>> import qualified Prelude+-- >>> import Data.Group+-- >>> import Data.Monoid+-- >>> import Data.Semigroup+-- >>> import Data.Word+-- >>> :set -XTypeApplications+-- >>> :set -XFlexibleContexts++-- | A representation of a free group over an alphabet @a@.+--+-- The intuition here is that @Left a@ represents a "negative" @a@,+-- whereas @Right a@ represents "positive" @a@.+--+-- __Note:__ This does not perform simplification upon multiplication or construction.+-- To do this, one should use 'simplify'.+--+newtype FreeGroup a = FreeGroup { runFreeGroup :: [Either a a] }+    deriving (Show, Eq, Ord)++instance Semigroup (FreeGroup a) where+    (FreeGroup g) <> (FreeGroup g') = FreeGroup (g ++ g')++instance Monoid (FreeGroup a) where+    mempty = FreeGroup []++instance Group (FreeGroup a) where+    invert (FreeGroup g) = FreeGroup $ fmap inv g+        where+          inv :: Either a a -> Either a a+          inv (Left a) = Right a+          inv (Right a) = Left a++instance Functor FreeGroup where+    fmap f (FreeGroup g) = FreeGroup $ fmap (bimap f f) g++instance Applicative FreeGroup where+    pure a = FreeGroup $ pure $ pure a+    (<*>) = ap++instance Monad FreeGroup where+    return = pure+    (FreeGroup g) >>= f = FreeGroup $ concatMap go g+        where+          go (Left a)  = runFreeGroup $ invert $ f a+          go (Right a) = runFreeGroup $ f a++instance Alternative FreeGroup where+    empty = mempty+    (<|>) = (<>)++-- | /O(n)/ Simplifies a word in a free group.+--+-- === __Examples:__+--+-- >>> simplify $ FreeGroup [Right 'a', Left 'b', Right 'c', Left 'c', Right 'b', Right 'a']+-- FreeGroup {runFreeGroup = [Right 'a',Right 'a']}+--+simplify :: (Eq a) => FreeGroup a -> FreeGroup a+simplify (FreeGroup g) = FreeGroup $ foldr go [] g+    where+      go (Left a) ((Right a'):as) | a == a' = as+      go (Right a) ((Left a'):as) | a == a' = as+      go a as = a:as++-- | /O(n)/ Interpret a word in a free group over some group @g@ as an element in a group @g@.+--+interpret :: (Group g) => FreeGroup g -> g+interpret (FreeGroup g) = foldr go mempty g+    where+      go (Left a) acc  = invert a <> acc+      go (Right a) acc = a <> acc++-- | /O(n)/ Strict variant of 'interpret'.+--+interpret' :: (Group g) => FreeGroup g -> g+interpret' (FreeGroup g) = foldl' go mempty g+    where+      go acc (Left a) = acc <> invert a+      go acc (Right a) = acc <> a++-- | Present a 'Group' as a 'FreeGroup' modulo relations.+--+present :: Group g => FreeGroup g -> (FreeGroup g -> g) -> g+present = flip ($)+{-# inline present #-}++-- | A representation of a free abelian group over an alphabet @a@.+--+-- The intuition here is group elements correspond with their positive+-- or negative multiplicities, and as such are simplified by construction.+--+newtype FreeAbelianGroup a = FreeAbelianGroup { runFreeAbelian :: Map a Int }+    deriving (Show, Eq, Ord)++instance (Ord a) => Semigroup (FreeAbelianGroup a) where+    (FreeAbelianGroup g) <> (FreeAbelianGroup g') =+      FreeAbelianGroup $ Map.unionWith (+) g g'++instance (Ord a) => Monoid (FreeAbelianGroup a) where+    mempty = FreeAbelianGroup mempty++instance (Ord a) => Group (FreeAbelianGroup a) where+    invert (FreeAbelianGroup g) = FreeAbelianGroup $ fmap negate g++-- NOTE: We can't implement Functor/Applicative/Monad here+-- due to the Ord constraint. C'est La Vie!++-- | Functorial 'fmap' for a 'FreeAbelianGroup'.+--+abmap :: (Ord b) => (a -> b) -> FreeAbelianGroup a -> FreeAbelianGroup b+abmap f (FreeAbelianGroup g) = FreeAbelianGroup $ Map.mapKeys f g++-- | Lift a singular value into a 'FreeAbelianGroup'. Analogous to 'pure'.+--+singleton :: a -> FreeAbelianGroup a+singleton a = FreeAbelianGroup $ Map.singleton a 1++-- | Monadic 'join' for a 'FreeAbelianGroup'.+--+abjoin :: (Ord a) => FreeAbelianGroup (FreeAbelianGroup a) -> FreeAbelianGroup a+abjoin (FreeAbelianGroup g) = FreeAbelianGroup $ Map.foldMapWithKey go g+    where+      go (FreeAbelianGroup g') n = fmap (*n) g'++-- | Interpret a free group as a word in the underlying group @g@.+--+abInterpret :: (Group g) => FreeAbelianGroup g -> g+abInterpret (FreeAbelianGroup g) = Map.foldMapWithKey (flip gtimes) g
+ src/Data/Group/Free/Church.hs view
@@ -0,0 +1,158 @@+{-# language RankNTypes #-}+{-# language Safe #-}+-- |+-- Module       : Data.Group+-- Copyright    : (c) 2020 Reed Mullanix, Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Reed Mullanix <reedmullanix@gmail.com>,+--                Emily Pillmore <emilypi@cohomolo.gy>+--+-- Stability    : stable+-- Portability  : non-portable+--+-- This module provides definitions for Church-encoded+-- 'FreeGroup's, 'FreeAbelianGroup's, along with useful combinators.+--+module Data.Group.Free.Church+( -- * Church-encoded free groups+  FG(..)+  -- ** Church-encoded free group combinators+, interpretFG+, reifyFG+, reflectFG+, presentFG+  -- * Church-encoded free abelian groups+, FA(..)+  -- ** Church-encoded free abelian group combinators+, forgetFA+, interpretFA+, reifyFA+, reflectFA+) where++import Control.Applicative+import Control.Monad++import Data.Group+import Data.Group.Free+import qualified Data.Map.Strict as Map++-- | The Church-encoding of a 'FreeGroup'.+--+-- This datatype represents the free group on some @a@-valued+-- generators. For more information on why this encoding is preferred,+-- see Dan Doel's <http://comonad.com/reader/2015/free-monoids-in-haskell/ article> in+-- the Comonad Reader.+--+newtype FG a = FG { runFG :: forall g. (Group g) => (a -> g) -> g }++instance Semigroup (FG a) where+  (FG g) <> (FG g') = FG $ \k -> g k <> g' k++instance Monoid (FG a) where+  mempty = FG $ const mempty++instance Group (FG a) where+  invert (FG g) = FG (invert . g)++instance Functor FG where+  fmap f (FG fa) = FG $ \k -> fa (k . f)++instance Applicative FG where+  pure a = FG ($ a)+  (<*>) = ap++instance Monad FG where+  return = pure+  (FG fg) >>= f = FG $ \k -> fg (\a -> (runFG $ f a) k)++instance Alternative FG where+  empty = mempty+  (<|>) = (<>)++-- | Interpret a Church-encoded free group as a concrete 'FreeGroup'.+--+interpretFG :: Group g => FG g -> g+interpretFG (FG fg) = fg id+{-# inline interpretFG #-}++-- | Convert a Church-encoded free group to a concrete 'FreeGroup'.+--+reifyFG :: FG a -> FreeGroup a+reifyFG fg = interpretFG $ fmap pure fg+{-# inline reifyFG #-}++-- | Convert a concrete 'FreeGroup' to a Church-encoded free group.+--+reflectFG :: FreeGroup a -> FG a+reflectFG (FreeGroup fg) = FG $ \k -> foldMap (go k) fg+  where+    go k (Left a) = invert (k a)+    go k (Right a) = k a+{-# inline reflectFG #-}++-- | Present a 'Group' as a 'FG' modulo relations.+--+presentFG :: Group g => FG g -> (FG g -> g) -> g+presentFG = flip ($)+{-# inline presentFG #-}++----------------------------------------+-- Free Abelian Groups++-- | The Church-encoding of a 'FreeAbelianGroup'.+--+-- This datatype represents the free group on some @a@-valued+-- generators, along with their exponents in the group.+--+newtype FA a = FA { runFA :: forall g. (Group g) => (a -> Int -> g) -> g }++instance Semigroup (FA a) where+  (FA g) <> (FA g') = FA $ \k -> g k <> g' k++instance Monoid (FA a) where+  mempty = FA $ const mempty++instance Group (FA a) where+  invert (FA g) = FA (invert . g)++instance Functor FA where+  fmap f (FA fa) = FA $ \k -> fa (k . f)++instance Applicative FA where+  pure a = FA $ \k -> k a 1+  (<*>) = ap++instance Monad FA where+  return = pure+  (FA fa) >>= f = FA $ \k -> fa (\a n -> gtimes n $ (runFA $ f a) k)++instance Alternative FA where+  empty = mempty+  (<|>) = (<>)++-- | Interpret a Church-encoded free abelian group as a concrete 'FreeAbelianGroup'.+--+interpretFA :: Group g => FA g -> g+interpretFA (FA fa) = fa (flip gtimes)+{-# inline interpretFA #-}++-- | Convert a Church-encoded free abelian group to a concrete 'FreeAbelianGroup'.+--+reifyFA :: Ord a => FA a -> FreeAbelianGroup a+reifyFA = interpretFA . fmap singleton+{-# inline reifyFA #-}++-- | Convert a concrete 'FreeAbelianGroup' to a Church-encoded free abelian group.+--+reflectFA :: Ord a => FreeAbelianGroup a -> FA a+reflectFA (FreeAbelianGroup fa) = FA $ \k -> Map.foldMapWithKey k fa+{-# inline reflectFA #-}++-- | Forget the commutative structure of a Church-encoded free abelian group,+-- turning it into a standard free group.+--+forgetFA :: Group a => FA a -> FG a+forgetFA fa = FG ($ interpretFA fa)+{-# inline forgetFA #-}
+ src/Data/Group/Multiplicative.hs view
@@ -0,0 +1,168 @@+{-# language FlexibleInstances #-}+{-# language Safe #-}+-- |+-- Module       : Data.Group.Multiplicative+-- Copyright    : (c) 2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>,+--                Reed Mullanix <reedmullanix@gmail.com>+-- Stability    : stable+-- Portability  : non-portable+--+-- This module contains definitions for 'MultiplicativeGroup' and+-- 'MultiplicativeAbelianGroup', along with the relevant combinators.+--+module Data.Group.Multiplicative+( -- * Multiplicative Groups+  MultiplicativeGroup+  -- ** combinators+, (/)+, (*)+, (^)+, power+  -- * Multiplicative abelian groups+, MultiplicativeAbelianGroup+) where+++import Data.Functor.Const+import Data.Functor.Identity+import Data.Group+import Data.Int+import Data.Proxy+import Data.Ratio+import Data.Semigroup+import Data.Word++import Numeric.Natural++import Prelude hiding ((^), (/), (*))++infixl 7 /, *+infixr 8 ^++-- $setup+--+-- >>> import qualified Prelude+-- >>> import Data.Group+-- >>> import Data.Monoid+-- >>> import Data.Semigroup+-- >>> :set -XTypeApplications++-- -------------------------------------------------------------------- --+-- Multiplicative groups++-- | An multiplicative group is a 'Group' whose operation can be thought of+-- as multiplication in some sense.+--+-- For example, the multiplicative group of rationals \( (ℚ, 1, *) \).+--+class Group g => MultiplicativeGroup g++instance MultiplicativeGroup ()+instance MultiplicativeGroup b => MultiplicativeGroup (a -> b)+instance MultiplicativeGroup a => MultiplicativeGroup (Dual a)+instance MultiplicativeGroup All+instance MultiplicativeGroup (Product (Ratio Integer))+instance MultiplicativeGroup (Product (Ratio Natural))+instance MultiplicativeGroup (Product (Ratio Int))+instance MultiplicativeGroup (Product (Ratio Int8))+instance MultiplicativeGroup (Product (Ratio Int16))+instance MultiplicativeGroup (Product (Ratio Int32))+instance MultiplicativeGroup (Product (Ratio Int64))+instance MultiplicativeGroup (Product (Ratio Word))+instance MultiplicativeGroup (Product (Ratio Word8))+instance MultiplicativeGroup (Product (Ratio Word16))+instance MultiplicativeGroup (Product (Ratio Word32))+instance MultiplicativeGroup (Product (Ratio Word64))+instance (MultiplicativeGroup a, MultiplicativeGroup b) => MultiplicativeGroup (a,b)+instance (MultiplicativeGroup a, MultiplicativeGroup b, MultiplicativeGroup c) => MultiplicativeGroup (a,b,c)+instance (MultiplicativeGroup a, MultiplicativeGroup b, MultiplicativeGroup c, MultiplicativeGroup d) => MultiplicativeGroup (a,b,c,d)+instance (MultiplicativeGroup a, MultiplicativeGroup b, MultiplicativeGroup c, MultiplicativeGroup d, MultiplicativeGroup e) => MultiplicativeGroup (a,b,c,d,e)+instance MultiplicativeGroup a => MultiplicativeGroup (Const a b)+instance MultiplicativeGroup a => MultiplicativeGroup (Identity a)+instance MultiplicativeGroup a => MultiplicativeGroup (Proxy a)++-- | Infix alias for multiplicative inverse.+--+-- === __Examples__:+--+-- >>> let x = Product (4 :: Rational)+-- >>> x / 2+-- Product {getProduct = 2 % 1}+--+(/) :: MultiplicativeGroup a => a -> a -> a+(/) = minus+{-# inline (/) #-}++-- | Infix alias for multiplicative @('<>')@.+--+-- === __Examples__:+--+-- >>> Product (2 :: Rational) * Product (3 :: Rational)+-- Product {getProduct = 6 % 1}+--+(*) :: MultiplicativeGroup g => g -> g -> g+(*) = (<>)+{-# inline (*) #-}++-- | Infix alias for 'power'.+--+-- === __Examples__:+--+-- >>> let x = Product (3 :: Rational)+-- >>> x ^ 3+-- Product {getProduct = 27 % 1}+--+(^) :: (Integral n, MultiplicativeGroup a) => a -> n -> a+(^) = power+{-# inline (^) #-}++-- | Multiply an element of a multiplicative group by itself @n@-many times.+--+-- This represents @ℕ@-indexed powers of an element @g@ of+-- a multiplicative group, i.e. iterated products of group elements.+-- This is representable by the universal property+-- \( C(x, ∏_n g) ≅ C(x, g)^n \).+--+-- === __Examples__:+--+-- >>> power (Product (3 :: Rational)) 3+-- Product {getProduct = 27 % 1}+--+power :: (Integral n, MultiplicativeGroup g) => g -> n -> g+power a n = gtimes n a+{-# inline power #-}++-- -------------------------------------------------------------------- --+-- Multiplicative abelian groups++-- | A multiplicative abelian group is a 'Group' whose operation can be thought of+-- as commutative multiplication in some sense. Almost all multiplicative groups+-- are abelian.+--+class (MultiplicativeGroup g, AbelianGroup g) => MultiplicativeAbelianGroup g+instance MultiplicativeAbelianGroup ()+instance MultiplicativeAbelianGroup b => MultiplicativeAbelianGroup (a -> b)+instance MultiplicativeAbelianGroup a => MultiplicativeAbelianGroup (Dual a)+instance MultiplicativeAbelianGroup All+instance MultiplicativeAbelianGroup (Product (Ratio Integer))+instance MultiplicativeAbelianGroup (Product (Ratio Natural))+instance MultiplicativeAbelianGroup (Product (Ratio Int))+instance MultiplicativeAbelianGroup (Product (Ratio Int8))+instance MultiplicativeAbelianGroup (Product (Ratio Int16))+instance MultiplicativeAbelianGroup (Product (Ratio Int32))+instance MultiplicativeAbelianGroup (Product (Ratio Int64))+instance MultiplicativeAbelianGroup (Product (Ratio Word))+instance MultiplicativeAbelianGroup (Product (Ratio Word8))+instance MultiplicativeAbelianGroup (Product (Ratio Word16))+instance MultiplicativeAbelianGroup (Product (Ratio Word32))+instance MultiplicativeAbelianGroup (Product (Ratio Word64))+instance (MultiplicativeAbelianGroup a, MultiplicativeAbelianGroup b) => MultiplicativeAbelianGroup (a,b)+instance (MultiplicativeAbelianGroup a, MultiplicativeAbelianGroup b, MultiplicativeAbelianGroup c) => MultiplicativeAbelianGroup (a,b,c)+instance (MultiplicativeAbelianGroup a, MultiplicativeAbelianGroup b, MultiplicativeAbelianGroup c, MultiplicativeAbelianGroup d) => MultiplicativeAbelianGroup (a,b,c,d)+instance (MultiplicativeAbelianGroup a, MultiplicativeAbelianGroup b, MultiplicativeAbelianGroup c, MultiplicativeAbelianGroup d, MultiplicativeAbelianGroup e) => MultiplicativeAbelianGroup (a,b,c,d,e)+instance MultiplicativeAbelianGroup a => MultiplicativeAbelianGroup (Const a b)+instance MultiplicativeAbelianGroup a => MultiplicativeAbelianGroup (Identity a)+instance MultiplicativeAbelianGroup a => MultiplicativeAbelianGroup (Proxy a)
+ src/Data/Group/Permutation.hs view
@@ -0,0 +1,121 @@+{-# language PatternSynonyms #-}+{-# language Safe #-}+{-# language ViewPatterns #-}+-- |+-- Module       : Data.Group+-- Copyright    : (c) 2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Reed Mullanix <reedmullanix@gmail.com>,+--                Emily Pillmore <emilypi@cohomolo.gy>+--+-- Stability    : stable+-- Portability  : non-portable+--+-- This module provides definitions for 'Permutation's+-- along with useful combinators.+--+module Data.Group.Permutation+( -- * Permutation groups+  Permutation(..)+  -- ** Permutation group combinators+, permute+, pairwise+, (-$)+, ($-)+, embed+, retract+  -- ** Permutation patterns+, pattern Permute+) where+++import Data.Group+import Data.Group.Additive+import Data.Group.Multiplicative++infixr 0 $-, -$++-- -------------------------------------------------------------------- --+-- Permutations++-- | Isomorphism of a finite set onto itself. Each entry consists of one+-- half of the isomorphism.+--+-- /Note/: It is the responsibility of the user to provide inverse proofs+-- for 'to' and 'from'. Be responsible!+--+data Permutation a = Permutation+  { to :: a -> a+    -- ^ The forward half of the bijection+  , from :: a -> a+    -- ^ The inverse half of the bijection+  }++-- instance Profunctor Permutation where+--   dimap = :'(++instance Semigroup a => Semigroup (Permutation a) where+  a <> b = Permutation (to a <> to b) (from a <> from b)++instance Monoid a => Monoid (Permutation a) where+  mempty = Permutation id id++instance Group a => Group (Permutation a) where+  invert (Permutation t f) = Permutation (f . t) (t . f)++instance AbelianGroup a => AbelianGroup (Permutation a)+instance AdditiveGroup a => AdditiveGroup (Permutation a)+instance AdditiveAbelianGroup a => AdditiveAbelianGroup (Permutation a)+instance MultiplicativeGroup a => MultiplicativeGroup (Permutation a)+++-- -------------------------------------------------------------------- --+-- Permutation group combinators++-- | Build a 'Permutation' from a bijective pair.+--+permute :: (a -> a) -> (a -> a) -> Permutation a+permute = Permutation+{-# inline permute #-}++-- | Destroy a 'Permutation', producing the underlying pair of+-- bijections.+--+pairwise :: Permutation a -> (a -> a, a -> a)+pairwise p = (to p, from p)+{-# inline pairwise #-}++-- | Infix alias for the 'to' half of 'Permutation' bijection+--+(-$) :: Permutation a -> a -> a+(-$) = to+{-# inline (-$) #-}++-- | Infix alias for the 'from' half of 'Permutation' bijection+--+($-) :: Permutation a -> a -> a+($-) = from+{-# inline ($-) #-}++-- | Embed a 'Group' into the 'Permutation' group on it's underlying set.+--+embed :: (Group g) => g -> Permutation g+embed g = Permutation { to = (g <>), from = (invert g <>) }++-- | Get a group element out of the permutation group.+-- This is a left inverse to 'embed', i.e.+--+-- @+--    retract . embed = id+-- @+--+retract :: (Group g) => Permutation g -> g+retract p = p -$ mempty++-- | Bidirectional pattern synonym for embedding/retraction of groups+-- into their permutation groups.+--+pattern Permute :: Group g => Permutation g -> g+pattern Permute p <- (embed -> p)+  where Permute p = retract p
+ test/doctests.hs view
@@ -0,0 +1,7 @@+module Main where++import Build_doctests (flags, pkgs, module_sources)+import Test.DocTest (doctest)++main :: IO ()+main = doctest $ flags ++ pkgs ++ module_sources