Copyright | (c) Donnacha Oisín Kidney 2018 |
---|---|
License | MIT |
Maintainer | mail@doisinkidney.com |
Stability | experimental |
Portability | GHC |
Safe Haskell | None |
Language | Haskell2010 |
Data.Monoid.Diff
Description
This module provides the Difference Monoid, which adds subtraction to arbitrary monoids.
This has a number of uses:
will give you a type similar toDiff
(Product
a)Ratio
. Here, the "subtraction" operation is division. For example:>>>
(1 :-: 2) <> (3 :-: 4) :: Diff (Product Int)
Product {getProduct = 3} :-: Product {getProduct = 8}In a similar vein,
will add subtraction to a numeric type:Diff
(Sum
a)>>>
runDiff (-) (diff 2 <> diff 3 <> invert (diff 4)) :: Sum Natural
Sum {getSum = 1}This will let you work with nonnegative types, where you need some form of subtraction (for, e.g., differences, hence the name), and you only want to check for underflow once.
Using the above example, in particular, we get a monoid for averages:
>>>
import Data.Function (on)
>>>
let avg = runDiff ((%) `on` getProduct.getSum) . foldMap (fmap Sum . diff . Product)
>>>
avg [1,4,3,2,5]
3 % 1
The Monoid
and Semigroup
laws hold in a pretty
straightforward way, provided the underlying type also follows those
laws.
For the Group
laws, the underlying type must be a
cancellative semigroup.
A cancellative semigroup is one where
If this does not hold, than the equivalence only holds modulo the the addition of some constant
Most common semigroups are cancellative, however notable exceptions include the cross product of vectors, matrix multiplication, and sets:
fromList
[1]<>
fromList
[1,2] =fromList
[1]<>
fromList
[2]
This type is known formally as the Grothendieck group.
The Diff Type
The Difference Monoid.
Constructors
!a :-: !a infixl 6 |
Instances
Monad Diff Source # | |
Functor Diff Source # | |
MonadFix Diff Source # | |
Applicative Diff Source # | |
Foldable Diff Source # | |
Traversable Diff Source # | |
Distributive Diff Source # | |
Representable Diff Source # | |
Read1 Diff Source # | |
Show1 Diff Source # | |
MonadZip Diff Source # | |
Comonad Diff Source # | |
ComonadApply Diff Source # | |
Traversable1 Diff Source # | |
Foldable1 Diff Source # | |
Apply Diff Source # | |
Bind Diff Source # | |
Extend Diff Source # | |
Adjunction Parity Diff Source # | |
Bounded a => Bounded (Diff a) Source # | |
(Eq a, Semigroup a) => Eq (Diff a) Source # | |
Data a => Data (Diff a) Source # | |
(Ord a, Semigroup a) => Ord (Diff a) Source # | |
Read a => Read (Diff a) Source # | |
Show a => Show (Diff a) Source # | |
Generic (Diff a) Source # | |
Semigroup a => Semigroup (Diff a) Source # | |
Monoid a => Monoid (Diff a) Source # | |
NFData a => NFData (Diff a) Source # | |
Monoid a => Group (Diff a) Source # | |
Generic1 * Diff Source # | |
type Rep Diff Source # | |
type Rep (Diff a) Source # | |
type Rep1 * Diff Source # | |
Functions for working with Diff
diff :: Monoid a => a -> Diff a Source #
Lift a monoid into the difference monoid.
>>>
diff (Sum 1)
Sum {getSum = 1} :-: Sum {getSum = 0}
foldDiff :: Group b => (a -> b) -> Diff a -> b Source #
A group homomorphism given a monoid homomorphism.
runDiff :: (a -> a -> b) -> Diff a -> b Source #
Interpret the difference using a subtraction function.
normalize :: (a -> a -> (a, a)) -> Diff a -> Diff a Source #
Given a "normalizing" function, try simplify the representation.
For instance, one such normalizing function may be to take the numeric difference of two types:
>>>
let sumNorm x y = if x >= y then (x - y, 0) else (0, y - x)
>>>
normalize sumNorm ((foldMap (diff.Sum) [1..10]) <> (invert (foldMap (diff.Sum) [1..5])))
Sum {getSum = 40} :-: Sum {getSum = 0}
Re-Exports from Group
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
Methods
Instances
Group () | |
Group Odd # | |
Group a => Group (Dual a) | |
Num a => Group (Sum a) | |
Fractional a => Group (Product a) | |
Monoid a => Group (Diff a) # | |
Group b => Group (a -> b) | |
(Group a, Group b) => Group (a, b) | |
(Group a, Group b, Group c) => Group (a, b, c) | |
(Group a, Group b, Group c, Group d) => Group (a, b, c, d) | |
(Group a, Group b, Group c, Group d, Group e) => Group (a, b, c, d, e) | |