Re: [Haskell-cafe] List Monads and non-determinism

2013-07-20 Thread Matt Ford
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 cresw...@gmail.com wrote:

 On Fri, Jul 19, 2013 at 3:58 PM, Matt Ford m...@dancingfrog.co.uk 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 cresw...@gmail.com wrote:
 
 On Fri, Jul 19, 2013 at 3:23 PM, Matt Ford m...@dancingfrog.co.uk 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


Re: [Haskell-cafe] List Monads and non-determinism

2013-07-20 Thread 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 m...@dancingfrog.co.uk

 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


Re: [Haskell-cafe] List Monads and non-determinism

2013-07-20 Thread Eric Rasmussen
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 agocor...@gmail.comwrote:

 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 m...@dancingfrog.co.uk

 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


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] List Monads and non-determinism

2013-07-19 Thread Rogan Creswick
On Fri, Jul 19, 2013 at 3:23 PM, Matt Ford m...@dancingfrog.co.uk 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


Re: [Haskell-cafe] List Monads and non-determinism

2013-07-19 Thread Timon Gehr

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.







___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] List Monads and non-determinism

2013-07-19 Thread 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))

Any thoughts?

Matt 

On 19 Jul 2013, at 23:35, Rogan Creswick cresw...@gmail.com wrote:

 On Fri, Jul 19, 2013 at 3:23 PM, Matt Ford m...@dancingfrog.co.uk 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


Re: [Haskell-cafe] List Monads and non-determinism

2013-07-19 Thread Rogan Creswick
On Fri, Jul 19, 2013 at 3:58 PM, Matt Ford m...@dancingfrog.co.uk 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 cresw...@gmail.com wrote:

 On Fri, Jul 19, 2013 at 3:23 PM, Matt Ford m...@dancingfrog.co.uk 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


Re: [Haskell-cafe] List Monads and non-determinism

2013-07-19 Thread Chris Wong
 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 cresw...@gmail.com wrote:

 On Fri, Jul 19, 2013 at 3:23 PM, Matt Ford m...@dancingfrog.co.uk 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.fa...@gmail.com
  w: http://lfairy.github.io/

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] List Monads and non-determinism

2013-07-19 Thread Timon Gehr

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?


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe