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