I recently started using Haskell and it will probably be for a short while. Just being asked to use it to better understand functional programming for a class I am taking at Uni.
Now I have a slight problem I am currently facing with what I am trying to do. I want to build it breadth-first but I think I got my conditions messed up or my conditions are also just wrong.
So essentially if I give it
[“A1-Gate”, “North-Region”, “South-Region”, “Convention Center”, “Rectorate”, “Academic Building1”, “Academic Building2”] and [0.0, 0.5, 0.7, 0.3, 0.6, 1.2, 1.4, 1.2], my tree should come out like
But my test run results are haha not what I expected. So an extra sharp expert in Haskell could possibly help me spot what I am doing wrong.
Output:
*Main> l1 = ["A1-Gate", "North-Region", "South-Region", "Convention Center",
"Rectorate", "Academic Building1", "Academic Building2"]
*Main> l3 = [0.0, 0.5, 0.7, 0.3, 0.6, 1.2, 1.4, 1.2]
*Main> parkingtree = createBinaryParkingTree l1 l3
*Main> parkingtree
Node "North-Region" 0.5
(Node "A1-Gate" 0.0 EmptyTree EmptyTree)
(Node "Convention Center" 0.3
(Node "South-Region" 0.7 EmptyTree EmptyTree)
(Node "Academic Building2" 1.4
(Node "Academic Building1" 1.2 EmptyTree EmptyTree)
(Node "Rectorate" 0.6 EmptyTree EmptyTree)))
A-1 Gate should be the root but it ends up being a child with no children so pretty messed up conditions.
If I could get some guidance it would help. Below is what I've written so far::
data Tree = EmptyTree | Node [Char] Float Tree Tree deriving (Show,Eq,Ord)
insertElement location cost EmptyTree =
Node location cost EmptyTree EmptyTree
insertElement newlocation newcost (Node location cost left right) =
if (left == EmptyTree && right == EmptyTree)
then Node location cost (insertElement newlocation newcost EmptyTree)
right
else if (left == EmptyTree && right /= EmptyTree)
then Node location cost (insertElement newlocation newcost EmptyTree)
right
else if (left /= EmptyTree && right == EmptyTree)
then Node location cost left
(insertElement newlocation newcost EmptyTree)
else Node newlocation newcost EmptyTree
(Node location cost left right)
buildBPT [] = EmptyTree
--buildBPT (xs:[]) = insertElement (fst xs) (snd xs) (buildBPT [])
buildBPT (x:xs) = insertElement (fst x) (snd x) (buildBPT xs)
createBinaryParkingTree a b = buildBPT (zip a b)
Thank you for any guidance that might be provided. Yes I have looked at some of the similar questions I do think my problem is different but if you think a certain post has a clear answer that will help I am willing to go and take a look at it.
Here's a corecursive solution.
{-# bft(Xs,T) :- bft( Xs, [T|Q], Q). % if you don't read Prolog, see (*)
bft( [], Nodes , []) :- maplist( =(empty), Nodes).
bft( [X|Xs], [N|Nodes], [L,R|Q]) :- N = node(X,L,R),
bft( Xs, Nodes, Q).
#-}
data Tree a = Empty | Node a (Tree a) (Tree a) deriving Show
bft :: [a] -> Tree a
bft xs = head nodes -- Breadth First Tree
where
nodes = zipWith g (map Just xs ++ repeat Nothing) -- values and
-- Empty leaves...
(pairs $ tail nodes) -- branches...
g (Just x) (lt,rt) = Node x lt rt
g Nothing _ = Empty
pairs ~(a: ~(b:c)) = (a,b) : pairs c
{-
nodes!!0 = g (Just (xs!!0)) (nodes!!1, nodes!!2) .
nodes!!1 = g (Just (xs!!1)) (nodes!!3, nodes!!4) . .
nodes!!2 = g (Just (xs!!2)) (nodes!!5, nodes!!6) . . . .
................ .................
-}
nodes is the breadth-first enumeration of all the subtrees of the result tree. The tree itself is the top subtree, i.e., the first in this list. We create Nodes from each x in the input xs, and when the input
is exhausted we create Emptys by using an indefinite number of Nothings instead (the Empty leaves' true length is length xs + 1 but we don't need to care about that).
And we didn't have to count at all.
Testing:
> bft [1..4]
Node 1 (Node 2 (Node 4 Empty Empty) Empty) (Node 3 Empty Empty)
> bft [1..10]
Node 1
(Node 2
(Node 4
(Node 8 Empty Empty)
(Node 9 Empty Empty))
(Node 5
(Node 10 Empty Empty)
Empty))
(Node 3
(Node 6 Empty Empty)
(Node 7 Empty Empty))
How does it work: the key is g's laziness, that it doesn't force lt's nor rt's value, while the tuple structure is readily served by -- very lazy in its own right -- pairs. So both are just like the not-yet-set variables in that Prolog pseudocode(*), when served as 2nd and 3rd arguments to g. But then, for the next x in xs, the node referred to by this lt becomes the next invocation of g's result.
And then it's rt's turn, etc. And when xs end, and we hit the Nothings, g stops pulling the values from pairs's output altogether. So pairs stops advancing on the nodes too, which is thus never finished though it's defined as an unending stream of Emptys past that point, just to be on the safe side.
(*) Prolog's variables are explicitly set-once: they are allowed to be in a not-yet-assigned state. Haskell's (x:xs) is Prolog's [X | Xs].
The pseudocode: maintain a queue; enqueue "unassigned pointer"; for each x in xs: { set pointer in current head of the queue to Node(x, lt, rt) where lt, rt are unassigned pointers; enqueue lt; enqueue rt; pop queue }; set all pointers remaining in queue to Empty; find resulting tree in the original head of the queue, i.e. the original first "unassigned pointer" (or "empty box" instead of "unassigned pointer" is another option).
This Prolog's "queue" is of course fully persistent: "popping" does not mutate any data structure and doesn't change any outstanding references to the queue's former head -- it just advances the current pointer into the queue. So what's left in the wake of all this queuing, is the bfs-enumeration of the built tree's nodes, with the tree itself its head element -- the tree is its top node, with the two children fully instantiated to the bottom leaves by the time the enumeration is done.
Update: #dfeuer came up with much simplified version of it which is much closer to the Prolog original (that one in the comment at the top of the post), that can be much clearer. Look for more efficient code and discussion and stuff in his post. Using the simple [] instead of dfeuer's use of the more efficient infinite stream type data IS a = a :+ IS a for the sub-trees queue, it becomes
bftree :: [a] -> Tree a
bftree xs = t
where
t : q = go xs q
go [] _ = repeat Empty
go (x:ys) ~(l : ~(r : q)) = Node x l r : go ys q
---READ-- ----READ---- ---WRITE---
{-
xs = [ x x2 x3 x4 x5 x6 x7 x8 … ]
(t:q) = [ t l r ll lr rl rr llr … Empty Empty … … ]
-}
For comparison, the opposite operation of breadth-first enumeration of a tree is
bflist :: Tree a -> [a]
bflist t = [x | Node x _ _ <- q]
where
q = t : go 1 q
go 0 _ = []
go i (Empty : q) = go (i-1) q
go i (Node _ l r : q) = l : r : go (i+1) q
-----READ------ --WRITE--
How does bftree work: t : q is the list of the tree's sub-trees in breadth-first order. A particular invocation of go (x:ys) uses l and r before they are defined by subsequent invocations of go, either with another x further down the ys, or by go [] which always returns Empty. The result t is the very first in this list, the topmost node of the tree, i.e. the tree itself.
This list of tree nodes is created by the recursive invocations of go at the same speed with which the input list of values xs is consumed, but is consumed as the input to go at twice that speed, because each node has two child nodes.
These extra nodes thus must also be defined, as Empty leaves. We don't care how many are needed and simply create an infinite list of them to fulfill any need, although the actual number of empty leaves will be one more than there were xs.
This is actually the same scheme as used in computer science for decades for array-backed trees where tree nodes are placed in breadth-first order in a linear array. Curiously, in such setting both conversions are a no-op -- only our interpretation of the same data is what's changing, our handling of it, how are we interacting with / using it.
Update: the below solution is big-O optimal and (I think) pretty easy to understand, so I'm leaving it here in case anyone's interested. However, Will Ness's solution is much more beautiful and, especially when optimized a bit, can be expected to perform better in practice. It is much more worthy of study!
I'm going to ignore the fake edge labels for now and just focus on the core of what's happening.
A common pattern in algorithm design is that it's sometimes easier to solve a more general problem. So instead of trying to build a tree, I'm going to look at how to build a forest (a list of trees) with a given number of trees. I'll make the node labels polymorphic to avoid having to think about what they look like; you can of course use the same building technique with your original tree type.
data Tree a = Empty | Node a (Tree a) (Tree a)
-- Built a tree from a breadth-first list
bft :: [a] -> Tree a
bft xs = case dff 1 xs of
[] -> Empty
[t] -> t
_ -> error "something went wrong"
-- Build a forest of nonempty trees.
-- The given number indicates the (maximum)
-- number of trees to build.
bff :: Int -> [a] -> [Tree a]
bff _ [] = []
bff n xs = case splitAt n xs of
(front, rear) -> combine front (bff (2 * n) rear)
where
combine :: [a] -> [Tree a] -> [Tree a]
-- you write this
Here's a full, industrial-strength, maximally lazy implementation. This is the most efficient version I've been able to come up with that's as lazy as possible. A slight variant is less lazy but still works for fully-defined infinite inputs; I haven't tried to test which would be faster in practice.
bft' :: [a] -> Tree a
bft' xs = case bff 1 xs of
[] -> Empty
[t] -> t
_ -> error "whoops"
bff' :: Int -> [a] -> [Tree a]
bff' !_ [] = []
bff' n xs = combine n xs (bff (2 * n) (drop n xs))
where
-- The "take" portion of the splitAt in the original
-- bff is integrated into this version of combine. That
-- lets us avoid allocating an intermediate list we don't
-- really need.
combine :: Int -> [a] -> [Tree a] -> [Tree a]
combine 0 !_ ~[] = [] -- These two lazy patterns are just documentation
combine _k [] ~[] = []
combine k (y : ys) ts = Node y l r : combine (k - 1) ys dropped
where
(l, ~(r, dropped)) = case ts of -- This lazy pattern matters.
[] -> (Empty, (Empty, []))
t1 : ts' -> (t1, case ts' of
[] -> (Empty, [])
t2 : ts'' -> (t2, ts''))
For the less-lazy variant, replace (!l, ~(!r, dropped)) with (!l, !r, dropped) and adjust the RHS accordingly.
For true industrial strength, forests should be represented using lists strict in their elements:
data SL a = Cons !a (SL a) | Nil
And the pairs in the above (l, ~(r, dropped)) should both be represented using a type like
data LSP a b = LSP !a b
This should avoid some (pretty cheap) run-time checks. More importantly, it makes it easier to see where things are and aren't getting forced.
The method that you appear to have chosen is to build the tree up backwards: from bottom-to-top, right-to-left; starting from the last element of your list. This makes your buildBPT function look nice, but requires your insertElement to be overly complex. To construct a binary tree in a breadth-first fashion this way would require some difficult pivots at every step past the first three.
Adding 8 nodes to the tree would require the following steps (see how the nodes are inserted from last to first):
. 4
6 6
8 7 8 . .
. .
3
7 4 5
8 . 6 7 8 .
6 2
7 8 3 4
5 6 7 8
5
6 7 1
8 . . . 2 3
4 5 6 7
8 . . . . . . .
If, instead, you insert the nodes left-to-right, top-to-bottom, you end up with a much simpler solution, requiring no pivoting, but instead some tree structure introspection. See the insertion order; at all times, the existing values remain where they were:
. 1
2 3
1 4 5 . .
. .
1
1 2 3
2 . 4 5 6 .
1 1
2 3 2 3
4 5 6 7
1
2 3 1
4 . . . 2 3
4 5 6 7
8 . . . . . . .
The insertion step has an asymptotic time complexity on the order of O(n^2) where n is the number of nodes to insert, as you are inserting the nodes one-by-one, and then iterating the nodes already present in the tree.
As we insert left-to-right, the trick is to check whether the left sub-tree is complete:
if it is, and the right sub-tree is not complete, then recurse to the right.
if it is, and the right sub-tree is also complete, then recurse to the left (starting a new row).
if it is not, then recurse to the left.
Here is my (more generic) solution:
data Tree a = Leaf | Node a (Tree a) (Tree a)
deriving (Eq, Show)
main = do
let l1 = ["A1-Gate", "North-Region", "South-Region", "Convention Center",
"Rectorate", "Academic Building1", "Academic Building2"]
let l2 = [0.0, 0.5, 0.7, 0.3, 0.6, 1.2, 1.4, 1.2]
print $ treeFromList $ zip l1 l2
mkNode :: a -> Tree a
mkNode x = Node x Leaf Leaf
insertValue :: Tree a -> a -> Tree a
insertValue Leaf y = mkNode y
insertValue (Node x left right) y
| isComplete left && nodeCount left /= nodeCount right = Node x left (insertValue right y)
| otherwise = Node x (insertValue left y) right
where nodeCount Leaf = 0
nodeCount (Node _ left right) = 1 + nodeCount left + nodeCount right
depth Leaf = 0
depth (Node _ left right) = 1 + max (depth left) (depth right)
isComplete n = nodeCount n == 2 ^ (depth n) - 1
treeFromList :: (Show a) => [a] -> Tree a
treeFromList = foldl insertValue Leaf
EDIT: more detailed explanation:
The idea is to remember in what order you insert nodes: left-to-right first, then top-to-bottom. I compressed the different cases in the actual function, but you can expand them into three:
Is the left side complete? If not, then insert to the left side.
Is the right side as complete as the left side, which is complete? If not, then insert to the right side.
Both sides are full, so we start a new level by inserting to the left side.
Because the function fills the nodes up from left-to-right and top-to-bottom, then we always know (it's an invariant) that the left side must fill up before the right side, and that the left side can never be more than one level deeper than the right side (nor can it be shallower than the right side).
By following the growth of the second set of example trees, you can see how the values are inserted following this invariant. This is enough to describe the process recursively, so it extrapolates to a list of any size (the recursion is the magic).
Now, how do we determine whether a tree is 'complete'? Well, it is complete if it is perfectly balanced, or if – visually – its values form a triangle. As we are working with binary trees, then the base of the triangle (when filled) must have a number of values equal to a power of two. More specifically, it must have 2^(depth-1) values. Count for yourself in the examples:
depth = 1 -> base = 1: 2^(1-1) = 1
depth = 2 -> base = 2: 2^(2-1) = 2
depth = 3 -> base = 4: 2^(3-1) = 4
depth = 4 -> base = 8: 2^(4-1) = 8
The total number of nodes above the base is one less than the width of the base: 2^(n-1) - 1. The total number of nodes in the complete tree is therefore the number of nodes above the base, plus those of the base, so:
num nodes in complete tree = 2^(depth-1) - 1 + 2^(depth-1)
= 2 × 2^(depth-1) - 1
= 2^depth - 1
So now we can say that a tree is complete if it has exactly 2^depth - 1 non-empty nodes in it.
Because we go left-to-right, top-to-bottom, when the left side is complete, we move to the right, and when the right side is just as complete as the left side (meaning that it has the same number of nodes, which is means that it is also complete because of the invariant), then we know that the whole tree is complete, and therefore a new row must be added.
I originally had three special cases in there: when both nodes are empty, when the left node is empty (and therefore so was the right) and when the right node is empty (and therefore the left could not be). These three special cases are superseded by the final case with the guards:
If both sides are empty, then countNodes left == countNodes right, so therefore we add another row (to the left).
If the left side is empty, then both sides are empty (see previous point).
If the right side is empty, then the left side must have depth 1 and node count 1, meaning that it is complete, and 1 /= 0, so we add to the right side.
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.
I am trying to convert postfix expression to binary tree. My function takes as argument a list of tokens (strings).
Everytime I give the function any input, debugger writes a message: Non-exhaustive patterns in function "add".
My idea was: read a token after token and determine, if it is an operator or an operand. If it is operand, don't save any node to the tree and store the number to the stack. Otherwise I create a node with an operator, pop symbols from stack, set them as children of new node and push the operator to stack.
If the list of strings is empty, functions print the binary tree.
Would someone explain to me, why the function gives non-exhaustive patterns error and how can I fix the function?
data Tree = Leaf String | Empty | Node Tree String Tree deriving (Show)
add :: Tree -> [String] -> [Tree] -> Tree
add (Node l v p) [] stack = (Node l v p)
add Empty (x:xs) []
| x `elem` ["*","-","+"] = add (Leaf x) xs [Leaf x]
| otherwise = add Empty xs [Leaf x]
add Empty (x:xs) (a:b:bs)
| x `elem` ["*","-","+"] = add (Node b x a) xs (Leaf x:a:b:bs)
| otherwise = add Empty xs (Leaf x:a:b:bs)
add (Leaf x) token (a:b:bs)
| x `elem` ["*","-","+"] = add (Node b x a) token (Leaf x:bs)
| otherwise = Leaf x
add (Node l v p) (x:xs) (a:b:bs)
| x `elem` ["*","-","+"] = add (Node b x a) xs (Leaf x:bs)
| otherwise = add (Node l v p) xs (Leaf x:a:b:bs)
parse :: String -> Tree
parse input = add Empty (words (toPostfix input)) []
I've managed to reproduce the error by simple example:
add Empty ["10", "1", "+"] []
The program successfully adds Leaf "10" to the stack, but can't add Leaf "1" to the stack, because the add is called with the following args:
add Empty ["1", "+"] [Leaf "10"]
But it doesn't match any pattern, because add Empty (x:xs) (a:b:bs) expects the third argument to have two Tree elements and a list. Therefore, a pattern that matches third argument as a list with one element is needed. For example, adding:
add Empty (x:xs) [a] = add Empty xs (Leaf x:[a])
fixes the error and prints the following:
Node (Leaf "10") "+" (Leaf "1")
Hope it'll help you to continue with the task, unless you've already solved it :)
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)