Haskell - Recursively adding node to binary tree and keeping track of its visit count

Question

New to Haskell and working on a little problem.

I am working with a binary tree and want each node in the tree to have a count of how many times it has been visited. To do this I have created the following data type:

I also have the zipper that represents the current node in the tree:

Using this zipper type, I am trying to represent sets as binary search trees. To do this I am going to implement the function below, which takes a value and the zipper and inserts the node with the given value into the tree. It does this by navigating from the current node to the appropriate area in the tree.

will result in the following tree with the current node having the value 1. The root node would have been visited twice.

However, I'm not totally sure on how to implement the addNode function so that I can recursively add the node given into the binary tree whilst keeping track of the number of times the node has been visited. Can someone help with this please?

Answer 1

You probably don't want to have addNode take a zipper. If nodes are inserted in random order, you want to always call addNode from the top of the tree, and a plain recursive solution with no zippers is better.

A zipper-based addNode only makes sense if nodes are added in an order where each added node is "close" to the previous node. However, if this is the case, an unbalanced binary tree is probably a poor choice of data structure. I have trouble imagining a use case where the order of node insertion is such that a zipper-based addNode is efficient and an unbalanced binary tree remains approximately balanced.

If you do decide to forge ahead with a zipper-based addNode, I think you need to rethink what it means to "visit" a node. In your example, you presumably have:

addNode 3 (Leaf, []) = (Node Leaf 3 1 Leaf, [])

meaning the newly created node has been visited once. When you addNode 4 to this, you'd expect to get:

(Node Leaf 4 1 Leaf, [Rt 3 2 Leaf])

since you visit node "3" again and create a new node "4" that's been visited once. But, when you further addNode 2, you have to re-visit node "4" (to determine that "2" is less than "4"), re-visit node "3" (to determine that "2" is also less than "3"), and finally insert the new "2" node giving:

(Node Leaf 2 1 Leaf, [Lt 3 3 (Node Leaf 4 2 Leaf)])

These visit counts differ from what you gave in your question.

Anyway, here are a few thoughts -- again, only if you really decide you want a zipper-based addNode. I think you should divide the problem into two recursive steps. The first recursion should move up the tree to find the appropriate starting point. The second recursion should move down the subtree to perform the actual insertion.

The first recursion is subtle. Consider this tree:

    4
   / \
  3   7
     / \
    6   9

and imagine we are looking at "6" and trying to insert "2". To decide if we need to move up, we need to compare the new node "2" with the current node "6". We also need to look at the direction of the first crumb, and we may need to look at the value of that crumb.

For example, since 2<6 and the first crumb was left, we know we must unconditionally move up, because it's always possible there are smaller numbers to check higher in the tree.

Contrast this with inserting "2" at node "9" instead. We still have 2<9, but since the first crumb is right, we only move up if the parent node's value is also greater than (or equal to) 2. Here, since 2<=7, we move up, but if the "7" had been "1" instead, we would have ended the first recursion and inserted the "2" into the subtree at node "9".

Basically, we move up as long as (1) we are less than the current node and either the first crumb is left or we are less than or equal to the first crumb; or (2) we are greater than the current node and either the first crumb is right or we are greater than or equal to the first crumb.

You'll need to decide if "visiting" a node means moving up to it and/or if checking the crumb direction and value of a crumb without moving up to it should count.

Once we finish moving up according to these conditions, we can proceed to insert the new node in the current subtree, moving down in the usual manner.

If you'd like to give this a try, you might start with the following template:

addNode:: Ord a => a -> Zipper a -> Zipper a
addNode x = insertDown . upToSubtree
  where
    upToSubtree z@(_, []) = z        -- at root, so we're done moving up
    upToSubtree z@(Leaf, _) = ...    -- unconditionally move up
    upToSubtree z@(Node l y n r, (crumb:crumbs))
      =  case compare x y of
          LT -> case crumb of
            Lt _ _ _ -> ...              -- move up, regardless of crumb value
            Rt u _ _ | x<=u -> ...       -- move up only if x <= crumb
                     | otherwise -> ...  -- don't move up, but count visit to crumb?
          GT -> case crumb of
            Rt _ _ _ -> ...              -- move up, regardless of crumb value
            Lt u _ _ | x>=u -> ...       -- move up only if x >= crumb
                     | otherwise -> ...  -- don't move up, but count visit to crumb?
          EQ -> ...                      -- don't move up

    insertDown (Leaf, crumbs) = ...      -- insert new node
    insertDown (Node l y n r, crumbs)
      = case compare x y of
          LT -> ... go left and recurse ...
          GT -> ... go right and recruse ...
          -- don't insert duplicates, but consider as visited
          EQ -> ... note visit ...

SPOILERS

Below is the full solution I came up with. I haven't tested it very extensively. My intention is to count each comparison with a node on the way up as a visit and each comparison with a node on the way down as a visit, but avoid double-counting the visits to the node returned by upToSubtree, even though the code below actually does two comparisons against that node in most cases. I doubt the logic is 100% correct.

.

.

.

data BTree a = Leaf | Node (BTree a) a Int (BTree a) deriving (Show)
data Direction a = Lt a Int (BTree a) | Rt a Int (BTree a) deriving (Show)
type Breadcrumbs a = [Direction a]
type Zipper a = (BTree a, Breadcrumbs a)

addNode:: Ord a => a -> Zipper a -> Zipper a
addNode x = insertDown . upToSubtree
  where
    upToSubtree z@(_, []) = z
    upToSubtree z@(Leaf, _) = up z
    upToSubtree z@(Node l y n r, (crumb:crumbs))
      =  let z' = visit z  -- count visit for this comparison
      in case compare x y of
          LT -> case crumb of
            Lt _ _ _ -> up z'
            Rt u _ _ | x <= u -> up z'
                     -- we note comparison with parent, visit of this node counted by insertDown
                     | otherwise -> visitParent z
          GT -> case crumb of
            Rt _ _ _ -> up z'
            Lt u _ _ | x >= u -> up z'
                     -- we note comparison with parent, visit of this node counted by insertDown
                     | otherwise -> visitParent z
          EQ -> z -- visit will be counted by insertDown

    up (t, Lt y n r : crumbs) = upToSubtree (Node t y n r, crumbs)
    up (t, Rt y n l : crumbs) = upToSubtree (Node l y n t, crumbs)

    insertDown (Leaf, crumbs) = (Node Leaf x 1 Leaf, crumbs)
    insertDown (Node l y n r, crumbs)
      = case compare x y of
          LT -> insertDown (l, Lt y (n+1) r : crumbs)
          GT -> insertDown (r, Rt y (n+1) l : crumbs)
          -- don't insert duplicates, but consider as visited
          EQ -> (Node l y (n+1) r, crumbs)

    visit (Node l x n r, crumbs) = (Node l x (n+1) r, crumbs)
    visitParent (t, Lt x n r : crumbs) = (t, Lt x (n+1) r : crumbs)
    visitParent (t, Rt x n l : crumbs) = (t, Rt x (n+1) l : crumbs)

main = do
  print $ addNode 2 $ addNode 4 $ addNode 3 (Leaf,[])
  -- adding "2" to my ASCII tree example at node "9"
  print $ addNode 2 $ (Node Leaf 9 0 Leaf,
                       [ Rt 7 0 (Node Leaf 6 0 Leaf)
                       , Rt 4 0 (Node Leaf 3 0 Leaf)])
  -- adding "2" to my ASCII tree example at node "6"
  print $ addNode 2 $ (Node Leaf 6 0 Leaf,
                       [ Lt 7 0 (Node Leaf 9 0 Leaf)
                       , Rt 4 0 (Node Leaf 3 0 Leaf)])