Maximum and Minimum monoids

[wren ng thornton]

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)
     deriving (Read, Show, Eq)

-- | 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