Building a Binary Tree (not BST) in Haskell Breadth-First

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.