{-# LANGUAGE Haskell2010, FlexibleInstances #-}
-- | This module defines the 'LCMMonoid' subclass of the 'Monoid' class.
--
-- The 'LCMMonoid' subclass adds the 'lcm' operation, which takes two monoidal
-- arguments and finds their /least common multiple/, or (more generally) the
-- least monoid from which either argument can be subtracted with the '</>'
-- operation.
--
-- For LCM monoids that are distributive, this module also provides the
-- 'DistributiveLCMMonoid' subclass of 'LCMMonoid'.
--
-- All classes in this module are for Abelian, /i.e./, 'Commutative' monoids.
--
module Data.Monoid.LCM
( LCMMonoid (..)
, DistributiveLCMMonoid
)
where
import Prelude hiding (gcd, lcm, max)
import qualified Prelude
import Data.IntSet (IntSet)
import Data.Monoid (Dual (..), Product (..), Sum (..))
import Data.Monoid.GCD (GCDMonoid (..), DistributiveGCDMonoid)
import Data.Set (Set)
import Numeric.Natural (Natural)
import qualified Data.IntSet as IntSet
import qualified Data.Set as Set
-- These imports are marked as redundant, but are actually required by haddock:
import Data.Maybe (isJust)
import Data.Semigroup.Cancellative (Reductive ((</>)))
import Data.Semigroup.Commutative (Commutative)
--------------------------------------------------------------------------------
-- LCMMonoid
--------------------------------------------------------------------------------
-- | Class of Abelian monoids that allow the /least common multiple/ to be
-- found for any two given values.
--
-- Operations must satisfy the following laws:
--
-- __/Reductivity/__
--
-- @
-- 'isJust' ('lcm' a b '</>' a)
-- @
-- @
-- 'isJust' ('lcm' a b '</>' b)
-- @
--
-- __/Uniqueness/__
--
-- @
-- 'all' 'isJust'
-- [ \ \ c '</>' a
-- , \ \ c '</>' b
-- , 'lcm' a b '</>' c
-- ]
-- ==>
-- ('lcm' a b '==' c)
-- @
--
-- __/Idempotence/__
--
-- @
-- 'lcm' a a '==' a
-- @
--
-- __/Identity/__
--
-- @
-- 'lcm' 'mempty' a '==' a
-- @
-- @
-- 'lcm' a 'mempty' '==' a
-- @
--
-- __/Commutativity/__
--
-- @
-- 'lcm' a b '==' 'lcm' b a
-- @
--
-- __/Associativity/__
--
-- @
-- 'lcm' ('lcm' a b) c '==' 'lcm' a ('lcm' b c)
-- @
--
-- __/Absorption/__
--
-- @
-- 'lcm' a ('gcd' a b) '==' a
-- @
-- @
-- 'gcd' a ('lcm' a b) '==' a
-- @
--
class GCDMonoid m => LCMMonoid m where
lcm :: m -> m -> m
instance LCMMonoid () where
lcm () () = ()
instance LCMMonoid a => LCMMonoid (Dual a) where
lcm (Dual a) (Dual b) = Dual (lcm a b)
instance LCMMonoid (Product Natural) where
lcm (Product a) (Product b) = Product (Prelude.lcm a b)
instance LCMMonoid (Sum Natural) where
lcm (Sum a) (Sum b) = Sum (Prelude.max a b)
instance Ord a => LCMMonoid (Set a) where
lcm = Set.union
instance LCMMonoid IntSet where
lcm = IntSet.union
instance (LCMMonoid a, LCMMonoid b) => LCMMonoid (a, b) where
lcm (a0, a1) (b0, b1) =
(lcm a0 b0, lcm a1 b1)
instance (LCMMonoid a, LCMMonoid b, LCMMonoid c) => LCMMonoid (a, b, c) where
lcm (a0, a1, a2) (b0, b1, b2) =
(lcm a0 b0, lcm a1 b1, lcm a2 b2)
instance (LCMMonoid a, LCMMonoid b, LCMMonoid c, LCMMonoid d) =>
LCMMonoid (a, b, c, d)
where
lcm (a0, a1, a2, a3) (b0, b1, b2, b3) =
(lcm a0 b0, lcm a1 b1, lcm a2 b2, lcm a3 b3)
--------------------------------------------------------------------------------
-- DistributiveLCMMonoid
--------------------------------------------------------------------------------
-- | Class of /commutative/ LCM monoids with /distributivity/.
--
-- In addition to the general 'LCMMonoid' laws, instances of this class
-- must also satisfy the following laws:
--
-- The 'lcm' operation itself must be /both/ left-distributive /and/
-- right-distributive:
--
-- @
-- 'lcm' (a '<>' b) (a '<>' c) '==' a '<>' 'lcm' b c
-- @
-- @
-- 'lcm' (a '<>' c) (b '<>' c) '==' 'lcm' a b '<>' c
-- @
--
-- The 'lcm' and 'gcd' operations must distribute over one another:
--
-- @
-- 'lcm' a ('gcd' b c) '==' 'gcd' ('lcm' a b) ('lcm' a c)
-- @
-- @
-- 'gcd' a ('lcm' b c) '==' 'lcm' ('gcd' a b) ('gcd' a c)
-- @
--
class (DistributiveGCDMonoid m, LCMMonoid m) => DistributiveLCMMonoid m
instance DistributiveLCMMonoid ()
instance DistributiveLCMMonoid (Product Natural)
instance DistributiveLCMMonoid (Sum Natural)
instance DistributiveLCMMonoid IntSet
instance Ord a => DistributiveLCMMonoid (Set a)
instance DistributiveLCMMonoid a => DistributiveLCMMonoid (Dual a)