List Monads and non-determinism

Hi All, I thought I'd have a go at destructing [1,2] >>= \n -> [3,4] >>= \m -> return (n,m) which results in [(1,3)(1,4),(2,3),(2,4)] I started by putting brackets in ([1,2] >>= \n -> [3,4]) >>= \m -> return (n,m) This immediately fails when evaluated: I expect it's something to do with the n value now not being seen by the final return. It seems to me that the return function is doing something more than it's definition (return x = [x]). If ignore the error introduced by the brackets I have and continue to simplify I get. [3,4,3,4] >>= \m -> return (n,m) Now this obviously won't work as there is no 'n' value. So what's happening here? Return seems to be doing way more work than lifting the result to a list, how does Haskell know to do this? Why's it not in the function definition? Are lists somehow a special case? Any pointers appreciated. Cheers, -- Matt

On Fri, Jul 19, 2013 at 3:23 PM, Matt Ford
I started by putting brackets in
([1,2] >>= \n -> [3,4]) >>= \m -> return (n,m)
This immediately fails when evaluated: I expect it's something to do with the n value now not being seen by the final return.
You're bracketing from the wrong end, which your intuition about n's visibility hints at. Try this as your first set of parens: [1,2] >>= (\n -> [3,4] >>= \m -> return (n,m)) --Rogan
It seems to me that the return function is doing something more than it's definition (return x = [x]).
If ignore the error introduced by the brackets I have and continue to simplify I get.
[3,4,3,4] >>= \m -> return (n,m)
Now this obviously won't work as there is no 'n' value. So what's happening here? Return seems to be doing way more work than lifting the result to a list, how does Haskell know to do this? Why's it not in the function definition? Are lists somehow a special case?
Any pointers appreciated.
Cheers,
-- Matt
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Hi,
Thanks for the help.
I thought >>= was left associative? It seems to be in the examples from Learn You A Haskell.
I tried to use the associative law to bracket from the right but it didn't like that either...
[1,2] >>= (\x -> (\n -> [3,4])) x >>= \m -> return (n,m))
Any thoughts?
Matt
On 19 Jul 2013, at 23:35, Rogan Creswick
On Fri, Jul 19, 2013 at 3:23 PM, Matt Ford
wrote: I started by putting brackets in
([1,2] >>= \n -> [3,4]) >>= \m -> return (n,m)
This immediately fails when evaluated: I expect it's something to do with the n value now not being seen by the final return.
You're bracketing from the wrong end, which your intuition about n's visibility hints at. Try this as your first set of parens:
[1,2] >>= (\n -> [3,4] >>= \m -> return (n,m))
--Rogan
It seems to me that the return function is doing something more than it's definition (return x = [x]).
If ignore the error introduced by the brackets I have and continue to simplify I get.
[3,4,3,4] >>= \m -> return (n,m)
Now this obviously won't work as there is no 'n' value. So what's happening here? Return seems to be doing way more work than lifting the result to a list, how does Haskell know to do this? Why's it not in the function definition? Are lists somehow a special case?
Any pointers appreciated.
Cheers,
-- Matt
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On Fri, Jul 19, 2013 at 3:58 PM, Matt Ford
Hi,
Thanks for the help.
I thought >>= was left associative? It seems to be in the examples from Learn You A Haskell.
I tried to use the associative law to bracket from the right but it didn't like that either...
[1,2] >>= (\x -> (\n -> [3,4])) x >>= \m -> return (n,m))
I think the issue is that you need to first take into account the lambdas *then* use what you know about the properties of (>>=). I found this stackoverflow answer helpful ( http://stackoverflow.com/a/11237469) "The rule for lambdas is pretty simple: the body of the lambda extends as far to the right as possible without hitting an unbalanced parenthesis." So, the first lambda runs to the end of the expression: [1,2] >>= (\n -> [3,4] >>= \m -> return (n,m)) Now, there is still a lambda nested inside the first lambda: \m -> return (n,m) [1,2] >>= (\n -> [3,4] >>= (\m -> return (n,m))) You violated the implied grouping that these new parentheses make explicit when you tried to apply the associative law above. Timon's post continues from this point to show the full deconstruction. --Rogan
Any thoughts?
Matt
On 19 Jul 2013, at 23:35, Rogan Creswick
wrote: On Fri, Jul 19, 2013 at 3:23 PM, Matt Ford
wrote: I started by putting brackets in
([1,2] >>= \n -> [3,4]) >>= \m -> return (n,m)
This immediately fails when evaluated: I expect it's something to do with the n value now not being seen by the final return.
You're bracketing from the wrong end, which your intuition about n's visibility hints at. Try this as your first set of parens:
[1,2] >>= (\n -> [3,4] >>= \m -> return (n,m))
--Rogan
It seems to me that the return function is doing something more than it's definition (return x = [x]).
If ignore the error introduced by the brackets I have and continue to simplify I get.
[3,4,3,4] >>= \m -> return (n,m)
Now this obviously won't work as there is no 'n' value. So what's happening here? Return seems to be doing way more work than lifting the result to a list, how does Haskell know to do this? Why's it not in the function definition? Are lists somehow a special case?
Any pointers appreciated.
Cheers,
-- Matt
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Hi,
Thanks all for your good help. I was caught up in sequential thinking about monads so much so that I treated the lambda expressions as separate functions rather than a nested big one.
That clears up a lot of nagging doubts.
Cheers,
Matt.
On 20 Jul 2013, at 00:18, Rogan Creswick
On Fri, Jul 19, 2013 at 3:58 PM, Matt Ford
wrote: Hi,
Thanks for the help.
I thought >>= was left associative? It seems to be in the examples from Learn You A Haskell.
I tried to use the associative law to bracket from the right but it didn't like that either...
[1,2] >>= (\x -> (\n -> [3,4])) x >>= \m -> return (n,m))
I think the issue is that you need to first take into account the lambdas *then* use what you know about the properties of (>>=).
I found this stackoverflow answer helpful (http://stackoverflow.com/a/11237469)
"The rule for lambdas is pretty simple: the body of the lambda extends as far to the right as possible without hitting an unbalanced parenthesis."
So, the first lambda runs to the end of the expression:
[1,2] >>= (\n -> [3,4] >>= \m -> return (n,m))
Now, there is still a lambda nested inside the first lambda: \m -> return (n,m)
[1,2] >>= (\n -> [3,4] >>= (\m -> return (n,m)))
You violated the implied grouping that these new parentheses make explicit when you tried to apply the associative law above.
Timon's post continues from this point to show the full deconstruction.
--Rogan
Any thoughts?
Matt
On 19 Jul 2013, at 23:35, Rogan Creswick
wrote: On Fri, Jul 19, 2013 at 3:23 PM, Matt Ford
wrote: I started by putting brackets in
([1,2] >>= \n -> [3,4]) >>= \m -> return (n,m)
This immediately fails when evaluated: I expect it's something to do with the n value now not being seen by the final return.
You're bracketing from the wrong end, which your intuition about n's visibility hints at. Try this as your first set of parens:
[1,2] >>= (\n -> [3,4] >>= \m -> return (n,m))
--Rogan
It seems to me that the return function is doing something more than it's definition (return x = [x]).
If ignore the error introduced by the brackets I have and continue to simplify I get.
[3,4,3,4] >>= \m -> return (n,m)
Now this obviously won't work as there is no 'n' value. So what's happening here? Return seems to be doing way more work than lifting the result to a list, how does Haskell know to do this? Why's it not in the function definition? Are lists somehow a special case?
Any pointers appreciated.
Cheers,
-- Matt
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

I thought >>= was left associative? It seems to be in the examples from Learn You A Haskell.
It is. But lambdas are parsed using the "maximal munch" rule, so they extend *as far to the right as possible*. So \x -> x * 2 + 1 would be parsed as \x -> (x * 2 + 1) -- right not (\x -> x) * 2 + 1 -- wrong which is obviously incorrect. I believe C uses a similar rule for funny expressions like `x+++y` (using maximal munch: `(x++) + y`).
I tried to use the associative law to bracket from the right but it didn't like that either...
[1,2] >>= (\x -> (\n -> [3,4])) x >>= \m -> return (n,m))
Any thoughts?
Matt
On 19 Jul 2013, at 23:35, Rogan Creswick
wrote: On Fri, Jul 19, 2013 at 3:23 PM, Matt Ford
wrote: I started by putting brackets in
([1,2] >>= \n -> [3,4]) >>= \m -> return (n,m)
This immediately fails when evaluated: I expect it's something to do with the n value now not being seen by the final return.
You're bracketing from the wrong end, which your intuition about n's visibility hints at. Try this as your first set of parens:
[1,2] >>= (\n -> [3,4] >>= \m -> return (n,m))
--Rogan
It seems to me that the return function is doing something more than it's definition (return x = [x]).
If ignore the error introduced by the brackets I have and continue to simplify I get.
[3,4,3,4] >>= \m -> return (n,m)
Now this obviously won't work as there is no 'n' value. So what's happening here? Return seems to be doing way more work than lifting the result to a list, how does Haskell know to do this? Why's it not in the function definition? Are lists somehow a special case?
Any pointers appreciated.
Cheers,
-- Matt
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- Chris Wong, fixpoint conjurer e: lambda.fairy@gmail.com w: http://lfairy.github.io/

On 07/20/2013 12:58 AM, Matt Ford wrote:
Hi,
Thanks for the help.
I thought >>= was left associative? It seems to be in the examples from Learn You A Haskell. ...
Yes, >>= is left-associative. The associativity of >>= is not relevant for your example because no two >>= operations actually occur next to each other. The second >>= is part of the lambda occurring as the second argument to the first >>=. Lambdas bind 'the rest of the expression'. [1,2] >>= \n -> [3,4] >>= \m -> return (n,m) is equivalent to: let a = [1,2] b = (\n -> [3,4] >>= \m -> return (n,m)) in a >>= b
I tried to use the associative law to bracket from the right but it didn't like that either...
[1,2] >>= (\x -> (\n -> [3,4])) x >>= \m -> return (n,m))
Any thoughts? ...
Where does that 'x' come from?

On 07/20/2013 12:23 AM, Matt Ford wrote:
Hi All,
I thought I'd have a go at destructing
[1,2] >>= \n -> [3,4] >>= \m -> return (n,m)
which results in [(1,3)(1,4),(2,3),(2,4)]
I started by putting brackets in
([1,2] >>= \n -> [3,4]) >>= \m -> return (n,m) ...
This is not the same expression any more. See below for the correct bracketing.
This immediately fails when evaluated: I expect it's something to do with the n value now not being seen by the final return.
It seems to me that the return function is doing something more than it's definition (return x = [x]).
If ignore the error introduced by the brackets I have and continue to simplify I get.
[3,4,3,4] >>= \m -> return (n,m)
Now this obviously won't work as there is no 'n' value. So what's happening here? Return seems to be doing way more work than lifting the result to a list, how does Haskell know to do this? Why's it not in the function definition? Are lists somehow a special case?
Any pointers appreciated. ...
[1,2] >>= (\n -> [3,4] >>= (\m -> return (n,m))) ~>* ((\n -> [3,4] >>= (\m -> return (n,m))) 1) ++ ((\n -> [3,4] >>= (\m -> return (n,m))) 2) ~>* ([3,4] >>= (\m -> return (1,m))) ++ ([3,4] >>= (\m -> return (2,m))) ~>* ((\m -> return (1,m)) 3 ++ (\m -> return (1,m)) 4) ++ ((\m -> return (2,m)) 3 ++ (\m -> return (2,m)) 4) ~>* return (1,3) ++ return (1,4) ++ return (2,3) ++ return (2,4) ~>* [(1,3)] ++ [(1,4)] ++ [(2,3)] ++ [(2,4)] ~>* [(1,3),(1,4),(2,3),(2,4)] Where the definition return x = [x] has been applied in the second-last step.

Matt
It is not return, but the bind the one that does the miracle of
multiplication.
By its definition for the list monad, it applies the second term once for
each element are in the first term.
So return is called many times. At the end, bind concat all the small
lists generated
2013/7/20 Matt Ford
Hi All,
I thought I'd have a go at destructing
[1,2] >>= \n -> [3,4] >>= \m -> return (n,m)
which results in [(1,3)(1,4),(2,3),(2,4)]
I started by putting brackets in
([1,2] >>= \n -> [3,4]) >>= \m -> return (n,m)
This immediately fails when evaluated: I expect it's something to do with the n value now not being seen by the final return.
It seems to me that the return function is doing something more than it's definition (return x = [x]).
If ignore the error introduced by the brackets I have and continue to simplify I get.
[3,4,3,4] >>= \m -> return (n,m)
Now this obviously won't work as there is no 'n' value. So what's happening here? Return seems to be doing way more work than lifting the result to a list, how does Haskell know to do this? Why's it not in the function definition? Are lists somehow a special case?
Any pointers appreciated.
Cheers,
-- Matt
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- Alberto.

For the sake of approaching this in yet another way, it can also be helpful
to substitute the definitions of bind and return in your expression. If we
start with the definitions:
instance Monad [] where
xs >>= f = concat (map f xs)
return x = [x]
Then we can make the following transformations:
[1,2] >>= \n -> [3,4] >>= \m -> return (n,m)
[1,2] >>= \n -> [3,4] >>= \m -> [(n, m)]
[1,2] >>= \n -> concat (map (\m -> [(n, m)]) [3,4])
concat (map (\n -> concat (map (\m -> [(n, m)]) [3,4])) [1,2])
Or perhaps more simply:
concatMap (\n -> concatMap (\m -> [(n, m)]) [3,4]) [1,2]
All of which are valid expressions and produce the same value.
Depending on your learning style this might not be as helpful as the other
approaches, but it does take a lot of the mystery out of >>= and return.
On Sat, Jul 20, 2013 at 1:08 AM, Alberto G. Corona
Matt
It is not return, but the bind the one that does the miracle of multiplication. By its definition for the list monad, it applies the second term once for each element are in the first term. So return is called many times. At the end, bind concat all the small lists generated
2013/7/20 Matt Ford
Hi All,
I thought I'd have a go at destructing
[1,2] >>= \n -> [3,4] >>= \m -> return (n,m)
which results in [(1,3)(1,4),(2,3),(2,4)]
I started by putting brackets in
([1,2] >>= \n -> [3,4]) >>= \m -> return (n,m)
This immediately fails when evaluated: I expect it's something to do with the n value now not being seen by the final return.
It seems to me that the return function is doing something more than it's definition (return x = [x]).
If ignore the error introduced by the brackets I have and continue to simplify I get.
[3,4,3,4] >>= \m -> return (n,m)
Now this obviously won't work as there is no 'n' value. So what's happening here? Return seems to be doing way more work than lifting the result to a list, how does Haskell know to do this? Why's it not in the function definition? Are lists somehow a special case?
Any pointers appreciated.
Cheers,
-- Matt
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- Alberto.
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
participants (6)
-
Alberto G. Corona
-
Chris Wong
-
Eric Rasmussen
-
Matt Ford
-
Rogan Creswick
-
Timon Gehr