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
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@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe