diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +Version 1.2.2 +--------------- +* Add `Data.Monoid.LCM` module with `LCMMonoid` type class by Jonathan Knowles +* Repair links to Hackage within `README.md` by Jonathan Knowles + Version 1.2.1 --------------- * Fix for the `Monus` instance for `Maybe` by Jonathan Knowles diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,37 +4,38 @@ ### Subclasses of Semigroup and Monoid with a solid theoretical foundation and practical purposes ### The monoid-subclasses package has been released [on -Hackage](http://hackage.haskell.org/package/monoid-subclasses). The package defines several classes that are richer -than [semigroups](http://hackage.haskell.org/package/base/docs/Data-Semigroup.html#t:Semigroup) and -[monoids](http://hackage.haskell.org/package/base/docs/Data-Monoid.html#t:Monoid) but less demanding than -[groups](http://hackage.haskell.org/package/groups/docs/Data-Group.html): +Hackage](https://hackage.haskell.org/package/monoid-subclasses). The package defines several classes that are richer +than [semigroups](https://hackage.haskell.org/package/base/docs/Data-Semigroup.html#t:Semigroup) and +[monoids](https://hackage.haskell.org/package/base/docs/Data-Monoid.html#t:Monoid) but less demanding than +[groups](https://hackage.haskell.org/package/groups/docs/Data-Group.html): -* [Reductive](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Semigroup-Cancellative.html#t:Reductive) +* [Reductive](https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Semigroup-Cancellative.html#t:Reductive) provides the operator `` which acts as a partial inverse of the semigroup `<>` operator. -* [Cancellative](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Semigroup-Cancellative.html#t:Cancellative) +* [Cancellative](https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Semigroup-Cancellative.html#t:Cancellative) is a subclass of `Reductive` that provides additional guarantees about the `` operation result: (a <> b) a == Just b (a <> b) b == Just a Every group (*i.e.*, every `Monoid a` with the operation `inverse :: a -> a`) is a cancellative monoid where `a b = Just (a <> inverse b)` but not every `Cancellative` monoid is a group. - -* [GCDMonoid](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-GCD.html#t:GCDMonoid) is a subclass of `Reductive` and `Monoid` that provides the `gcd` operation for getting the greatest common denominator for two given monoid values. -* [Monus](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monus.html#t:Monus) provides the `<\>` monus operation. The set difference is one familiar instance of this operation. -* [MonoidNull](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-Null.html) class provides the Boolean `null` operation that checks if the argument monoid is `mempty`. -* [Factorial](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Semigroup-Factorial.html) and [FactorialMonoid](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-Factorial.html) classes represent semigroups and monoids that can be split up into irreducible factors. -That's the theoretical point of view. From the practical point of view, the main purpose of the _monoid-subclasses_ package is similar to that of [ListLike](http://hackage.haskell.org/package/ListLike/docs/Data-ListLike.html) - to provide unifying abstractions for various monoidal data types in Haskell, primarily [String](http://hackage.haskell.org/package/base/docs/Data-String.html#t:String), [ByteString](http://hackage.haskell.org/package/bytestring/docs/Data-ByteString.html#t:ByteString), and [Text](http://hackage.haskell.org/package/text). All three types are already instances of the [Monoid](http://hackage.haskell.org/package/base/docs/Data-Monoid.html#t:Monoid) class. While that abstraction is useful for building sequences of data, it doesn't help with deconstructing them. +* [GCDMonoid](https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-GCD.html#t:GCDMonoid) is a subclass of `Reductive` and `Monoid` that provides the `gcd` operation for getting the greatest common denominator for two given monoid values. +* [LCMMonoid](https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-LCM.html#t:LCMMonoid) is a subclass of `Reductive` and `Monoid` that provides the `lcm` operation for getting the least common multiple for two given monoid values. +* [Monus](https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-Monus.html#t:Monus) provides the `<\>` monus operation. The set difference is one familiar instance of this operation. +* [MonoidNull](https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-Null.html#t:MonoidNull) class provides the Boolean `null` operation that checks if the argument monoid is `mempty`. +* [Factorial](https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Semigroup-Factorial.html#t:Factorial) and [FactorialMonoid](https://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-Factorial.html#t:FactorialMonoid) classes represent semigroups and monoids that can be split up into irreducible factors. +That's the theoretical point of view. From the practical point of view, the main purpose of the _monoid-subclasses_ package is similar to that of [ListLike](https://hackage.haskell.org/package/ListLike/docs/Data-ListLike.html) - to provide unifying abstractions for various monoidal data types in Haskell, primarily [String](https://hackage.haskell.org/package/base/docs/Data-String.html#t:String), [ByteString](https://hackage.haskell.org/package/bytestring/docs/Data-ByteString.html#t:ByteString), and [Text](https://hackage.haskell.org/package/text). All three types are already instances of the [Monoid](https://hackage.haskell.org/package/base/docs/Data-Monoid.html#t:Monoid) class. While that abstraction is useful for building sequences of data, it doesn't help with deconstructing them. + That being said, there are two major differences in the goals of _ListLike_ and _monoid-subclasses_: - * _ListLike_ strives to reproduce the standard [Data.List](http://hackage.haskell.org/package/base/docs/Data-List.html) interface, whereas _monoid-subclasses_ builds from deeper theoretical foundations; and + * _ListLike_ strives to reproduce the standard [Data.List](https://hackage.haskell.org/package/base/docs/Data-List.html) interface, whereas _monoid-subclasses_ builds from deeper theoretical foundations; and * The _monoid-subclasses_ implementation uses standard Haskell 2010, with the exception of two minor extensions which can be worked around if necessary. -The [incremental-parser](http://hackage.haskell.org/package/incremental-parser) package can serve as a compact example +The [incremental-parser](https://hackage.haskell.org/package/incremental-parser) package can serve as a compact example of a parser library that can be applied to different input types thanks to _monoid-subclasses_. There is also -[picoparsec](http://hackage.haskell.org/package/picoparsec), a fork of -[attoparsec](http://hackage.haskell.org/package/attoparsec), and the heavy-duty -[grammatical-parsers](http://hackage.haskell.org/package/grammatical-parsers) library. +[picoparsec](https://hackage.haskell.org/package/picoparsec), a fork of +[attoparsec](https://hackage.haskell.org/package/attoparsec), and the heavy-duty +[grammatical-parsers](https://hackage.haskell.org/package/grammatical-parsers) library. A more thorough description of the library design can be found in the Haskell Symposium 2013 paper [Adding Structure to Monoids ](https://github.com/blamario/monoid-subclasses/wiki/Files/HaskellSymposium2013.pdf) diff --git a/Test/TestMonoidSubclasses.hs b/Test/TestMonoidSubclasses.hs --- a/Test/TestMonoidSubclasses.hs +++ b/Test/TestMonoidSubclasses.hs @@ -6,14 +6,15 @@ {-# LANGUAGE CPP, Rank2Types, ScopedTypeVariables, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving #-} {-# LANGUAGE ExistentialQuantification #-} +{- HLINT ignore "Use camelCase" -} module Main where -import Prelude hiding (foldl, foldr, gcd, length, null, reverse, span, splitAt, takeWhile) +import Prelude hiding (foldl, foldr, gcd, lcm, length, null, reverse, span, splitAt, takeWhile) import Test.Tasty (defaultMain, testGroup) import Test.Tasty.QuickCheck (Arbitrary, CoArbitrary, Property, Gen, - arbitrary, coarbitrary, property, label, forAll, mapSize, testProperty, variant, whenFail, (.&&.)) + arbitrary, coarbitrary, property, label, forAll, mapSize, testProperty, variant, whenFail, (.&&.), (===)) import Test.QuickCheck.Instances () import Control.Applicative (Applicative(..), liftA2) @@ -73,6 +74,7 @@ import Data.Monoid.GCD (GCDMonoid, LeftGCDMonoid, RightGCDMonoid, gcd, commonPrefix, stripCommonPrefix, commonSuffix, stripCommonSuffix) +import Data.Monoid.LCM (LCMMonoid, lcm) import Data.Monoid.Monus (OverlappingGCDMonoid, Monus, (<\>), overlap, stripOverlap, stripPrefixOverlap, stripSuffixOverlap) import Data.Monoid.Textual (TextualMonoid) @@ -96,6 +98,7 @@ | RightGCDTest (RightGCDMonoidInstance -> Property) | GCDTest (GCDMonoidInstance -> Property) | CancellativeGCDTest (CancellativeGCDMonoidInstance -> Property) + | LCMTest (LCMMonoidInstance -> Property) data CommutativeMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, Commutative a, Monoid a) => CommutativeMonoidInstance a @@ -138,6 +141,8 @@ GCDMonoidInstance a data CancellativeGCDMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, Monoid a, Cancellative a, GCDMonoid a) => CancellativeGCDMonoidInstance a +data LCMMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, LCMMonoid a) => + LCMMonoidInstance a commutativeInstances :: [CommutativeMonoidInstance] commutativeInstances = map upcast reductiveInstances @@ -369,6 +374,22 @@ cancellativeGCDInstances = [CancellativeGCDMonoidInstance ()] +lcmInstances = + [LCMMonoidInstance (mempty :: Product Natural), + LCMMonoidInstance (mempty :: Sum Natural), + LCMMonoidInstance (mempty :: Dual (Product Natural)), + LCMMonoidInstance (mempty :: Dual (Sum Natural)), + LCMMonoidInstance (mempty :: IntSet), + LCMMonoidInstance (mempty :: (IntSet, IntSet)), + LCMMonoidInstance (mempty :: (IntSet, IntSet, IntSet)), + LCMMonoidInstance (mempty :: (IntSet, IntSet, IntSet, IntSet)), + -- For sets, test with a variety of different universe sizes, from small + -- to large: + LCMMonoidInstance (mempty :: Set ()), + LCMMonoidInstance (mempty :: Set Bool), + LCMMonoidInstance (mempty :: Set Ordering), + LCMMonoidInstance (mempty :: Set Word8)] + main = defaultMain (testGroup "MonoidSubclasses" $ map expand tests) where expand (name, test) = testProperty name (foldr1 (.&&.) $ checkInstances test) @@ -391,6 +412,7 @@ checkInstances (RightGCDTest checkType) = (map checkType rightGCDInstances) checkInstances (GCDTest checkType) = (map checkType gcdInstances) checkInstances (CancellativeGCDTest checkType) = (map checkType cancellativeGCDInstances) +checkInstances (LCMTest checkType) = (map checkType lcmInstances) tests :: [(String, Test)] tests = [("CommutativeMonoid", CommutativeTest checkCommutative), @@ -478,7 +500,21 @@ ("stripCommonSuffix 3", RightGCDTest checkStripCommonSuffix3), ("stripCommonSuffix 4", RightGCDTest checkStripCommonSuffix4), ("gcd", GCDTest checkGCD), - ("cancellative gcd", CancellativeGCDTest checkCancellativeGCD) + ("cancellative gcd", CancellativeGCDTest checkCancellativeGCD), + ("lcm reductivity (left)", LCMTest checkLCM_reductivity_left), + ("lcm reductivity (right)", LCMTest checkLCM_reductivity_right), + ("lcm uniqueness", LCMTest checkLCM_uniqueness), + ("lcm idempotence", LCMTest checkLCM_idempotence), + ("lcm identity (left)", LCMTest checkLCM_identity_left), + ("lcm identity (right)", LCMTest checkLCM_identity_right), + ("lcm commutativity", LCMTest checkLCM_commutativity), + ("lcm associativity", LCMTest checkLCM_associativity), + ("lcm absorption (gcd-lcm)", LCMTest checkLCM_absorption_gcd_lcm), + ("lcm absorption (lcm-gcd)", LCMTest checkLCM_absorption_lcm_gcd), + ("lcm distributivity (left)", LCMTest checkLCM_distributivity_left), + ("lcm distributivity (right)", LCMTest checkLCM_distributivity_right), + ("lcm distributivity (gcd-lcm)", LCMTest checkLCM_distributivity_gcd_lcm), + ("lcm distributivity (lcm-gcd)", LCMTest checkLCM_distributivity_lcm_gcd) ] checkCommutative (CommutativeMonoidInstance (e :: a)) = forAll (arbitrary :: Gen (a, a)) (\(a, b)-> a <> b == b <> a) @@ -883,6 +919,77 @@ && commonSuffix (a <> c) (b <> c) == (commonSuffix a b) <> c && gcd (a <> b) (a <> c) == a <> gcd b c && gcd (a <> c) (b <> c) == gcd a b <> c + +checkLCM_reductivity_left (LCMMonoidInstance (_ :: a)) = + forAll (arbitrary :: Gen (a, a)) check + where + check a b = isJust (lcm a b a) + +checkLCM_reductivity_right (LCMMonoidInstance (_ :: a)) = + forAll (arbitrary :: Gen (a, a)) check + where + check a b = isJust (lcm a b b) + +checkLCM_uniqueness (LCMMonoidInstance (_ :: a)) = + forAll (arbitrary :: Gen (a, a, a)) check + where + check a b c = + all isJust [c a, c b, lcm a b c] === (lcm a b == c) + +checkLCM_idempotence (LCMMonoidInstance (_ :: a)) = + forAll (arbitrary :: Gen a) check + where + check a = lcm a a === a + +checkLCM_identity_left (LCMMonoidInstance (_ :: a)) = + forAll (arbitrary :: Gen a) check + where + check a = lcm mempty a === a + +checkLCM_identity_right (LCMMonoidInstance (_ :: a)) = + forAll (arbitrary :: Gen a) check + where + check a = lcm a mempty === a + +checkLCM_commutativity (LCMMonoidInstance (_ :: a)) = + forAll (arbitrary :: Gen (a, a)) check + where + check a b = lcm a b === lcm b a + +checkLCM_associativity (LCMMonoidInstance (_ :: a)) = + forAll (arbitrary :: Gen (a, a, a)) check + where + check a b c = lcm (lcm a b) c === lcm a (lcm b c) + +checkLCM_absorption_gcd_lcm (LCMMonoidInstance (_ :: a)) = + forAll (arbitrary :: Gen (a, a)) check + where + check a b = lcm a (gcd a b) === a + +checkLCM_absorption_lcm_gcd (LCMMonoidInstance (_ :: a)) = + forAll (arbitrary :: Gen (a, a)) check + where + check a b = gcd a (lcm a b) === a + +checkLCM_distributivity_left (LCMMonoidInstance (_ :: a)) = + forAll (arbitrary :: Gen (a, a, a)) check + where + check a b c = lcm (a <> b) (a <> c) === a <> lcm b c + +checkLCM_distributivity_right (LCMMonoidInstance (_ :: a)) = + forAll (arbitrary :: Gen (a, a, a)) check + where + check a b c = lcm (a <> c) (b <> c) === lcm a b <> c + +checkLCM_distributivity_gcd_lcm (LCMMonoidInstance (_ :: a)) = + forAll (arbitrary :: Gen (a, a, a)) check + where + check a b c = lcm a (gcd b c) === gcd (lcm a b) (lcm a c) + +checkLCM_distributivity_lcm_gcd (LCMMonoidInstance (_ :: a)) = + forAll (arbitrary :: Gen (a, a, a)) check + where + check a b c = gcd a (lcm b c) === lcm (gcd a b) (gcd a c) textualFactors :: TextualMonoid t => t -> [Either t Char] textualFactors = map characterize . factors diff --git a/monoid-subclasses.cabal b/monoid-subclasses.cabal --- a/monoid-subclasses.cabal +++ b/monoid-subclasses.cabal @@ -1,5 +1,5 @@ Name: monoid-subclasses -Version: 1.2.1 +Version: 1.2.2 Cabal-Version: >= 1.10 Build-Type: Simple Synopsis: Subclasses of Monoid @@ -11,7 +11,7 @@ License: BSD3 License-file: BSD3-LICENSE.txt -Copyright: (c) 2013-2021 Mario Blažević +Copyright: (c) 2013-2023 Mario Blažević Author: Mario Blažević Maintainer: Mario Blažević Homepage: https://github.com/blamario/monoid-subclasses/ @@ -24,7 +24,7 @@ Library hs-source-dirs: src Exposed-Modules: Data.Semigroup.Cancellative, Data.Semigroup.Factorial, - Data.Monoid.Cancellative, Data.Monoid.GCD, Data.Monoid.Monus, + Data.Monoid.Cancellative, Data.Monoid.GCD, Data.Monoid.LCM, Data.Monoid.Monus, Data.Monoid.Factorial, Data.Monoid.Null, Data.Monoid.Textual, Data.Monoid.Instances.ByteString.UTF8, Data.Monoid.Instances.CharVector, Data.Monoid.Instances.Concat, Data.Monoid.Instances.Measured, Data.Monoid.Instances.Positioned, diff --git a/src/Data/Monoid/LCM.hs b/src/Data/Monoid/LCM.hs new file mode 100644 --- /dev/null +++ b/src/Data/Monoid/LCM.hs @@ -0,0 +1,143 @@ +{-# 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. +-- +-- The 'LCMMonoid' class is for Abelian, /i.e./, 'Commutative' monoids. +-- +module Data.Monoid.LCM ( + LCMMonoid (..) + ) +where + +import Prelude hiding (lcm, max) +import qualified Prelude + +import Data.IntSet (IntSet) +import Data.Monoid (Dual (..), Product (..), Sum (..)) +import Data.Monoid.GCD (GCDMonoid) +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) + +-- | 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 +-- @ +-- +-- __/Distributivity/__ +-- +-- @ +-- 'lcm' (a '<>' b) (a '<>' c) '==' a '<>' 'lcm' b c +-- @ +-- @ +-- 'lcm' (a '<>' c) (b '<>' c) '==' 'lcm' a b '<>' c +-- @ +-- @ +-- '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 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)