# Maximum and Minimum monoids

wren ng thornton wren at freegeek.org
Fri Dec 28 05:19:41 CET 2012

```On 12/27/12 1:45 PM, Gabriel Gonzalez wrote:
> I don't know if this has been brought up before or not, but would it be
> possible to add the Maximum and Minimum monoids to Data.Monoid?  The
> following implementations extend the traditional semigroups using Maybe.

If we're going to go ahead with this, I've preferred using the following
suite which has a number of useful generalizations on the theme. The
only downside is that some of these require FlexibleInstances and
KindSignatures.

----------------------------------------------------------------
----------------------------------------------------------------
-- | The 'Monoid' given by @('max','minBound')@
newtype Max a = Max a
deriving (Eq, Ord, Show, Read, Bounded)

-- | Unwrap a 'Max' value. Not using record syntax to define this,
-- in order to pretty up the derived 'Show' instance.
getMax :: Max a -> a
getMax (Max a) = a

instance Functor Max where
fmap f (Max a) = Max (f a)

instance (Ord a, Bounded a) => Monoid (Max a) where
mempty  = Max minBound
mappend = max

----------------------------------------------------------------
-- | The 'Monoid' given by @('min','maxBound')@
newtype Min a = Min a
deriving (Eq, Ord, Show, Read, Bounded)

-- | Unwrap a 'Min' value. Not using record syntax to define this,
-- in order to pretty up the derived 'Show' instance.
getMin :: Min a -> a
getMin (Min a) = a

instance Functor Min where
fmap f (Min a) = Min (f a)

instance (Ord a, Bounded a) => Monoid (Min a) where
mempty  = Min maxBound
mappend = min

----------------------------------------------------------------
----------------------------------------------------------------
-- | Monoids for unbounded ordered types, with @Nothing@ serving
-- as the extreme bound.
newtype Priority (m :: * -> *) a = Priority (Maybe a)

-- | Constructor for a 'Priority' value.
mkPriority :: (Ord a) => a -> Priority m a
mkPriority x = Priority (Just x)

-- | Monomorphized version of 'mkPriority' for convenience.
mkPriorityMax :: (Ord a) => a -> Priority Max a
mkPriorityMax = mkPriority

-- | Monomorphized version of 'mkPriority' for convenience.
mkPriorityMin :: (Ord a) => a -> Priority Min a
mkPriorityMin = mkPriority

-- | Unwrap a 'Priority' value. Not using record syntax to define
-- this, in order to pretty up the derived 'Show' instance.
getPriority :: Priority m a -> Maybe a
getPriority (Priority a) = a

instance Functor (Priority m) where
fmap f (Priority ma) = Priority (fmap f ma)

----------------------------------------------------------------
-- | The smallest value for @Priority Max at .
minfinity :: Priority Max a
minfinity = Priority Nothing

instance Ord a => Ord (Priority Max a) where
Priority Nothing  `compare` Priority Nothing  = EQ
Priority Nothing  `compare` _                 = LT
_                 `compare` Priority Nothing  = GT
Priority (Just a) `compare` Priority (Just b) = a `compare` b

instance (Ord a) => Monoid (Priority Max a) where
mempty  = minfinity
mappend = max

----------------------------------------------------------------
-- | The largest value for @Priority Min at .
infinity :: Priority Min a
infinity = Priority Nothing

instance Ord a => Ord (Priority Min a) where
Priority Nothing  `compare` Priority Nothing  = EQ
Priority Nothing  `compare` _                 = GT
_                 `compare` Priority Nothing  = LT
Priority (Just a) `compare` Priority (Just b) = a `compare` b

instance (Ord a) => Monoid (Priority Min a) where
mempty  = infinity
mappend = min

----------------------------------------------------------------
-- | Coalesce the @Nothing@ of 'Priority' and the extreme bound of
-- 'Min'\/'Max'. This is helpful for maintaining sparse maps, where
-- absent keys are mapped to the extreme value.
class Prioritizable m where
toPriority   :: (Eq a, Bounded a) => m a -> Priority m a
fromPriority :: (Bounded a) => Priority m a -> m a

instance Prioritizable Max where
toPriority (Max a)
| a == minBound = Priority Nothing
| otherwise     = Priority (Just a)

fromPriority (Priority Nothing)  = Max minBound
fromPriority (Priority (Just a)) = Max a

instance Prioritizable Min where
toPriority (Min a)
| a == maxBound = Priority Nothing
| otherwise     = Priority (Just a)

fromPriority (Priority Nothing)  = Min maxBound
fromPriority (Priority (Just a)) = Min a

----------------------------------------------------------------
----------------------------------------------------------------
-- | A type for min-\/maximizing a function of type @(Ord b) => (a -> b)@.
-- When there are multiple arguments with the same min-\/maximum
-- value, 'mappend' returns the first one but the traversable
-- functions may return an arbitrary one depending on their order
-- of traversal. If the function is injective, then there can be
-- no confusion (i.e., we won't need to choose).
--
-- Technically, this type should also be annotated by the function
-- it min-\/maximizes, but that would require dependent types. Using
-- the monoid operations on values generated by different functions
-- will yield meaningless results.
newtype Arg (m :: * -> *) a b = Arg (Maybe (b,a))
-- N.B., we chose this order for the pair in order to
-- facilitate nested argmaxing
-- N.B., constructor isn't exported, for correctness.

-- | Constructor for an 'Arg' value. Using the monoid operations
-- on values generated by different functions will yield meaningless
-- results.
mkArg :: (Ord b) => (a -> b) -> a -> Arg m a b
mkArg f x = Arg (Just (f x, x))

-- | Monomorphized version of 'mkArg' for convenience.
mkArgMax :: (Ord b) => (a -> b) -> a -> Arg Max a b
mkArgMax = mkArg

-- | Monomorphized version of 'mkArg' for convenience.
mkArgMin :: (Ord b) => (a -> b) -> a -> Arg Min a b
mkArgMin = mkArg

-- | Destructor for 'Arg' returning both the argmin\/-max and the
-- min\/max. @Nothing@ represents min-\/maximization over the empty
-- set.
getArgWithValue :: Arg m a b -> Maybe (b,a)
getArgWithValue (Arg x) = x

-- | Destructor for 'Arg' returning only the argmin\/-max. @Nothing@
-- represents min-\/maximization over the empty set.
getArg :: Arg m a b -> Maybe a
getArg = fmap snd . getArgWithValue

instance (Ord b) => Monoid (Arg Max a b) where
mempty = Arg Nothing

mappend ma mb =
case ma of
Arg Nothing       -> mb
Arg (Just (fa,_)) ->
case mb of
Arg Nothing       -> ma
Arg (Just (fb,_)) -> if fa >= fb then ma else mb

instance (Ord b) => Monoid (Arg Min a b) where
mempty = Arg Nothing

mappend ma mb =
case ma of
Arg Nothing       -> mb
Arg (Just (fa,_)) ->
case mb of
Arg Nothing       -> ma
Arg (Just (fb,_)) -> if fa <= fb then ma else mb

----------------------------------------------------------------
-- | A type for min-\/maximizing a non-injective function of type
-- @(Ord b) => (a -> b)@. This variant of 'Arg' will return all
-- values that min-\/maximize the function. Using 'mappend' they
-- will be returned in order, but the traversable functions may
-- return them in an arbitrary order depending on the order of
-- traversal. Duplicates will be preserved regardless.
--
-- Technically, this type should also be annotated by the function
-- it min-\/maximizes, but that would require dependent types. Using
-- the monoid operations on values generated by different functions
-- will yield meaningless results.
newtype Args (m :: * -> *) a b = Args (Maybe (b,[a]))
-- N.B., constructor isn't exported, for correctness.

-- | Constructor for an 'Args' value. Using the monoid operations
-- on values generated by different functions will yield meaningless
-- results.
mkArgs :: (Ord b) => (a -> b) -> a -> Args m a b
mkArgs f x = Args (Just (f x, [x]))

-- | Monomorphized version of 'mkArgs' for convenience.
mkArgsMax :: (Ord b) => (a -> b) -> a -> Args Max a b
mkArgsMax = mkArgs

-- | Monomorphized version of 'mkArgs' for convenience.
mkArgsMin :: (Ord b) => (a -> b) -> a -> Args Min a b
mkArgsMin = mkArgs

-- | Destructor for 'Args' returning both the argmins\/-maxes and
-- the min\/max. @Nothing@ represents min-\/maximization over the
-- empty set.
getArgsWithValue :: Args m a b -> Maybe (b,[a])
getArgsWithValue (Args x) = x

-- | Destructor for 'Args' returning only the argmins\/-maxes. The
-- empty list represents min-\/maximization over the empty set.
getArgs :: Args m a b -> [a]
getArgs = maybe [] snd . getArgsWithValue

instance (Ord b) => Monoid (Args Max a b) where
mempty = Args Nothing

mappend ma mb =
case ma of
Args Nothing        -> mb
Args (Just (fa,as)) ->
case mb of
Args Nothing        -> ma
Args (Just (fb,bs)) ->
case compare fa fb of
GT -> ma
EQ -> Args (Just (fa, as++bs))
LT -> mb

instance (Ord b) => Monoid (Args Min a b) where
mempty = Args Nothing

mappend ma mb =
case ma of
Args Nothing        -> mb
Args (Just (fa,as)) ->
case mb of
Args Nothing        -> ma
Args (Just (fb,bs)) ->
case compare fa fb of
LT -> ma
EQ -> Args (Just (fa, as++bs))
GT -> mb

----------------------------------------------------------------
----------------------------------------------------------- fin.

--
Live well,
~wren

```