[Haskell-beginners] Tying the knot with binary trees

[David McBride]

You are right that the problem is with your insert algorithm.  When
you are inserting, what you are doing is you traverse down the correct
side of the tree, you make a new node and then you return that node,
thereby trashing the rest of the tree.

Here is the general approach of what you should do.  You know you are
going left or right down the tree, and you know you are probably going
to change it, that means you have to change every node down along the
length of the tree.

insert v' Leaf = mkRoot v'
insert v' n@(Node v l r f) = case compare v v' of
  EQ -> n
  GT -> (Node v (insert v' l) r f)
  LT -> (Node v l (insert v' r) f)

The only problem with this is that the parent node is not getting set
with this algorithm.  The problem is that Leaves do not know their
parents, so one solution is to change your data type to this:

data BinTree a =
  Leaf { lfather :: BinTree a } |
  Node { value :: a
          , left :: BinTree a
          , right :: BinTree a
          , father :: BinTree a
  }

then insert would become
insert v' (Leaf parent) = let result = Node v' (Leaf result) (Leaf
result) parent
insert v' n = ...

Otherwise you'll have to pass the parent down along the tree as you
modify it as such:

insert v' Leaf = mkRoot v'
insert v' n@(Node v l r f) = case compare v v' of
  EQ -> n
  GT -> (Node v (insert' v' l n) r f)
  LT -> (Node v l (insert' v' r n) f)

insert' v' Leaf parent = Node v' Leaf Leaf parent
insert' v' n@(Node v l r f) parent = case compare v v' of
  EQ -> n
  GT -> let result = Node v (insert' v' l result) r parent in result
  LT -> let result = Node v l (insert' v' r result) parent in result

You require a base case because the first node has no parent to insert with.

On Fri, Apr 13, 2012 at 12:16 PM, Michael Schober <Micha-Schober at web.de> wrote:
> Hi folk,
>
> as an exercise I'm trying to write a binary tree whose nodes also include a
> reference to its parent. I've got the data structure I want to use and some
> helper functions, but there seems to be a bug in insert or find or both
> (although I assume it's in insert).
>
> Here's what I got so far:
>
> data BinTree a = Leaf
>  | Node { value :: a
>         , left :: BinTree a
>         , right :: BinTree a
>         , father :: BinTree a
>         }
>
> instance Show a => Show (BinTree a) where
>  show Leaf = "[]"
>  show (Node v l r _) = "(Node " ++ show v
>                     ++ " " ++ show l ++ " " ++ show r ++ ")"
>
> mkRoot :: a -> BinTree a
> mkRoot value = let root = Node value Leaf Leaf root
>               in root
>
> member :: Ord a => a -> BinTree a -> Bool
> member v Leaf = False
> member v (Node v' l r _) =
>  if v == v' then True
>  else if v <= v' then member v l
>       else member v r
>
> find :: Ord a => a -> BinTree a -> Maybe (BinTree a)
> find v Leaf = Nothing
> find v n@(Node v' l r _) =
>  if v == v' then Just n
>  else if v <= v' then find v l
>       else find v r
>
> insert :: Ord a => a -> BinTree a -> BinTree a
> insert v' Leaf = mkRoot v'
> insert v' n@(Node v l r f) = insert' v' n f
>  where
>    insert' :: Ord a => a -> BinTree a -> BinTree a -> BinTree a
>    insert' v' Leaf f' = Node v' Leaf Leaf f'
>    insert' v' n@(Node v l r f) f' =
>      if v' == v then n
>      else if v' <= v
>           then let inserted = insert' v' l result
>                    result = Node v inserted r f
>                in  result
>           else let inserted = insert' v' r result
>                    result = Node v l inserted f
>                in  result
>
> I thought this should do the trick, but here's what I get in ghci:
>
> *Main> find 3 (insert 7 (insert 3 (insert 5 Leaf))) >>= return . parent
> Just (Node 5 (Node 3 [] []) [])
>
> I'm expecting to see
>
> Just (Node 5 (Node 3 [] []) (Node 7 [] []))
>
> Inserting into an empty tree (i.e. a leaf) works fine, as does mkRoot. Also,
> it seems as inserting an existing value works fine as well - but obviously I
> couldn't test that one exhaustingly so far.
>
> I'm grateful for any pointers towards a solution.
>
> Best regards,
> Michael
>
> P.S.: For those unfamiliar with this problem, here is a list of URLs of what
> I read of the subject:
> [1]
> http://www.haskell.org/haskellwiki/Tying_the_Knot#Migrated_from_the_old_wiki
> [2]
> http://debasishg.blogspot.de/2009/02/learning-haskell-solving-josephus.html
> [3] http://blog.sigfpe.com/2006/12/tying-knots-generically.html
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners