[Haskell-cafe] Understanding tail recursion and trees

[anton muhin]

Well, if you could change your data structure, probably something like
this could work (in spirit of Daniil's response):

module Main where

data Tree = Tree {
  parent :: Maybe (Either Tree Tree)
  ,  left :: Maybe Tree
  , right :: Maybe Tree
}

buildTree :: (a -> (Maybe a, Maybe a)) -> a -> Tree
buildTree f = buildTree' Nothing where
  buildTree' p a = let t = Tree { parent = p, left = mkP Left t l,
right = mkP Right t r } in t where
    (l, r) = f a
    mkP f t v = fmap (buildTree' (Just $ f t)) v

leftmost :: Tree -> Tree
leftmost tree = maybe tree leftmost (left tree)

up :: Tree -> Maybe Tree
up tree = maybe Nothing (either Just up) (parent tree)

next :: Tree -> Maybe Tree
next tree = maybe (up tree) (Just . leftmost) (right tree)

nodes :: Tree -> Int
nodes = f 0 . Just . leftmost where
  f n = maybe n ((f $! (n + 1)) . next)

mkBalanced :: Int -> Tree
mkBalanced = buildTree f where
  f 0 = (Nothing, Nothing)
  f n = (Just (n - 1), Just (n - 1))

mkLeftist :: Int -> Tree
mkLeftist = buildTree f where
  f 0 = (Nothing, Nothing)
  f n = (Just (n - 1), Nothing)

mkRightist :: Int -> Tree
mkRightist = buildTree f where
  f 0 = (Nothing, Nothing)
  f n = (Nothing, Just (n - 1))

test v = do
  putStrLn "..."
  print $ nodes v

main = do
  test $ mkLeftist 2000000
  test $ mkRightist 2000000
  test $ mkBalanced 20

yours,
anton.

On Thu, May 1, 2008 at 4:09 PM, Edsko de Vries <devriese at cs.tcd.ie> wrote:
> Hi,
>
>  I am writing a simple compiler for a small DSL embedded in Haskell, and
>  am struggling to identify and remove the source of a stack error when
>  compiling larger examples. To understand the issues better, I was
>  playing around with tail recursion on trees when I came across the
>  following problem.
>
>  Suppose we want to count the number of leaves in a tree.  The obvious
>  naive (non tail-recursive) will run out of stack space quickly on larger
>  trees. To test this, I defined a function that generates left (gentreeL,
>  code below) or right (gentreeR) biased trees, that look like
>
>        *        *
>       / \      / \
>      *   *    *   *
>     / \          / \
>    *   *        *   *
>   .                  .
>   .                    .
>  n                      n
>
>  respectively; that is, a tree of depth n, with on the right (or the
>  left) leaves only).
>
>  Now, we can define define two traversals: one that has a tail call for
>  the left subtree, after having traversed the right (acountL, below); and
>  one that has a tail call for the right subtree, after having traversed
>  the left (acountR).
>
>  I was expecting acountL to work on the left biased tree but not on the
>  right biased tree -- and that assumption turned out to be correct.
>  However, I was also expecting (by "duality" :) acountR to work on the
>  right biased tree, but not on the left biased tree, whereas in fact it
>  works on both! (Indeed, it works on reallybigtree3, which combines the
>  left and right biased trees, as well.)
>
>  Can anyone explain why this is happening? Why is acountR not running out
>  of stack space on the left biased tree?
>
>  Also, if this is quirk rather than something I can rely on, is there a
>  way to write a function that can count the number of leaves in
>  reallybigtree3 without running out of stack space?
>
>  Thanks (code follows),
>
>  Edsko
>
>  > data Tree = Leaf Integer | Branch Tree Tree
>
>  > -- naive count
>  > ncount :: Tree -> Integer
>  > ncount (Leaf _) = 1
>  > ncount (Branch t1 t2) = ncount t1 + ncount t2
>
>  > -- generate left-biased tree (right nodes are always single leaves)
>  > gentreeL :: Integer -> Tree
>  > gentreeL 0 = Leaf 0
>  > gentreeL n = Branch (gentreeL (n-1)) (Leaf 0)
>  >
>  > -- generate right-based tree (left nodes are always single leaves)
>  > gentreeR :: Integer -> Tree
>  > gentreeR 0 = Leaf 0
>  > gentreeR n = Branch (Leaf 0) (gentreeR (n-1))
>  >
>  > -- test examples
>  > reallybigtree1 = gentreeL 2000000
>  > reallybigtree2 = gentreeR 2000000
>  > reallybigtree3 = Branch (gentreeL 2000000) (gentreeR 2000000)
>  >
>  > -- count with tail calls for the left subtree
>  > acountL :: Tree -> Integer -> Integer
>  > acountL (Leaf _)       acc = acc + 1
>  > acountL (Branch t1 t2) acc = acountL t1 $! (acountL t2 acc)
>  >
>  > -- count with tail calls for the right subtree
>  > acountR :: Tree -> Integer -> Integer
>  > acountR (Leaf _)       acc = acc + 1
>  > acountR (Branch t1 t2) acc = acountR t2 $! (acountL t1 acc)
>  _______________________________________________
>  Haskell-Cafe mailing list
>  Haskell-Cafe at haskell.org
>  http://www.haskell.org/mailman/listinfo/haskell-cafe
>