[Haskell-beginners] Tying the knot

aditya siram aditya.siram at gmail.com
Thu Dec 30 01:22:27 CET 2010


My brain turns into strange braid when I see this kind of thing. I
don't quite understand it and I've never used it in real world code
but I'll try and explain anyway. Caveat emptor.

First forget about 'labelLeaves' and think a function that only
returned the leaf count:
  count :: Tree a -> Int
  count tree = c
     where
     c = count' tree

     count' (Branch a b) = na+nb
         where
         na = count' a
         nb = count' b
     count' (Leaf _)  = 1

> count $ Branch (Leaf "hello") (Leaf "world")
2

Now look at 'n' and imagine it was a memory location. Mentally
substitute some hex address (like 0x0000) if it makes it easier.
Here's what the function looks like now:

  labelLeaves :: Tree a -> Tree Int
  labelLeaves tree = tree'
      where
      (0x0000, tree') = label 0x0000 tree  -- n is both result and argument!

      label 0x0000 (Branch a b) = (na+nb, Branch a' b')
          where
          (na,a') = label 0x0000 a
          (nb,b') = label 0x0000 b
      label 0x0000 (Leaf _)     = (1, Leaf 0x0000)

So if labelLeaves is given (Branch (Leaf "hello") (Leaf "world")) as
an argument, and we continue to think of 'n' as a memory location the
function returns something like:
(Branch (Leaf 0x0000) (Leaf 0x0000))

The part of the function where the leaves are counted up is exactly
like my 'count' example above, but when the function is done instead
of just returning it this line:
 (n,tree') = label n tree
assigns the final count to 'n'. If 'n' is a memory location the final
leaf count would be sitting in 0x0000. Subbing the value at that
location into the result we get:
(Branch (Leaf 2) (Leaf 2))


-deech

On Wed, Dec 29, 2010 at 4:52 PM, Patrick LeBoutillier
<patrick.leboutillier at gmail.com> wrote:
> Heinrich,
>
>> A canonical example is the following solution to the problem of labeling all
>> the leaves in a tree with the total leaf count:
>>
>>    data Tree a = Branch (Tree a) (Tree a) | Leaf a
>>
>>    labelLeaves :: Tree a -> Tree Int
>>    labelLeaves tree = tree'
>>        where
>>        (n, tree') = label n tree  -- n is both result and argument!
>>
>>        label n (Branch a b) = (na+nb, Branch a' b')
>>            where
>>            (na,a') = label n a
>>            (nb,b') = label n b
>>        label n (Leaf _)     = (1, Leaf n)
>>
>
> This looks completely freaky to me... how does it work? Is it the
> laziness that allows the sum to be calculated first while preserving
> the structure (as thunks?), and then once the value of n is known it
> is propagated back down the tree and the actual tree values
> constructed? Anyways this is really amazing to my newbie eyes...
>
> Patrick
> --
> =====================
> Patrick LeBoutillier
> Rosemère, Québec, Canada
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>



More information about the Beginners mailing list