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.
Related
I am trying to create a Haskell function that generates a list containing all the partial paths of a tree, given the tree implementation data Tree a = Empty | Node a (Tree a) (Tree a). For example, if I have a tree
tree = Node 5 (Node 3 Empty Empty ) (Node 2 Empty Empty )
I want to get
[[],[5],[5,3],[5,2]]
How could I make such a function?
First let us consider the type of this function, it must be Tree a -> [[a]].
So what can we do given a node Node x left right? We have the path that is just the node itself - this is just [x], as well as the paths that go through this node to the left- and right sub tree. The paths going throu the left and right sub tree are just what we get if we apply our function to left and right respectively. We now just need to add x to the start of each of those paths and we do that by calling map(x:) paths. (And for an empty one we should get an empty list as there is no path.)
data Tree a = Empty | Node a (Tree a) (Tree a)
tree = Node 5 (Node 3 Empty Empty ) (Node 2 Empty Empty )
pp :: Tree a -> [[a]]
pp (Node x left right) = [[x]] ++ map(x:)(pp left) ++ map(x:)(pp right)
pp Empty = []
Now this has one flaw that the empty path is not considered as a partial path by this function. But we can easily amend that by adding it and wrapping it in another function:
partialPaths :: Tree a -> [[a]]
partialPaths t = [[]] ++ pp t
main = print $ partialPaths tree
Try it online!
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)
So I am trying to add consecutive numbers to the elements in a BST strictly using recursion (no standard prelude functions). Here is what I have so far:
data Tree a = Empty | Node a (Tree a) (Tree a) deriving (Show)
leaf x = Node x Empty Empty
number' :: Int -> Tree a -> Tree (Int, a)
number' a Empty = Empty
number' a (Node x xl xr) = Node (a,x) (number' (a+1) xl) (number' (a+1) xr)
number :: Tree a -> Tree (Int, a)
number = number' 1
number' is an auxiliary function that carries around "a" as a counter. It should add 1 to each recursive call, so I am not sure why it is doing what it is doing.
As of now the level of the element is assigned to each element. I would like the first element to be assigned 1, the element to the left of that 2, the element to the left of that 3, etc. Each element should get a+1 assigned to it and no number should be repeated. Thanks in advance.
I want to first explain why the code in the question assigns level numbers. This will lead us directly to two different solutions, one passed on caching, one based on doing two traversals at once. Finally, I show how the second solution relates to the solutions provided by other answers.
What has to be changed in the code from the question?
The code in the question assigns the level number to each node. We can understand why the code behaves like that by looking at the recursive case of the number' function:
number' a (Node x xl xr) = Node (a,x) (number' (a+1) xl) (number' (a+1) xr)
Note that we use the same number, a + 1, for both recursive calls. So the root nodes in both subtrees will get assigned the same number. If we want each node to have a different number, we better pass different numbers to the recursive calls.
What number should we pass to the recursive call?
If we want to assign the numbers according to a left-to-right pre-order traversal, then a + 1 is correct for the recursive call on the left subtree, but not for the recursive call on the right subtree. Instead, we want to leave out enough numbers to annotate the whole left subtree, and then start annotating the right subtree with the next number.
How many numbers do we need to reserve for the left subtree? That depends on the subtree's size, as computed by this function:
size :: Tree a -> Int
size Empty = 0
size (Node _ xl xr) = 1 + size xl + size xr
Back to the recursive case of the number' function. The smallest number annotated somewhere in the left subtree is a + 1. The biggest number annotated somewhere in the left subtree is a + size xl. So the smallest number available for the right subtree is a + size xl + 1. This reasoning leads to the following implementation of the recursive case for number' that works correctly:
number' :: Int -> Tree a -> Tree (Int, a)
number' a Empty = Empty
number' a (Node x xl xr) = Node (a,x) (number' (a+1) xl) (number' (a + size xl + 1) xr)
Unfortunately, there is a problem with this solution: It is unnecessarily slow.
Why is the solution with size slow?
The function size traverses the whole tree. The function number' also traverses the whole tree, and it calls size on all left subtrees. Each of these calls will traverse the whole subtree. So overall, the function size gets executed more than once on the same node, even though it always returns the same value, of course.
How can we avoid traversing the tree when calling size?
I know two solutions: Either we avoid traversing the tree in the implementation of size by caching the sizes of all trees, or we avoid calling size in the first place by numbering the nodes and computing the size in one traversal.
How can we compute the size without traversing the tree?
We cache the size in every tree node:
data Tree a = Empty | Node Int a (Tree a) (Tree a) deriving (Show)
size :: Tree a -> Int
size Empty = 0
size (Node n _ _ _) = n
Note that in the Node case of size, we just return the cached size. So this case is not recursive, and size does not traverse the tree, and the problem with our implementation of number' above goes away.
But the information about the size has to come from somewhere! Everytime we create a Node, we have to provide the correct size to fill the cache. We can lift this task off to smart constructors:
empty :: Tree a
empty = Empty
node :: a -> Tree a -> Tree a -> Tree a
node x xl xr = Node (size xl + size xr + 1) x xl xr
leaf :: a -> Tree a
leaf x = Node 1 x Empty Empty
Only node is really necessary, but I added the other two for completeness. If we always use one of these three functions to create a tree, the cached size information will always be correct.
Here is the version of number' that works with these definitions:
number' :: Int -> Tree a -> Tree (Int, a)
number' a Empty = Empty
number' a (Node _ x xl xr) = node (a,x) (number' (a+1) xl) (number' (a + size xl + 1) xr)
We have to adjust two things: When pattern matching on Node, we ignore the size information. And when creating a Node, we use the smart constructor node.
That works fine, but it has the drawback of having to change the definition of trees. On the one hand, caching the size might be a good idea anyway, but on the other hand, it uses some memory and it forces the trees to be finite. What if we want to implement a fast number' without changing the definition of trees? This brings us to the second solution I promised.
How can we number the tree without computing the size?
We cannot. But we can number the tree and compute the size in a single traversal, avoiding the multiple size calls.
number' :: Int -> Tree a -> (Int, Tree (Int, a))
Already in the type signature, we see that this version of number' computes two pieces of information: The first component of the result tuple is the size of the tree, and the second component is the annotated tree.
number' a Empty = (0, Empty)
number' a (Node x xl xr) = (sl + sr + 1, Node (a, x) yl yr) where
(sl, yl) = number' (a + 1) xl
(sr, yr) = number' (a + sl + 1) xr
The implementation decomposes the tuples from the recursive calls and composes the components of the result. Note that sl is like size xl from the previous solution, and sr is like size xr. We also have to name the annotated subtrees: yl is the left subtree with node numbers, so it is like number' ... xl in the previous solution, and yr is the right subtree with node numbers, so it is like number' ... xr in the previous solution.
We also have to change number to only return the second component of the result of number':
number :: Tree a -> Tree (Int, a)
number = snd . number' 1
I think that in a way, this is the clearest solution.
What else could we improve?
The previous solution works by returning the size of the subtree. That information is then used to compute the next available node number. Instead, we could also return the next available node number directly.
number' a Empty = (a, Empty)
number' a (Node x xl xr) = (ar, Node (a, x) yl yr) where
(al, yl) = number' (a + 1) xl
(ar, yr) = number' al xr
Note that al is like a + sl + 1 in the previous solution, and ar is like a + sl + sr + 1. Clearly, this change avoids some additions.
This is essentially the solution from Sergey's answer, and I would expect that this is the version most Haskellers would write. You could also hide the manipulations of a, al and ar in a state monad, but I don't think that really helps for such a small example. The answer by Ankur shows how it would look like.
data Tree a = Empty | Node a (Tree a) (Tree a) deriving (Show)
number :: Tree a -> Tree (Int, a)
number = fst . number' 1
number' :: Int -> Tree a -> (Tree (Int, a), Int)
number' a Empty = (Empty, a)
number' a (Node x l r) = let (l', a') = number' (a + 1) l
(r', a'') = number' a' r
in (Node (a, x) l' r', a'')
*Tr> let t = (Node 10 (Node 20 (Node 30 Empty Empty) (Node 40 Empty Empty)) (Node 50 (Node 60 Empty Empty) Empty))
*Tr> t
Node 10 (Node 20 (Node 30 Empty Empty) (Node 40 Empty Empty)) (Node 50 (Node 60 Empty Empty) Empty)
*Tr> number t
Node (1,10) (Node (2,20) (Node (3,30) Empty Empty) (Node (4,40) Empty Empty)) (Node (5,50) (Node (6,60) Empty Empty) Empty)
As suggested by comments in your question that each call to number should return a integer also which needs to be further used for next set of nodes. This makes the signature of the function to:
Tree a -> Int -> (Tree (Int,a), Int)
Looking at the last part of it, it looks like a candidate for State monad i.e state -> (Val,state).
Below code shows how you can do this using State monad.
import Control.Monad.State
data Tree a = Empty | Node a (Tree a) (Tree a) deriving (Show)
myTree :: Tree String
myTree = Node "A" (Node "B" (Node "D" Empty Empty) (Node "E" Empty Empty)) (Node "C" (Node "F" Empty Empty) (Node "G" Empty Empty))
inc :: State Int ()
inc = do
i <- get
put $ i + 1
return ()
number :: Tree a -> State Int (Tree (Int,a))
number Empty = return Empty
number (Node x l r) = do
i <- get
inc
l' <- number l
r' <- number r
return $ Node (i,x) l' r'
main = do
putStrLn $ show (fst (runState (number myTree) 1))
I need to make an implementation of a priority queue with a Heap Tree in Haskell, for example:
Given a list: [3,2,7,8,4,1,9]
3 is the main root
2 is its left leaf
7 is its right leaf
8 is the left leaf of 2
4 is the right leaf of 2
1 is the left leaf of 7
9 is the right leaf of 7
If I want to heapifiy the tree it would be like this:
7 > 3 so we exchange them
8 > 2 we exchange them
8 > 7 we exchange them
9 > 3 we exchange them
9 > 8 we exchange them
We end with a list like this: [9,7,8,2,4,1,3]
And 9 is the element with the highest number (priority) in our queue.
I will need to do this:
insert h e that inserts the element e in the heap h (in the last position)
delete h that removes the element with the highest priority (in our example 9)
heapify h that heapifies the tree.
But my problem is the heapify function, I dont even know where to start. That's why im asking for clues or advice.
module Heapify where
Let's use the tree type
data Tree a = Leaf a | Node (Tree a) a (Tree a)
deriving Show
and the example tree
ourTree = Node (Node (Leaf 8) 2 (Leaf 4)) 3 (Node (Leaf 1) 7 (Leaf 9))
And work out how to heapify it.
Your description in pictures
Top node
Left subtree
Right subtree
Heapified?
In this case, the result is indeed a heap, but this method isn't the standard way of doing heapification, and doesn't generalise (as far as I can tell) to something that does make sure you have a heap. Credit to Will Ness for pointing this out.
How should we heapify?
A tree satisfies the heap property if each parent node is no smaller than its child nodes. (It says nothing about the compararive sizes of the child nodes.)
Heapification actually works a bit like insertion sort, in that you start at the low end, and work gradually up, dragging small elements back into place as you introduce them.
Step 1: Heapify the left and right subtrees
Step 2: This node: Check if the top value should be pulled down
Step 3: If so, heapify at that side again
Steps 1,2 and 4 are just recursive calls, so let's concentrate on the top node:
Top node
We need to (a) see the value at the top of the subtrees and (b) be able to replace it.
atTop :: Tree a -> a
atTop (Leaf a) = a
atTop (Node _ a _) = a
replaceTop :: Ord a => Tree a -> a -> Tree a
replaceTop (Leaf _) a = Leaf a
replaceTop (Node l _ r) a = heapify (Node l a r)
Notice the cheeky forward reference to heapify? When we replace the top node of a tree, we need to re-heapify it to make sure it's still a tree.
Now let's see how to adjust at the left hand side if necessary.
It's necessary if the top of the left subtree, topL, is larger than the value a at the node. If it's <= we don't need to do anything, so leave the node alone.
adjustLeft :: Ord a => Tree a -> Tree a
adjustLeft (Leaf a) = Leaf a -- But we shouldn't ask to do this.
adjustLeft node#(Node l a r)
| topL <= a = node
| otherwise = Node (replaceTop l a) topL r
where topL = atTop l
and at the right:
Now let's adjust at the right hand side if necessary. This works exactly the same.
adjustRight :: Ord a => Tree a -> Tree a
adjustRight (Leaf a) = Leaf a -- But we shouldn't ask to do this.
adjustRight node#(Node l a r)
| topR <= a = node
| otherwise = Node l topR (replaceTop r a)
where topR = atTop r
Let's see some of that working:
*Heapify> ourTree
Node (Node (Leaf 8) 2 (Leaf 4)) 3 (Node (Leaf 1) 7 (Leaf 9))
*Heapify> atTop ourTree
3
Pull down to the Left or right?
If the current value belongs lower down the tree, we need to pull it down the left or the right side, by swapping it with the larger value of the two. We pick the larger value so we know it's more than the top value in the left subtree.
doTop :: Ord a => Tree a -> Tree a
doTop (Leaf a) = Leaf a
doTop node#(Node l a r)
| atTop l > atTop r = adjustLeft node
| otherwise = adjustRight node
Remember that adjustLeft and adjustRight make a recursive call to heapify.
Return of the heapification
So to heapify, we just
heapify :: Ord a => Tree a -> Tree a
heapify (Leaf a) = Leaf a
heapify (Node l a r) = doTop (Node (heapify l) a (heapify r))
OK, that was easy. Let's test it:
*Heapify> ourTree
Node (Node (Leaf 8) 2 (Leaf 4)) 3 (Node (Leaf 1) 7 (Leaf 9))
*Heapify> heapify ourTree
Node (Node (Leaf 2) 8 (Leaf 4)) 9 (Node (Leaf 1) 7 (Leaf 3))
I'm needing some help in figuring out how to create a leftSpine function in Haskell.
Basically, it is supposed to take all the left most leafs and put them into a list, but whenever I run my code I get an empty list. Any help would be appreciated.
Here is my code.
data Tree x = Leaf | Node (Tree x) x (Tree x)
deriving Show
leftSpine :: Tree x -> [x]
leftSpine Leaf = []
leftSpine (Node lt x rt) = (leftSpine lt)
And here is my code to test it.
leftSpine (Node (Node (Node Leaf 1 Leaf) 2 (Node Leaf 3 Leaf))
4
(Node (Node Leaf 5 Leaf) 6 (Node Leaf 7 Leaf)))
It should equal [4,2,1] but it just comes up as [].
leftSpine :: Tree x -> [x]
leftSpine Leaf = []
leftSpine (Node lt x rt) = x:leftSpine lt
You weren't actually putting anything into the list. The difference is the x:leftSpine lt instead of leftSpine lt.
Your code plainly says that the result is always the empty list.
The first case says that the left spine of a leaf is the empty list. Ok so far.
The second case says that the left spine of a node is exactly the left spine of the node's left child.
So if we want to find the left spine of a tree, we'll just keep chasing down the left children of the nodes we reach, knowing that the answer is exactly equal to the left spine of the next left child. Either we eventually find a leaf, and our result is the empty list, or the tree is infinite and we never return a result at all. There is nothing in your code that could ever return anything else.
The key to writing a recursive function of this kind is to figure out what the answer is for the base case (Leaf, here), and then for the non-base cases (Node, here) you need to figure out how to combine the sub-solutions with the local information here to generate a full solution.
In this case the left spine of a Leaf is easy, as there's no data at all. So then how would you combine the information from Node lt x rt with leftSpine lt to get the left spine of the whole tree?