Generate All Possible Trees - haskell

Given the following data type definition:
data FormTree = Empty | Node FormTree FormTree deriving Show
I want to write a function which generates an infinite list containing all possible trees sorted after length e.g. the amount of nodes.
The following code almost does what I need but it only descends the tree on the right side by inserting additional nodes every time but I need it to alternate between both sides.
allPossibleTrees :: [FormTree]
allPossibleTrees = Empty : [Node x y | x <- recursive, y <- recursive]
where recursive = allPossibleTrees
Executing
take 5 allPossibleTrees
gives:
[Empty,Node Empty Empty,Node Empty (Node Empty Empty),Node Empty (Node Empty (Nodes Empty Empty)),Node Empty (Node Empty (Node Empty (Node Empty Empty)))]
but it should be something like:
[Empty,Node Empty Empty,Node (Node Empty Empty) Empty,Node Empty (Node Empty Empty),Node (Node Empty Empty) (Node Empty Empty)]

Here's a nice trick, reminiscent of the standard Fibonacci numbers trick. We'll build a lazy list; each member of the list will be a list of all trees with a given number of nodes. There's just one tree with no nodes, Empty, and that will serve as our base case. To build all the trees with n nodes, we'll assume we already know how to build trees with 0, 1, 2, ..., n-1 nodes. Then we'll just non-deterministically choose a pairing of those that sums to n-1 and stuck a Node on top.
In code:
import Control.Monad
import Data.List
sizes :: [[FormTree]]
sizes = [Empty] : (map go . drop 1 . inits) sizes where
go smaller = do
(ls, rs) <- zip smaller (reverse smaller)
liftM2 Node ls rs
Then we can simply define allPossibleTrees = concat sizes if that's wanted. The first few entries:
*Main> mapM_ print (take 4 sizes)
[Empty]
[Node Empty Empty]
[Node Empty (Node Empty Empty),Node (Node Empty Empty) Empty]
[Node Empty (Node Empty (Node Empty Empty)),Node Empty (Node (Node Empty Empty) Empty),Node (Node Empty Empty) (Node Empty Empty),Node (Node Empty (Node Empty Empty)) Empty,Node (Node (Node Empty Empty) Empty) Empty]
We can do a quick sanity check:
*Main> take 10 (map length sizes)
[1,1,2,5,14,42,132,429,1430,4862]
...which is indeed the first ten Catalan numbers, so we probably got it right!

The list comprehension
[ (x,y) | x<-[1..] , y<-[1..] ]
starts by considering x=1 and building all the pairs (1,y) for all the possible ys. Then follows with x=2 and all the (2,y) pairs. and so on.
However, there are infinitely many (1,y) pairs, so x=2 will only be considered after an infinite amount of time -- that is, not at all.
Your code suffers from the same problem.
To see a possible solution, you can refer to this related question exploiting the Omega monad to achieve a fair scheduling among all the cases.

One way is to keep track of the size of the tree (i.e. the number of Node constructors used.)
Suppose you had a function like this which returned the trees using exactly n Node constructors:
treesOfSize :: Int -> [FormTree]
Then allTrees could be defined as:
allTrees = concatMap treesOfSize [0..]
The definition of treesOfSize can be recursively defined which I'll let you figure out:
treesOfSize 0 = [Empty]
treesOfSize n = [ Node t1 t2 | ... ]

control-monad-omega library seems to do the trick with your original code:
{-# LANGUAGE MonadComprehensions #-}
import Control.Monad.Omega
data Empty = Empty | Node Empty Empty deriving Show
allPossibleTrees :: [Empty]
allPossibleTrees = Empty :
runOmega [Node x y | x <- each allPossibleTrees, y <- each allPossibleTrees]
First 10 trees look good to me:
*Main> mapM_ print $ take 10 allPossibleTrees
Empty
Node Empty Empty
Node Empty (Node Empty Empty)
Node (Node Empty Empty) Empty
Node Empty (Node Empty (Node Empty Empty))
Node (Node Empty Empty) (Node Empty Empty)
Node (Node Empty (Node Empty Empty)) Empty
Node Empty (Node (Node Empty Empty) Empty)
Node (Node Empty Empty) (Node Empty (Node Empty Empty))
Node (Node Empty (Node Empty Empty)) (Node Empty Empty)

Related

delete empty nodes from tree

I want to implement a function which deletes any empty children in a tree:
makeUnhollow (Node 5 Empty Empty) => Leaf 5
makeUnhollow (Leaf 5) => Leaf 5
makeUnhollow (Node 5 (Leaf 4) Empty) => (Node 5 (Leaf 4) Empty)
This is my current code:
makeUnhollow :: Tree a -> Tree a
makeUnhollow (Node a Empty Empty)= Leaf a
makeUnhollow (Leaf a) = Leaf a
makeUnhollow a = a
But somehow I'm getting failures for this code:
Tests.hs:130:
wrong result
expected: Node 6 (Leaf 5) (Leaf 7)
but got: Node 6 (Node 5 Empty Empty) (Node 7 Empty Empty)
Deleting all Empty children in a tree seems a little difficult:
Node a Empty Empty can become Leaf a
What if your root node is Empty?
What will Node a Empty (Leaf b) be?
I understand from your test that your goal is just to turn Node a Empty Empty into Leaf a, and not care when only one child is Empty. Mark Seemann's suggestion to turn makeUnhollow into a recursive function means you have to make it call itself in the last case of:
makeUnhollow :: Tree a -> Tree a
makeUnhollow (Node a Empty Empty) = Leaf a
makeUnhollow (Leaf a) = Leaf a
makeUnhollow Empty = ? -- don't forget to match Empty
makeUnhollow (Node a left right) = ? -- recurse on left, right :: Tree a
I might just call the function unhollow since that's an imperative verb, too.

Maximum element on a Tree in haskell?

Given a Tree :
data Tree a = Empty | Node a [Tree a] deriving Show
I am trying to get the maximum element so I've tried:
maxElem:: (Ord a) => Tree a -> Int
maxElem Empty = error "maxElem on empty Tree"
maxElem (Node a []) = a
maxElem (Node a x ) = maximum [ maxElem h | h<-x]
But I get an error and I don't find it.
There are three potential problems here:
if a tree contains one or many Emptys, it will error. So a Node 1 [Node 4 [], Empty, Node 2 [Node 5 []]], will raise an error since there is an Empty in the tree, and we will eventually call maxElem on that Empty whereas we can ignore the Empty and thus return 5;
you also do not take a into account when you calculate the maximum of a Node with children, whereas the a can be the maximum as well;
the result is an a as well, not per se an Int.
There are in fact two cases here:
1. the Empty tree, that raises an error; and
2. the maximum of a Node x cs is the maximum of x and the maxElem of the children, ignoring the Emptys.
So we can write it as:
maxElem:: Ord a => Tree a -> a
maxElem Empty = error "maxElem on Empty"
maxElem (Node x cs) = maximum (x : map maxElem [c | c#(Node _ _) <- cs])
Or we can write the map maxElem in the list comprehension:
maxElem:: Ord a => Tree a -> a
maxElem Empty = error "maxElem on Empty"
maxElem (Node x cs) = maximum (x : [maxElem c | c#(Node _ _) <- cs])
So the base case is the same, but the case of Node x cs calculates the maximum of a list with x as head, and map MaxElem as tail, but not on all children, but only the children that match the Node _ _ pattern. Since this list contains at least one element x, maximum can not error on the empty list, and we calculate only maxElem on Node instances.

Tree traversal confusion?

I have the following data type (source: http://learnyouahaskell.com/zippers):
data Tree a = Empty | Node a (Tree a) (Tree a) deriving (Show, Eq, Ord)
I then have the following function, that traverses the tree and replaces a Node based on directional instructions:
data Direction = L | R deriving (Show, Eq, Ord)
type Directions = [Direction]
changeNode :: Directions -> Tree Char -> Tree Char
changeNode (L : ds) (Node x l r) = Node x (changeNode ds l) r
changeNode (R : ds) (Node x l r) = Node x l (changeNode ds r)
changeNode [] (Node _ l r) = Node 'P' r l
However I don't understand this aspect of the function:
changeNode (L : ds) (Node x l r) = Node x (changeNode ds l) r
I see that this is using recursion (changeNode ds l), but I don't understand why this is using recursion.
Does anyone have a simple explanation?
This may not be the simple explanation you were hoping for, but it may help to try working through a short example. Read the following with pencil and paper handy and try to verify everything for yourself:
changeNode [L,R]
(Node 'A' (Node 'B' Empty (Node 'C' Empty Empty)) (Node 'D' Empty Empty))
I assume you'll agree that this should go left into the Node 'B' branch and then right into the Node 'C' branch, eventually replacing the 'C' with a 'P', right?
How does it do this? Well, the above expression matches the first pattern for changeNode, the one right after its type declaration. Specifically, it matches with variable assignments: ds=[R], x='A', l=the whole Node 'B' branch, and r=the whole Node 'D' branch. Therefore, we can rewrite it using the right hand side corresponding to that matching pattern. The right hand side for the pattern is:
Node x (changeNode ds l) r
and substituting the matched variables gives:
Node 'A' (changeNode [R] (Node 'B' Empty (Node 'C' Empty Empty)))
(Node 'D' Empty Empty) -- (1)
Now do you see what's happened? The first pattern for changeNode operates by "consuming" the first letter of the direction list (which has changed from [L,R] to [R]) and sort of pushing the changeNode call down into the left branch.
Now, concentrate on the value of this recursive changeNode call. This time it matches the second pattern for changeNode (with ds=[], x='B', l=Empty, and r=(Node 'C' Empty Empty)). The RHS for this pattern is:
Node x l (changeNode ds r)
which becomes (with the appropriate subtitutions):
Node 'B' Empty (changeNode [] (Node 'C' Empty Empty))
and substituting this value back into line (1), we get:
Node 'A' (Node 'B' Empty (changeNode [] (Node 'C' Empty Empty)))
(Node 'D' Empty Empty) -- (2)
Again, see how this second call has consumed the 'R' from the direction vector and pushed the changeNode call into the right branch of Node 'B'. Finally, what's the value of this last recursive changeNode call? Well, it matches the third pattern with l=Empty and r=Empty giving the RHS value:
Node 'P' Empty Empty
and substituting in to line (2), we get:
Node 'A' (Node 'B' Empty (Node 'P' Empty Empty)) (Node 'D' Empty Empty)
which was exactly what we wanted.
Contrast all this to what would have happened if the definition had been non-recursive:
changeNode' :: Directions -> Tree Char -> Tree Char
changeNode' (L : ds) (Node x l r) = Node x l r
changeNode' (R : ds) (Node x l r) = Node x l r
changeNode' [] (Node _ l r) = Node 'P' r l
In this case, our simple example would have matched the first pattern, again, with ds=[R], x='A', l=all of Node 'B' branch, r=all of Node 'D' branch, but instead of line (1), we would have used the non-recursive right hand side "Node x l r" to get the following in place of line (1):
Node 'A' (Node 'B' Empty (Node 'C' Empty Empty)) (Node 'D' Empty Empty)
See? Without the recursive call, after changeNode' consumes the 'L', it's finished. It returns the original tree with no further processing. The recursive call is needed to keep the process moving along until the direction vector is empty and the third pattern (the only one that actually changes a node) can be applied at the right place in the tree.
So, the short explanation (which doesn't really make sense until you've worked through the above example) is that the first two, recursive patterns for changeNode are used to move the changeNode call through the tree structure to the final target node where the final pattern is applied to change the node value.

In Haskell, how to generate a perfectly balanced binary search tree?

The function should takes a list xs and constructs a balanced binary search tree consisting of exactly the same set of elements as xs.
The result should be like this:
(if the list is [1,2,3,4,5,6,7,8])
Node (Node (Node (Node Empty 1 Empty) 2 Empty) 4 (Node Empty 4 Empty)) 5 (Node (Node Empty 6 Empty) 7 (Node Empty 8 Empty))
that is to say the tree should look like this:
5
/ \
3 7
/ \ / \
2 4 6 8
/
1
rather than this:
5
/ \
4 6
/ \
3 7
/ \
2 8
/
1
Could anybody tell me how to do this? I find I can do the second tree which is not perfectly balanced, but don't know how to do the first one.
I appreciate any help!!
Thank you in advance!
Sort the input list. Now create a tree whose root node is the middle element of the list, and whose left and right subtrees are the subtrees generated by applying this process to the sublists to the left and right of the center, respectively.
In Haskell:
buildBalanced [] = Empty
buildBalanced elts = Node (buildBalanced $ take half elts)
(elts !! half)
(buildBalanced $ drop (half+1) elts)
where half = length elts `quot` 2
main = putStrLn $ show $ buildBalanced [1,2,3,4,5,6,7,8]
-- prints Node (Node (Node (Node Empty 1 Empty) 2 Empty) 3 (Node Empty 4 Empty)) 5 (Node (Node Empty 6 Empty) 7 (Node Empty 8 Empty))
If the top of the tree must be the middle element:
mkBalanced [] = Empty
mkBalanced xs = Node mid (mkBalanced half0) (mkBalanced half1)
where (half0, half') = splitAt ((length xs `div` 2) - 1) xs
half1 = tail half'
mid = head half'
If not:
mkBalanced [] = Empty
mkBalanced (x:xs) = Node x (mkBalanced half0) (mkBalanced half1)
where (half0, half1) = splitAt (length xs `div` 2) xs

I need to create haskell function, which returns all possible binary trees, given a list of integers

As the title says, I need this:
getAllTrees :: [Int] -> [Tree Int]
getAllTrees xs = undefined
where tree is
data Tree x
= Null
| Leaf x
| Node (Tree x) x (Tree x)
I will appreciate any help, even the smallest clue :)
Thanks
I usually find it easiest to use the list monad for these kinds of problems. We can define getAllTrees by reasoning as follows:
The only tree of zero items is Null:
getAllTrees [] = return Null
There is also only one tree of one element, namely a Leaf:
getAllTrees [x] = return $ Leaf x
When we have more than one element, we can split the list in all possible ways to determine how we should branch, and then recursively generate the sub-trees from each list. Let's say we have a function splits :: [a] -> [([a], [a])] that returns all ways of splitting a list, for example:
> splits [1..3]
[([],[1,2,3]),([1],[2,3]),([1,2],[3]),([1,2,3],[])]
We can then define the final case of getAllTrees by using the list monad. This allows us to write code which sort of looks like like we're focusing on only one case, and the monad will give us all the combinations.
getAllTrees xs = do
(left, x : right) <- splits xs
Node <$> getAllTrees left <*> pure x <*> getAllTrees right
The first line splits the input list and takes the first item from the second part as the middle element. The case when the second part is empty doesn't match the pattern, so it gets discarded since that's how the list monad handles pattern match failures.
The second line uses applicative syntax to say that we want the result to be a list of nodes, made from all combinations of sub-trees from the left list, the fixed middle element x, and all sub-trees from the right list.
All that remains then is to implement splits. Looking at the example above, it's easy to see that we can just take the inits and tails of the list and zip them together:
splits xs = zip (inits xs) (tails xs)
Time for a quick sanity check in the interpreter:
> mapM_ print $ getAllTrees [1..3]
Node Null 1 (Node Null 2 (Leaf 3))
Node Null 1 (Node (Leaf 2) 3 Null)
Node (Leaf 1) 2 (Leaf 3)
Node (Node Null 1 (Leaf 2)) 3 Null
Node (Node (Leaf 1) 2 Null) 3 Null
> length $ getAllTrees [1..5]
42
Looks like we're done! Some key lessons:
Try to think about the small cases first, and build up from there.
The list monad is useful for code that needs to generate all combinations of things.
You don't have to do everything at once. Dealing with the list splitting separately made the code much simpler than it would have been otherwise.

Resources