For example:
Maybe (Maybe Bool) -> Maybe Bool
Just (Just True) -----> Just True
Just (Just False) ----> Just False
Just (Nothing) -------> Nothing
Nothing --------------> ?
It would map Nothing to Nothing. What is the mathematical theory or theorem underlying it?
If related to category theory, what part is it related to?
Is there a mathematical theory related to the Behavior of join of State, Writer, Reader, etc?
Is there any guarantee that m(m a) -> m a is safe?
edited:
Since result type a of m a -> a forgets the structure. so instead in order not to forget, result type m a of m (m a) -> m a is used for the compound effect of outer - m (...) with effect of inner - m.
Strictly speaking, two information(effect) was compounded into one only before the structure disappeared. The structure no longer exists.
I thought it was important to guarantee that there was no problem in doing so. Is it up to the programmer without any special rules or theory?
The compound doesn't look natural to me, it looks artificial.
Sorry for the vague question, thanks for all the comments.
The Mathematical definition of a monad, with translation to Haskell:
A couple of incidental preliminary notes
I'm going to assume you're familiar with Functors in Haskell. If not I'm tempted to direct you to my explanation on this other question here. I'm not going to explain category theory to you except by translating it into Haskell as best I can.
Identity functor vs Identity Functor instance.
Note: Firstly let me point out that the identity functor in mathematics does nothing, whereas the Identity functor in Haskell adds a newtype wrapper. Whenever we use the mathematical identity functor on a type a we should just get a back, so I won't be using the Identity functor instance.
Natural transformations
Secondly, note that a natural transformation between two functors (either possibly the identity), in Haskell is a polymorphic function e between two types made by (possibly mathematical identity) Functor instances, for example [a] -> Maybe a or (Int,a) -> Either String a such that e . fmap f == fmap f . e.
So safeLast : [a] -> Maybe a is a natural transformation, because safeLast (map f xs) == fmap f (safeLast xs), and even
rejectSomeSmallNumbers :: (Int,a) -> Either String a
rejectSomeSmallNumbers (i,a) = case i of
0 -> Left "Way too small!"
1 -> Left "Too small!"
2 -> Left "Two is small."
3 -> Left "Three is small, too."
_ -> Right a
is a natural transformation because rejectSomeSmallNumbers . fmap f == fmap f . rejectSomeSmallNumbers :: (Int,a) -> Either String b.
A natural transformation can use as much information as it likes about the two functors it connects (eg (,) Int and Either String) but it can't use any information about the type a any more than the functors can. It shouldn't be possible to write a polymorphic function between two valid functor types that's not a natural transformation. See this answer for more information.
What is a monad according to Maths and Haskell?
Let H be a category (let Hask be the kind of all haskell types together with function types, functions, etc etc).
A monad on H is (a monad in Hask is)
an endofunctor M : H -> H
a type constructor m: * -> * which has a Functor instance with fmap :: (a -> b) -> (m a -> m b)
and a natural transformation eta : 1_H -> M
a polymorphic function from a -> m a, called pure defined in the Applicative instance
a natural transformation mu : M^2 -> M
a polymorphic function from m (m a) -> m a, called join that is defined in Control.Monad
such that the following two rules hold:
mu . M mu == mu . mu M as natural transformations M^3 -> M
join . fmap join == join . join :: m (m (m a)) -> m a
mu . M eta == mu . eta M == 1_H as natural transformations M -> M
join . fmap pure == join . pure == id :: m a -> m a
What do these two rules mean?
Just to give you a handle on what these two conditions are saying, here they are when we're using lists:
(join . fmap join) [xss, yss, zss]
== join [join xss, join yss, join zss]
== join (join [xss, yss, zss])
and
join (fmap pure xs)
== join [[x] | x <- xs]
== xs
== id xs
== join [xs]
== join (pure xs)
(Fun fact, join isn't part of the monad definition. I have a perhaps unreliable memory that it used to be, but in Control.Monad it's defined as join x = x >>= id and as commented there, it could be defined as join bss = do { bs <- bss ; bs })
What does this mean for the Maybe monad in your example?
Well firstly, because join is polymorphic (mu is a natural transformation), it can't use any information about the type a in Maybe a, so we couldn't for example make it so that join (Just (Just False)) = Just True or join (Just Nothing) = Just False because we can only use values that are already in the Maybe a we're given:
join :: Maybe (Maybe a) -> Maybe a
join Nothing = Nothing -- can't provide Just a because we have no a
join (Just Nothing) = Nothing -- same reason
join (Just (Just a)) =
-- two choices: we could do the obviously correct `Just a` or collapse everything with `Nothing`.
pure :: a -> Maybe a
pure a =
-- two choices: we could do the obviously correct `Just a` or collapse everything with `Nothing`.
What stops us doing the crazy Nothing thing?
Let's look at the two rules, specialising to Maybe, and to the Just branches, because all the Nothings are inevitably Nothing because of polymorphism.
(join . fmap join) (Just maybemaybe)
== join (Just (join maybemaybe))
== join (join (Just maybemaybe)) -- required by he rule
That one works if we put Just a in the definition, or if we put Nothing, too.
In the second rule:
join (fmap pure (Just a))
== join (Just (pure a))
== join (pure (Just a))
== id (Just a) -- by the rule
== Just a
Well that forces pure to be Just, and at the same time forces join (Just (Just a)) to give us Just a.
Reader
Let's ditch the newtype wrapping to make the laws easier to talk about.
type Reader input a = input -> a
We'd need
join :: Reader input (Reader input a) -> Reader input a
join (make_an_a_maker :: (input -> (input -> a)) :: input -> a
join make_an_a_maker input = (make_an_a_maker input) input
There isn't anything else we can do without using undefined or similar.
So what stops you making crazy join functions?
Most of the time, the fact that you're making a polymorphic function, some of the time because you want to do the obviously correct thing and it works, and the rest of the time because you chose to follow the rules.
Not-relevant nerd note:
I prefer to think of Monads as type constructors m so that Kleisli composition is associative, with the unit being pure:
(>=>) :: (a -> m b)
-> ( b -> m c)
-> (a -> m c)
(first >=> second) a = do
b <- first a
c <- second b
return c
or if you prefer
(first >=> second) a =
first a >>= \b -> second b
so the laws are
(one >=> two) >=> three == one >=> (two >=> three) and
k >=> pure == pure >=> k == k
I think your confusion is over the fact that Nothing is not a single value. It is a polymorphic type that can be specialized to any number of values, depending on how a is fixed:
> :set -XTypeApplications
> :t Nothing
Nothing :: Maybe a
> :t Nothing #Int
Nothing #Int :: Maybe Int
> :t Nothing #Bool
Nothing #Bool :: Maybe Bool
> :t Nothing #(Maybe Bool)
Nothing #(Maybe Bool) :: Maybe (Maybe Bool)
Similarly, join :: Monad m => m (m a) -> m a can be specialized:
> :t join #Maybe
join #Maybe :: Maybe (Maybe a) -> Maybe a
> :t join #Maybe #Bool
join #Maybe #Bool :: Maybe (Maybe Bool) -> Maybe Bool
Maybe (Maybe Bool) has four values:
Just (Just True)
Just (Just False)
Just Nothing
Nothing
Maybe Bool has three values:
Just True
Just False
Nothing
join :: Maybe (Maybe Bool) is not a injection; it maps two different values of type Maybe (Maybe Bool) to the same value of type Maybe Bool:
join (Just (Just True)) == Just True
join (Just (Just False)) == Just False
join (Just Nothing) == Nothing
join Nothing == Nothing
Both Just Nothing :: Maybe (Maybe Bool) and Nothing :: Maybe (Maybe Bool) are mapped to Nothing :: Maybe Bool.
When learning the Reader Monad, I find that it is defined as:
newtype Reader r a = Reader { runReader :: r -> a }
instance Monad (Reader r) where
return a = Reader $ \_ -> a
m >>= k = Reader $ \r -> runReader (k (runReader m r)) r
I want to known why using function as constructor parameter instead of something else such as a tuple:
newtype Reader r a = Reader { runReader :: (r, a) }
instance Monad (Reader r) where
-- Here I cannot get r when defining return function,
-- so does that's the reason that must using a function whose input is an "r"?
return a = Reader (r_unknown, a)
m >>= k = Reader (fst $ runReader m) (f (snd $ runReader m))
According to the Reader definition, we need a "environment" which we can use to generate a "value". I think a Reader type should contain the information of "environment" and "value", so the tuple seems perfect.
You didn't mention it in the question, but I guess you thought specifically of using a pair for defining Reader because it also makes sense to think of that as a way of providing a fixed environment. Let's say we have an earlier result in the Reader monad:
return 2 :: Reader Integer Integer
We can use this result to do further calculations with the fixed environment (and the Monad methods guarantee it remains fixed throughout the chain of (>>=)):
GHCi> runReader (return 2 >>= \x -> Reader (\r -> x + r)) 3
5
(If you substitute the definitions of return, (>>=) and runReader in the expression above and simplify it, you will see exactly how it reduces to 2 + 3.)
Now, let's follow your suggestion and define:
newtype Env r a = Env { runEnv :: (r, a) }
If we have an environment of type r and a previous result of type a, we can make an Env r a out of them...
Env (3, 2) :: Env Integer Integer
... and we can also get a new result from that:
GHCi> (\(r, x) -> x + r) . runEnv $ Env (3, 2)
5
The question, then, is whether we can capture this pattern through the Monad interface. The answer is no. While there is a Monad instance for pairs, it does something quite different:
newtype Writer r a = Writer { Writer :: (r, a) }
instance Monoid r => Monad (Writer r) where
return x = (mempty, x)
m >>= f = Writer
. (\(r, x) -> (\(s, y) -> (mappend r s, y)) $ f x)
$ runWriter m
The Monoid constraint is needed so that we can use mempty (which solves the problem that you noticed of having to create a r_unknown out of nowhere) and mappend (which makes it possible to combine the first elements of the pair in a way that doesn't violate the monad laws). This Monad instance, however, does something very different than what the Reader one does. The first element of the pair isn't fixed (it is subject to change, as we mappend other generated values to it) and we don't use it to compute the second element of the pair (in the definition above, y does not depend neither on r nor on s). Writer is a logger; the r values here are output, not input.
There is one way, however, in which your intuition is justified: we can't make a reader-like monad using a pair, but we can make a reader-like comonad. To put it very loosely, Comonad is what you get when you turn the Monad interface upside down:
-- This is slightly different than what you'll find in Control.Comonad,
-- but it boils down to the same thing.
class Comonad w where
extract :: w a -> a -- compare with return
(=>>) :: w a -> (w a -> b) -> w b -- compare with (>>=)
We can give the Env we had abandoned a Comonad instance:
newtype Env r a = Env { runEnv :: (r, a) }
instance Comonad (Env r) where
extract (Env (_, x)) = x
w#(Env (r, _)) =>> f = Env (r, f w)
That allows us to write the 2 + 3 example from the beginning in terms of (=>>):
GHCi> runEnv $ Env (3, 2) =>> ((\(r, x) -> x + r) . runEnv)
(3,5)
One way to see why this works is noting that an a -> Reader r b function (i.e. what you give to Reader's (>>=)) is essentially the same thing that an Env r a -> b one (i.e. what you give to Env's (=>>)):
a -> Reader r b
a -> (r -> b) -- Unwrap the Reader result
r -> (a -> b) -- Flip the function
(r, a) -> b -- Uncurry the function
Env r a -> b -- Wrap the argument pair
As further evidence of that, here is a function that changes one into the other:
GHCi> :t \f -> \w -> (\(r, x) -> runReader (f x) r) $ runEnv w
\f -> \w -> (\(r, x) -> runReader (f x) r) $ runEnv w
:: (t -> Reader r a) -> Env r t -> a
GHCi> -- Or, equivalently:
GHCi> :t \f -> uncurry (flip (runReader . f)) . runEnv
\f -> uncurry (flip (runReader . f)) . runEnv
:: (a -> Reader r c) -> Env r a -> c
To wrap things up, here is a slightly longer example, with Reader and Env versions side-by-side:
GHCi> :{
GHCi| flip runReader 3 $
GHCi| return 2 >>= \x ->
GHCi| Reader (\r -> x ^ r) >>= \y ->
GHCi| Reader (\r -> y - r)
GHCi| :}
5
GHCi> :{
GHCi| extract $
GHCi| Env (3, 2) =>> (\w ->
GHCi| (\(r, x) -> x ^ r) $ runEnv w) =>> (\z ->
GHCi| (\(r, x) -> x - r) $ runEnv z)
GHCi| :}
5
First of all note that your bind function is wrong and would not compile.
If the Reader were defined as you describe with a tuple, there would be problems:
The monad laws would be violated, e.g. left identity, which states that:
return a >>= f == f a
or the right identity:
m >>= return == m
would be broken, depending on the implmentation of >>= because >>= would forget either the first tuple element of the first argument or the second, i.e. if the implmentation would be:
(Reader (mr, mv)) >>= f =
let (Reader (fr, fv)) = f mv
in Reader (mr, fv)
then we would always lose the reader value that comes out of f (aka fr) and otherwise if >>= would be
(Reader (mr, mv)) >>= f =
let (Reader (fr, fv)) = f mv
in Reader (fr, fv)
-- ^^^ tiny difference here ;)
we would always lose mr.
A Reader is some action, that may ask for a constant value, which cannot be changed by another monadic action, which is read-only.
But when defined with a tuple, we could super-easy overwrite the reader value, e.g. whith this function:
tell :: x -> BadReader x ()
tell x = BadReader (x, ())
If a reader is instead defined with a function, this is impossible (try it)
Also, that enviroment is actually not required before converting a Reader to a pure value (aka running the Reader), so from this alone it makes sense to use a function instead of a tuple.
When using a tuple, we would have to provide the Reader value even before we actually run an action.
You can see that in your return definition, you even point out the problem, where the r_unknown comes from ...
To get a btter intuition, let's assume a Reader action that returns the Persons with a certain age from the Addressbook:
data Person = MkPerson {name :: String, age :: Int}
type Addressbook = [Person]
personsWithThisAge :: Int -> Reader Addressbook [Person]
personsWithThisAge a = do
addressbook <- ask
return (filter (\p -> age p == a) addressbook)
This personsWithAge function returns a Reader action and since it only asks for the Addressbook, it is like a function that accepts an addressbook and gives back a [Person] list,
so it is natural to define a reader as just that, a function from some input to a result.
We could rewrite this Reader action to be a function of the Addressbook like this:
personsWithThisAgeFun :: Int -> Addressbook -> [Person]
personsWithThisAgeFun a addressbook =
filter (\p -> age p == a) addressbook
But why invent Reader??
The real value of Reader shows when combining several functions like e.g. personsWithThisAge, that all depend on (the same) one constant Addressbook.
Using a Reader we don't have to explicitly pass some Addressbook around, individual Reader actions don't even have any way at all to modify the Addressbook - Reader guarantees us, that every action uses the same, unmodified Addressbook, and all a Reader action can ever to with the environment is ask for it.
The only way to implement this, with these guarantees is with a function.
Also if you look at the monad instances that are included in the standard library, you will see that (r ->) is a monad; actually it is identical to the Reader monad apart from some technical differences.
Now the structure you describe with the tuple is actually pretty close to a Writer monad, what is write-only , but that's out of scope.
A function for determine if a string is a palindrome can be implemented in a pointfree applicative manner via
pal1 = (==) <$> reverse <*> id
And here is a monadic version
reverse >>= (==)
How does the modadic version work with no explicit call to id? I attempted to view the poinful representation using pointful and get back the same function.
This works using the fact that x -> y can be regarded as a kind of "reader monad". If we were to say
type Reader r x = r -> x
then we have an instance of Monad (Reader r). So we can see that
reverse :: [x] -> [x]
is actually
reverse :: Reader [x] [x]
Similarly,
(==) :: [x] -> [x] -> Bool
can be written as
(==) :: [x] -> Reader [x] Bool
Then (>>=) joins the two together.
So... We start with reverse, which is a Reader action that reads a list and returns a list. We then use >>= to pass that to ==, which is a function that takes a list, and returns a Reader [x] Bool.
In short, the input list is duplicated by the action of Reader, which basically takes an input and passes it to every function in the chain. (That's what the reader monad is.)
I hope that made some kind of sense... It took me a while to figure out!
Let's have a look at the Monad instance for ((->) r):
instance Monad ((->) r) where
return = const
f >>= k = \ r -> k (f r) r
and then simply fill in your monadic code:
reverse >>= (==) = \r -> (==) (reverse r) r
which we can write in a more familiar way:
\r -> reverse r == r
To add to other answers, here is another POV on this. Let's take a definition of bind via fmap and join:
m >>= act = join (fmap act m)
The expression (==) <$> reverse has type Eq a => [a] -> [a] -> Bool and is equivalent to fmap (==) reverse. Now, we pass it to join :: m (m a) -> m a and for (->) r monad instance the type would be ([a] -> [a] -> Bool) -> ([a] -> Bool). That is, join is exactly <*> id part.
I think the easiest way to understand this is by looking at the types:
(>>=) :: Monad m => m a -> (a -> m b) -> m b
specialized to the ((->) r) instance:
(>>=) :: (r -> a) -> (a -> r -> b) -> r -> b
You are not given an a. The only way to produce one is to apply the first function r -> a to the r you are given. The only way to produce a b is to apply the second function to the r and the a you just produced. This means the only possible definition for this function* is:
f >>= g = \a -> g (f a) a
Plugging our arguments in, we get:
reverse >>= (==)
-- definition of (>>=)
= \a -> (==) (reverse a) a
-- prefix to infix
= \a -> reverse a == a
Parametricity is a powerful tool for reasoning about polymorphic functions.
* other than bottom
The other answers confirm that the two behave the same, but don't explain where the id actually went. In this answer, I will attempt to do so. The punchline is that, for Reader, we have a curious id-removing equation: id >>= return . f = f. (A more beautiful form of this equation is that (id >>=) = (>>= id); together with the monad laws the beautiful form implies the easily-usable form.) To make the explanation a bit simpler, instead of trying to convert from applicative form to monadic form, I will just take it for granted that you believe the following equation:
(==) <$> reverse <*> id
= { too annoying to do carefully }
reverse >>= \xs -> id >>= \ys -> return ((==) xs ys)
So we will start from that last line, and end at reverse >>= (==). Along the way, it will be key to observe that id is the identity for (.) -- which just so happens to be fmap for the Reader monad. Here we go:
reverse >>= \xs -> id >>= \ys -> return ((==) xs ys)
= { monad law }
reverse >>= \xs -> fmap ((==) xs) id
= { definition of fmap for Reader }
reverse >>= \xs -> (.) ((==) xs) id
= { id is the identity of fmap }
reverse >>= \xs -> (==) xs
= { eta reduction }
reverse >>= (==)
So what is the meaning of id >>= return . f = f? Well, treating functions as "indexed values", we can understand id as being the value that equals its index; and return as being the value that is the same everywhere. So id >>= return . f says "look at index x; then, (still at index x), return the value that ignores its index and has value f x". It just so happens that the index we ignore and the value we hand to f match up -- so we might as well skip all that indirection and simply say "look at index x and apply f to it". This is the meaning of the equation.
Set, similarly to [] has a perfectly defined monadic operations. The problem is that they require that the values satisfy Ord constraint, and so it's impossible to define return and >>= without any constraints. The same problem applies to many other data structures that require some kind of constraints on possible values.
The standard trick (suggested to me in a haskell-cafe post) is to wrap Set into the continuation monad. ContT doesn't care if the underlying type functor has any constraints. The constraints become only needed when wrapping/unwrapping Sets into/from continuations:
import Control.Monad.Cont
import Data.Foldable (foldrM)
import Data.Set
setReturn :: a -> Set a
setReturn = singleton
setBind :: (Ord b) => Set a -> (a -> Set b) -> Set b
setBind set f = foldl' (\s -> union s . f) empty set
type SetM r a = ContT r Set a
fromSet :: (Ord r) => Set a -> SetM r a
fromSet = ContT . setBind
toSet :: SetM r r -> Set r
toSet c = runContT c setReturn
This works as needed. For example, we can simulate a non-deterministic function that either increases its argument by 1 or leaves it intact:
step :: (Ord r) => Int -> SetM r Int
step i = fromSet $ fromList [i, i + 1]
-- repeated application of step:
stepN :: Int -> Int -> Set Int
stepN times start = toSet $ foldrM ($) start (replicate times step)
Indeed, stepN 5 0 yields fromList [0,1,2,3,4,5]. If we used [] monad instead, we would get
[0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5]
instead.
The problem is efficiency. If we call stepN 20 0 the output takes a few seconds and stepN 30 0 doesn't finish within a reasonable amount of time. It turns out that all Set.union operations are performed at the end, instead of performing them after each monadic computation. The result is that exponentially many Sets are constructed and unioned only at the end, which is unacceptable for most tasks.
Is there any way around it, to make this construction efficient? I tried but without success.
(I even suspect that there could be some kinds of theoretical limits following from Curry-Howard isomorphism and Glivenko's theorem. Glivenko's theorem says that for any propositional tautology φ the formula ¬¬φ can be proved in intuitionistic logic. However, I suspect that the length of the proof (in normal form) can be exponentially long. So, perhaps, there could be cases when wrapping a computation into the continuation monad will make it exponentially longer?)
Monads are one particular way of structuring and sequencing computations. The bind of a monad cannot magically restructure your computation so as to happen in a more efficient way. There are two problems with the way you structure your computation.
When evaluating stepN 20 0, the result of step 0 will be computed 20 times. This is because each step of the computation produces 0 as one alternative, which is then fed to the next step, which also produces 0 as alternative, and so on...
Perhaps a bit of memoization here can help.
A much bigger problem is the effect of ContT on the structure of your computation. With a bit of equational reasoning, expanding out the result of replicate 20 step, the definition of foldrM and simplifying as many times as necessary, we can see that stepN 20 0 is equivalent to:
(...(return 0 >>= step) >>= step) >>= step) >>= ...)
All parentheses of this expression associate to the left. That's great, because it means that the RHS of each occurrence of (>>=) is an elementary computation, namely step, rather than a composed one. However, zooming in on the definition of (>>=) for ContT,
m >>= k = ContT $ \c -> runContT m (\a -> runContT (k a) c)
we see that when evaluating a chain of (>>=) associating to the left, each bind will push a new computation onto the current continuation c. To illustrate what is going on, we can use again a bit of equational reasoning, expanding out this definition for (>>=) and the definition for runContT, and simplifying, yielding:
setReturn 0 `setBind`
(\x1 -> step x1 `setBind`
(\x2 -> step x2 `setBind` (\x3 -> ...)...)
Now, for each occurrence of setBind, let's ask ourselves what the RHS argument is. For the leftmost occurrence, the RHS argument is the whole rest of the computation after setReturn 0. For the second occurrence, it's everything after step x1, etc. Let's zoom in to the definition of setBind:
setBind set f = foldl' (\s -> union s . f) empty set
Here f represents all the rest of the computation, everything on the right hand side of an occurrence of setBind. That means that at each step, we are capturing the rest of the computation as f, and applying f as many times as there are elements in set. The computations are not elementary as before, but rather composed, and these computations will be duplicated many times.
The crux of the problem is that the ContT monad transformer is transforming the initial structure of the computation, which you meant as a left associative chain of setBind's, into a computation with a different structure, ie a right associative chain. This is after all perfectly fine, because one of the monad laws says that, for every m, f and g we have
(m >>= f) >>= g = m >>= (\x -> f x >>= g)
However, the monad laws do not impose that the complexity remain the same on each side of the equations of each law. And indeed, in this case, the left associative way of structuring this computation is a lot more efficient. The left associative chain of setBind's evaluates in no time, because only elementary subcomputations are duplicated.
It turns out that other solutions shoehorning Set into a monad also suffer from the same problem. In particular, the set-monad package, yields similar runtimes. The reason being, that it too, rewrites left associative expressions into right associative ones.
I think you have put the finger on a very important yet rather subtle problem with insisting that Set obeys a Monad interface. And I don't think it can be solved. The problem is that the type of the bind of a monad needs to be
(>>=) :: m a -> (a -> m b) -> m b
ie no class constraint allowed on either a or b. That means that we cannot nest binds on the left, without first invoking the monad laws to rewrite into a right associative chain. Here's why: given (m >>= f) >>= g, the type of the computation (m >>= f) is of the form m b. A value of the computation (m >>= f) is of type b. But because we can't hang any class constraint onto the type variable b, we can't know that the value we got satisfies an Ord constraint, and therefore cannot use this value as the element of a set on which we want to be able to compute union's.
Recently on Haskell Cafe Oleg gave an example how to implement the Set monad efficiently. Quoting:
... And yet, the efficient genuine Set monad is possible.
...
Enclosed is the efficient genuine Set monad. I wrote it in direct style (it seems to be faster, anyway). The key is to use the optimized choose function when we can.
{-# LANGUAGE GADTs, TypeSynonymInstances, FlexibleInstances #-}
module SetMonadOpt where
import qualified Data.Set as S
import Control.Monad
data SetMonad a where
SMOrd :: Ord a => S.Set a -> SetMonad a
SMAny :: [a] -> SetMonad a
instance Monad SetMonad where
return x = SMAny [x]
m >>= f = collect . map f $ toList m
toList :: SetMonad a -> [a]
toList (SMOrd x) = S.toList x
toList (SMAny x) = x
collect :: [SetMonad a] -> SetMonad a
collect [] = SMAny []
collect [x] = x
collect ((SMOrd x):t) = case collect t of
SMOrd y -> SMOrd (S.union x y)
SMAny y -> SMOrd (S.union x (S.fromList y))
collect ((SMAny x):t) = case collect t of
SMOrd y -> SMOrd (S.union y (S.fromList x))
SMAny y -> SMAny (x ++ y)
runSet :: Ord a => SetMonad a -> S.Set a
runSet (SMOrd x) = x
runSet (SMAny x) = S.fromList x
instance MonadPlus SetMonad where
mzero = SMAny []
mplus (SMAny x) (SMAny y) = SMAny (x ++ y)
mplus (SMAny x) (SMOrd y) = SMOrd (S.union y (S.fromList x))
mplus (SMOrd x) (SMAny y) = SMOrd (S.union x (S.fromList y))
mplus (SMOrd x) (SMOrd y) = SMOrd (S.union x y)
choose :: MonadPlus m => [a] -> m a
choose = msum . map return
test1 = runSet (do
n1 <- choose [1..5]
n2 <- choose [1..5]
let n = n1 + n2
guard $ n < 7
return n)
-- fromList [2,3,4,5,6]
-- Values to choose from might be higher-order or actions
test1' = runSet (do
n1 <- choose . map return $ [1..5]
n2 <- choose . map return $ [1..5]
n <- liftM2 (+) n1 n2
guard $ n < 7
return n)
-- fromList [2,3,4,5,6]
test2 = runSet (do
i <- choose [1..10]
j <- choose [1..10]
k <- choose [1..10]
guard $ i*i + j*j == k * k
return (i,j,k))
-- fromList [(3,4,5),(4,3,5),(6,8,10),(8,6,10)]
test3 = runSet (do
i <- choose [1..10]
j <- choose [1..10]
k <- choose [1..10]
guard $ i*i + j*j == k * k
return k)
-- fromList [5,10]
-- Test by Petr Pudlak
-- First, general, unoptimal case
step :: (MonadPlus m) => Int -> m Int
step i = choose [i, i + 1]
-- repeated application of step on 0:
stepN :: Int -> S.Set Int
stepN = runSet . f
where
f 0 = return 0
f n = f (n-1) >>= step
-- it works, but clearly exponential
{-
*SetMonad> stepN 14
fromList [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14]
(0.09 secs, 31465384 bytes)
*SetMonad> stepN 15
fromList [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]
(0.18 secs, 62421208 bytes)
*SetMonad> stepN 16
fromList [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16]
(0.35 secs, 124876704 bytes)
-}
-- And now the optimization
chooseOrd :: Ord a => [a] -> SetMonad a
chooseOrd x = SMOrd (S.fromList x)
stepOpt :: Int -> SetMonad Int
stepOpt i = chooseOrd [i, i + 1]
-- repeated application of step on 0:
stepNOpt :: Int -> S.Set Int
stepNOpt = runSet . f
where
f 0 = return 0
f n = f (n-1) >>= stepOpt
{-
stepNOpt 14
fromList [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14]
(0.00 secs, 515792 bytes)
stepNOpt 15
fromList [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]
(0.00 secs, 515680 bytes)
stepNOpt 16
fromList [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16]
(0.00 secs, 515656 bytes)
stepNOpt 30
fromList [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30]
(0.00 secs, 1068856 bytes)
-}
I don't think your performance problems in this case are due to the use of Cont
step' :: Int -> Set Int
step' i = fromList [i,i + 1]
foldrM' f z0 xs = Prelude.foldl f' setReturn xs z0
where f' k x z = f x z `setBind` k
stepN' :: Int -> Int -> Set Int
stepN' times start = foldrM' ($) start (replicate times step')
gets similar performance to the Cont based implementation but occurs entirely in the Set "restricted monad"
I am not sure if I believe your claim about Glivenko's theorem leading to exponential increase in (normalized) proof size--at least in the Call-By-Need context. That is because we can arbitrarily reuse subproofs (and our logic is second order, we need only a single proof of forall a. ~~(a \/ ~a)). Proofs are not trees, they are graphs (sharing).
In general, you are likely to see performance costs from Cont wrapping Set but they can usually be avoided via
smash :: (Ord r, Ord k) => SetM r r -> SetM k r
smash = fromSet . toSet
I found out another possibility, based on GHC's ConstraintKinds extension. The idea is to redefine Monad so that it includes a parametric constraint on allowed values:
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RebindableSyntax #-}
import qualified Data.Foldable as F
import qualified Data.Set as S
import Prelude hiding (Monad(..), Functor(..))
class CFunctor m where
-- Each instance defines a constraint it valust must satisfy:
type Constraint m a
-- The default is no constraints.
type Constraint m a = ()
fmap :: (Constraint m a, Constraint m b) => (a -> b) -> (m a -> m b)
class CFunctor m => CMonad (m :: * -> *) where
return :: (Constraint m a) => a -> m a
(>>=) :: (Constraint m a, Constraint m b) => m a -> (a -> m b) -> m b
fail :: String -> m a
fail = error
-- [] instance
instance CFunctor [] where
fmap = map
instance CMonad [] where
return = (: [])
(>>=) = flip concatMap
-- Set instance
instance CFunctor S.Set where
-- Sets need Ord.
type Constraint S.Set a = Ord a
fmap = S.map
instance CMonad S.Set where
return = S.singleton
(>>=) = flip F.foldMap
-- Example:
-- prints fromList [3,4,5]
main = print $ do
x <- S.fromList [1,2]
y <- S.fromList [2,3]
return $ x + y
(The problem with this approach is in the case the monadic values are functions, such as m (a -> b), because they can't satisfy constraints like Ord (a -> b). So one can't use combinators like <*> (or ap) for this constrained Set monad.)