### Re: Maximum and Minimum monoids

wren ng thornton <wren <at> freegeek.org>

2012-12-28 04:19:41 GMT

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 <at> ('max','minBound') <at>
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 <at> ('min','maxBound') <at>
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 <at> Nothing <at> 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 <at> 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 <at> 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 <at> Nothing <at> 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 <at> (Ord b) => (a -> b) <at> .
-- 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. <at> Nothing <at> 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. <at> Nothing <at>
-- 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
-- <at> (Ord b) => (a -> b) <at> . 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. <at> Nothing <at> 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