monoidplus (empty) → 0.1

raw patch · 3 files changed

+543/−0 lines, 3 filesdep +basedep +contravariantdep +semigroupssetup-changed

Dependencies added: base, contravariant, semigroups, transformers

Files

• Data/Monoid/Plus.lhs +526/−0
• Setup.hs +2/−0
• monoidplus.cabal +15/−0

@@ -0,0 +1,526 @@+% MonoidPlus and other classes
+% [Public domain]
+% version 0.1
+
+\input birdstyle
+
+\birdleftrule=1pt
+\emergencystretch=1em
+
+\def\hugebreak{\penalty-600\vskip 30pt plus 8pt minus 4pt\relax}
+\newcount\chapno
+\def\: #1.{\advance\chapno by 1\relax\hugebreak{\bf\S\the\chapno. #1. }}
+
+\: Introduction. This is program for related things about monoids. It also
+has a tyep for bounded numbers.
+
+> {-# LANGUAGE FlexibleInstances #-}
+
+Exports:
+
+> module Data.Monoid.Plus (
+>   module Data.Semigroup, MonoidPlus(..), Group(..), MonoidMinus(..),
+>   MonoidNorm(..), MonoidPlusNorm(..), Semiring, Ring, (|*|), (|/|),
+>   (|+|), (|-|), BoundFrac, fromBoundFrac, toBoundFrac,
+>   WrapMonoidPlus(..), CatEndo(..), Possibilistic(..), Lukasiewicz(..),
+>   monoidicMap, mpure, Prob, pChoose, pChoice, probNorm, uniform, probOf
+> ) where {
+
+Imports:
+
+> import Control.Applicative;
+> import Control.Category hiding (id, (.));
+> import qualified Control.Category as C;
+> import Control.Monad;
+> import Control.Monad.Trans.Writer;
+> import Data.Functor.Contravariant;
+> import Data.List;
+> import Data.Monoid;
+> import Data.Ord;
+> import Data.Semigroup hiding (First, Last, getFirst, getLast);
+
+\: Classes. Other than {\tt Monoid} and {\tt MonoidPlus}, here are some
+other related classes.
+
+This class is for monoids that have another monoid operation on them
+following specific laws.
+
+> class Monoid t => MonoidPlus t where {
+>   mpempty :: t;
+>   mpappend :: t -> t -> t;
+>   mpconcat :: [t] -> t;
+>   mpconcat = foldr mpappend mpempty;
+> };
+
+Instances should follow these laws:
+
+> {-
+>   mpappend mpempty x = x;
+>   mpappend x mpempty = x;
+>   mpappend x (mpappend y z) = mpappend (mpappend x y) z;
+>   mpconcat = foldr mpappend mpempty;
+>   mappend x (mpappend y z) = mpappend (mappend x y) (mappend x z);
+>   mappend (mpappend y z) x = mpappend (mappend y x) (mappend z x);
+> -}
+
+That is, it is a monoid that the original monoid is distributive over.
+
+This class is for groups. All groups are monoids, and each elements can
+be inversed.
+
+> class Monoid t => Group t where {
+>   minverse :: t -> t;
+> };
+
+Instances should follow these laws:
+
+> {-
+>   mappend x (minverse x) = mempty;
+>   mappend (minverse x) x = mempty;
+> -}
+
+The {\tt MonoidPlus} instances can also form a group, which here is called
+{\tt MonoidMinus}.
+
+> class MonoidPlus t => MonoidMinus t where {
+>   mpinverse :: t -> t;
+> };
+
+Instances should follow these laws:
+
+> {-
+>   mpappend x (mpinverse x) = mpempty;
+>   mpappend (mpinverse x) x = mpempty;
+> -}
+
+This class is for normalizable monoids; for example, a list of numbers
+normalized so that they add up to 1, such as with probabilities.
+
+> class Monoid t => MonoidNorm t where {
+>   mnormfunc :: [t] -> t -> t;
+>   mnormalize :: [t] -> [t];
+>   mnormalize x = mnormfunc x <$> x;
+> };
+
+Instances should follow these laws:
+
+> {-
+>   mnormalize x = mnormfunc x <$> x;
+>   mnormalize (mnormalize x) = mnormalize x;
+>   mconcat (mnormalize x) = mempty;
+>   shuffle (mnormalize x) = mnormalize (shuffle x);
+> -}
+
+for any possible bijective function {\tt shuffle :: [a] -> [a]}.
+
+Sometimes you want normalization over its distributive monoid.
+
+> class MonoidPlus t => MonoidPlusNorm t where {
+>   mpnormfunc :: [t] -> t -> t;
+>   mpnormalize :: [t] -> [t];
+>   mpnormalize x = mpnormfunc x <$> x;
+> };
+
+Instances should follow these laws:
+
+> {-
+>   mpnormalize x = mpnormfunc x <$> x;
+>   mpnormalize (mpnormalize x) = mpnormalize x;
+>   mpconcat (mpnormalize (x:y)) = mempty;
+>   shuffle (mpnormalize x) = mpnormalize (shuffle x);
+> -}
+
+Some {\tt MonoidPlus} instances are semirings. There are no additional
+class methods for semirings.
+
+> class MonoidPlus t => Semiring t;
+
+Instances should follow these laws:
+
+> {-
+>   mappend mpempty x = mpempty;
+>   mappend x mpempty = mpempty;
+>   mpappend x y = mpappend y x;
+> -}
+
+Some semirings are rings.
+
+> class (Semiring t, MonoidMinus t) => Ring t;
+
+There are no additional laws; they follow from the laws of the classes
+that are required to make this class.
+
+\: Bounded Fractions. Due to the use of bounded fractional numbers in some
+rings, here is a type for bounded fractions. The type is exported without
+its constructor; you can use it as a number.
+
+> newtype BoundFrac t = BoundFrac { fromBoundFrac :: t }
+>  deriving (Eq, Ord);
+
+> toBoundFrac :: (Num t, Ord t) => t -> BoundFrac t;
+> toBoundFrac x = if x < 0 || x > 1 then error "Out of bounds"
+>  else BoundFrac x;
+
+> instance Show t => Show (BoundFrac t) where {
+>   show (BoundFrac x) = show x;
+> };
+
+> instance (Enum t, Fractional t, Ord t) => Enum (BoundFrac t) where {
+>   toEnum 0 = BoundFrac 0.0;
+>   toEnum 1 = BoundFrac 1.0;
+>   toEnum _ = error "Out of bounds";
+>   fromEnum (BoundFrac 1.0) = 1;
+>   fromEnum _ = 0;
+> };
+
+Because it is bounded, it can have a {\tt Bounded} instance too.
+
+> instance (Enum t, Fractional t, Ord t)
+>  => Bounded (BoundFrac t) where {
+>   minBound = BoundFrac 0.0;
+>   maxBound = BoundFrac 1.0;
+> };
+
+All numeric operations must check that it is in bounds.
+
+> instance (Num t, Ord t) => Num (BoundFrac t) where {
+>   (BoundFrac x) + (BoundFrac y) = if x + y < 0 || x + y > 1 then
+>    error "Out of bounds" else BoundFrac (x + y);
+>   (BoundFrac x) - (BoundFrac y) = if x - y < 0 || x - y > 1 then
+>    error "Out of bounds" else BoundFrac (x - y);
+>   (BoundFrac x) * (BoundFrac y) = if x * y < 0 || x * y > 1 then
+>    error "Out of bounds" else BoundFrac (x * y);
+>   negate (BoundFrac 0) = BoundFrac 0;
+>   negate _ = error "Out of bounds";
+>   abs = id;
+>   signum (BoundFrac 0) = BoundFrac 0;
+>   signum _ = BoundFrac 1;
+>   fromInteger 0 = BoundFrac 0;
+>   fromInteger 1 = BoundFrac 1;
+>   fromInteger _ = error "Out of bounds";
+> };
+
+> instance (Fractional t, Ord t) => Fractional (BoundFrac t) where {
+>   (BoundFrac x) / (BoundFrac y) = if x / y < 0 || x / y > 1 then
+>    error "Out of bounds" else BoundFrac (x / y);
+>   fromRational x = if x < 0 || x > 1 then error "Out of bounds"
+>    else BoundFrac (fromRational x);
+> };
+
+> instance Real t => Real (BoundFrac t) where {
+>   toRational (BoundFrac x) = toRational x;
+> };
+
+> instance (Real t, Fractional t) => RealFrac (BoundFrac t) where {
+>   properFraction 1 = (1, 0);
+>   properFraction x = (0, x);
+> };
+
+\: New Monoid Types. Any {\tt MonoidPlus} forms its own monoid; there can
+be a wrapper type to make it able to do so.
+
+> newtype WrapMonoidPlus t = WrapMonoidPlus t deriving (Eq, Ord, Show);
+
+> instance MonoidPlus t => Monoid (WrapMonoidPlus t) where {
+>   mempty = WrapMonoidPlus mpempty;
+>   mappend (WrapMonoidPlus x) (WrapMonoidPlus y) = WrapMonoidPlus
+>    (mpappend x y);
+> };
+
+Endomorphisms of a category form a monoid (including the Kleisli category
+of a monad).
+
+> newtype CatEndo c t = CatEndo { runCatEndo :: c t t };
+
+> instance Category c => Monoid (CatEndo c t) where {
+>   mempty = CatEndo C.id;
+>   mappend (CatEndo x) (CatEndo y) = CatEndo $ x C.. y;
+> };
+
+One semiring of bounded numbers is possibilistic semiring.
+
+> newtype Possibilistic t = Possibilistic { getPossibilistic ::
+>  BoundFrac t } deriving (Eq, Ord, Show);
+
+> instance (Num t, Ord t) => Monoid (Possibilistic t) where {
+>   mempty = Possibilistic 1;
+>   mappend (Possibilistic x) (Possibilistic y) = Possibilistic (x * y);
+> };
+
+> instance (Num t, Ord t) => MonoidPlus (Possibilistic t) where {
+>   mpempty = Possibilistic 0;
+>   mpappend (Possibilistic x) (Possibilistic y) = Possibilistic $
+>    max x y;
+> };
+
+> instance (Num t, Ord t) => Semiring (Possibilistic t);
+
+It is also a normalizable semiring; everything is multiplied so that the
+max value will be 1.
+
+> instance (Fractional t, Ord t) => MonoidPlusNorm (Possibilistic t)
+>  where {
+>   mpnormfunc a (Possibilistic v) = if all (== Possibilistic 0) a then
+>    Possibilistic 1 else (Possibilistic . toBoundFrac $ recip
+>    (fromBoundFrac . getPossibilistic . last $ sort a) *
+>    fromBoundFrac v);
+> };
+
+Another semiring of bounded numbers is Lukasiewicz semiring.
+
+> newtype Lukasiewicz t = Lukasiewicz { getLukasiewicz :: BoundFrac t }
+>  deriving (Eq, Ord, Show);
+
+> instance (Num t, Ord t) => Monoid (Lukasiewicz t) where {
+>   mempty = Lukasiewicz 1;
+>   mappend (Lukasiewicz x) (Lukasiewicz y) = Lukasiewicz . toBoundFrac $
+>    max (fromBoundFrac x + fromBoundFrac y - 1) 0;
+> };
+
+> instance (Num t, Ord t) => MonoidPlus (Lukasiewicz t) where {
+>   mpempty = Lukasiewicz 1;
+>   mpappend (Lukasiewicz x) (Lukasiewicz y) = Lukasiewicz $ min x y;
+> };
+
+\: Instances. The unit type easily forms a group, and is distributive
+since it has only one possible value. It is also the trivial ring.
+
+> instance MonoidPlus () where {
+>   mpempty = ();
+>   mpappend = const $ const ();
+>   mpconcat = const ();
+> };
+
+> instance Group () where {
+>   minverse = id;
+> };
+
+> instance MonoidMinus () where {
+>   mpinverse = id;
+> };
+
+> instance MonoidNorm () where {
+>   mnormfunc = flip const;
+>   mnormalize = id;
+> };
+
+> instance MonoidPlusNorm () where {
+>   mpnormfunc = flip const;
+>   mpnormalize = id;
+> };
+
+> instance Semiring ();
+
+> instance Ring ();
+
+The distribution over addition is multiplication.
+
+> instance Num t => MonoidPlus (Product t) where {
+>   mpempty = Product 0;
+>   mpappend (Product x) (Product y) = Product $ x + y;
+> };
+
+The distribution over logical conjunction is disjunction, and vice versa.
+
+> instance MonoidPlus All where {
+>   mpempty = All False;
+>   mpappend (All x) (All y) = All (x || y);
+> };
+
+> instance MonoidPlus Any where {
+>   mpempty = Any True;
+>   mpappend (Any x) (Any y) = Any (x && y);
+> };
+
+It is also a semiring; the semiring laws are followed.
+
+> instance Semiring All;
+
+> instance Semiring Any;
+
+Subtraction is the inverse of addition.
+
+> instance Num t => Group (Sum t) where {
+>   minverse = Sum . negate . getSum;
+> };
+
+The minimum and maximum operations distribute over each other.
+
+> instance (Ord t, Bounded t) => MonoidPlus (Min t) where {
+>   mpempty = minBound;
+>   mpappend (Min x) (Min y) = Min $ max x y;
+> };
+
+> instance (Ord t, Bounded t) => MonoidPlus (Max t) where {
+>   mpempty = maxBound;
+>   mpappend (Max x) (Max y) = Max $ min x y;
+> };
+
+Fractional numbers can be normalized in addition and multiplication.
+
+> instance Fractional t => MonoidNorm (Sum t) where {
+>   mnormfunc a v = Sum $ getSum v - sum (getSum <$> a)
+>    / fromIntegral (length a);
+> };
+
+> instance Fractional t => MonoidPlusNorm (Product t) where {
+>   mpnormfunc a v = Product $ if sum (getProduct <$> a) == 0
+>    then 1 / fromIntegral (length a)
+>    else getProduct v / sum (getProduct <$> a);
+> };
+
+Most kinds of numbers form a ring.
+
+> instance Num t => MonoidMinus (Product t) where {
+>   mpinverse = Product . negate . getProduct;
+> };
+
+> instance Num t => Semiring (Product t);
+
+> instance Num t => Ring (Product t);
+
+There is a ring of sets. This kind of implementation is the same thing as
+a predicate, which is also a contravariant functor.
+
+> instance Monoid (Predicate t) where {
+>   mempty = Predicate $ const True;
+>   mappend (Predicate x) (Predicate y) = Predicate $ \z -> x z && y z;
+> };
+
+> instance MonoidPlus (Predicate t) where {
+>   mpempty = Predicate $ const False;
+>   mpappend (Predicate x) (Predicate y) = Predicate $ \z -> x z /= y z;
+> };
+
+> instance MonoidMinus (Predicate t) where {
+>   mpinverse = id;
+> };
+
+> instance Semiring (Predicate t);
+
+> instance Ring (Predicate t);
+
+Equivalences (also a contravariant functor) can form an Abelian group.
+
+> instance Eq t => Monoid (Equivalence t) where {
+>   mempty = Equivalence (==);
+>   mappend (Equivalence f) (Equivalence g) = Equivalence $ \x y ->
+>    (x == y) /= (f x y /= g x y);
+> };
+
+> instance Eq t => Group (Equivalence t) where {
+>   minverse = id;
+> };
+
+If you have multiple groups, their direct product is a group.
+
+> instance (Group a, Group b) => Group (a, b) where {
+>   minverse (a, b) = (minverse a, minverse b);
+> };
+
+> instance (Group a, Group b, Group c) => Group (a, b, c) where {
+>   minverse (a, b, c) = (minverse a, minverse b, minverse c);
+> };
+
+\: Operators. These are infix operator forms of the other functions.
+
+> (|*|) :: Monoid t => t -> t -> t;
+> (|*|) = mappend;
+> infixr 5 |*|;
+
+> (|/|) :: Group t => t -> t -> t;
+> x |/| y = mappend x (minverse y);
+> infixr 5 |/|;
+
+> (|+|) :: MonoidPlus t => t -> t -> t;
+> (|+|) = mpappend;
+> infixr 4 |+|;
+
+> (|-|) :: MonoidMinus t => t -> t -> t;
+> x |-| y = mpappend x (mpinverse y);
+> infixr 4 |-|;
+
+\: Monoidic Monads. Although there is applicative for pairs having a
+monoid type, it is not a monad instance. A monad instance can be made.
+
+> instance Monoid t => Monad ((,) t) where {
+>   return = pure;
+>   x >>= f = join $ fmap f x where {
+>     join :: Monoid t => (t, (t, u)) -> (t, u);
+>     join (x, (y, z)) = (x |*| y, z);
+>   };
+> };
+
+It can make a monad transformer, too. In fact this monad transformer is
+{\tt WriterT}. Here are some extra functions for its use.
+
+> monoidicMap :: Functor m => (x -> y) -> WriterT x m a -> WriterT y m a;
+> monoidicMap = mapWriterT . fmap . fmap;
+
+> mpure :: Applicative f => w -> t -> WriterT w f t;
+> mpure x y = WriterT $ pure (y, x);
+
+It can be used for probability distributions too, as long as the
+probabilities are any normalizable ring. (Note: All possible outputs on
+the right side of a bind (or all lists in a join) must have probabilities
+adding up to the same total!)
+
+> type Prob a b = WriterT a [] b;
+
+> pChoose :: Ring p => p -> t -> t -> Prob p t;
+> pChoose p x y = WriterT [(x, p), (y, mempty |-| p)];
+
+> pChoice :: Ring p => p -> Prob p t -> Prob p t -> Prob p t;
+> pChoice p x y = join $ pChoose p x y;
+
+This function will normalize the results so that the underlying list will
+be equal to any one representing the same probability distribution. It
+requires sorting, equality testing, etc.
+
+> probNorm :: (Semiring p, MonoidPlusNorm p, Eq p, Ord t) => Prob p t
+>  -> Prob p t;
+> probNorm = WriterT . uncurry zip . (\(l, r) -> (l, mpnormalize r))
+>  . unzip . filter ((/=) mpempty . snd) . map (\x -> (fst $ head x,
+>  mpconcat $ snd <$> x)) . groupBy (\x y -> fst x == fst y) . sortBy
+>  (comparing fst) . runWriterT;
+
+> uniform :: (Semiring p, MonoidPlusNorm p) => [t] -> Prob p t;
+> uniform x = WriterT $ (flip (,) $ mpnormfunc (mempty <$ x) mempty)
+>  <$> x;
+
+> probOf :: (Semiring p, MonoidPlusNorm p, Eq p)
+>  => (t -> Bool) -> Prob p t -> p;
+> probOf f x = case (runWriterT $ probNorm (f <$> x)) of {
+>   [_, (True, p)] -> p;
+>   [(True, p)] -> p;
+>   _ -> mpempty;
+> };
+
+%  [Monty Hall example]
+%> data Door = A | B | C deriving (Eq, Ord, Show);
+%> doors :: [Door];
+%> doors = [A, B, C];
+%> hide :: Prob (Product Double) Door;
+%> hide = uniform doors;
+%> pick :: Prob (Product Double) Door;
+%> pick = uniform doors;
+%> tease :: Door -> Door -> Prob (Product Double) Door;
+%> tease h p = uniform (doors \\ [h, p]);
+%> switch :: Door -> Door -> Prob (Product Double) Door;
+%> switch p t = return $ head (doors \\ [p, t]);
+%> stick :: Door -> Door -> Prob (Product Double) Door;
+%> stick p t = return p;
+%> play :: (Door -> Door -> Prob (Product Double) Door)
+%>  -> Prob (Product Double) Bool;
+%> play strategy = probNorm $ do {
+%>   h <- hide;
+%>   p <- pick;
+%>   t <- tease h p;
+%>   s <- strategy p t;
+%>   return (s == h);
+%> };
+
+% End of document (final "}" is suppressed from printout)
+\toks0={{
+
+> } -- }\bye

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

@@ -0,0 +1,15 @@+Name:                monoidplus
+Version:             0.1
+Synopsis:            Extra classes/functions about monoids
+License:             PublicDomain
+Category:            Data, Math
+Build-type:          Simple
+Cabal-version:       >=1.6
+
+X-Printout-Mode:     PlainTeX
+X-Printout-Main:     Data/Monoid/Plus.lhs
+X-Printout-Require:  birdstyle.tex
+
+Library
+  Exposed-modules:     Data.Monoid.Plus
+  Build-depends:       base == 4.*, transformers, semigroups, contravariant