[Haskell-beginners] Tying the knot with binary trees

Markus Läll markus.l2ll at gmail.com
Sat Apr 14 18:31:30 CEST 2012


Hi Michael

When you have a tree with nodes pointing back to their parents then
you essentially have a graph. If you plan to change that graph, then
you have to rebuild *the entire structure*, and there's no going
around that. (And you cant use any of the nodes you pattern match,
only the numbers.)

They say that for this or similar reasons you have to use a zipper,
but I know nothing more about them than this :-)

On Sat, Apr 14, 2012 at 3:04 PM, Michael Schober <Micha-Schober at web.de> wrote:
> Hi again,
>
> thanks for your comments. I've tried your code, but unfortunately that
> doesn't seem to do the trick.
>
>
> 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 = ...
>
>
> I was reluctant to this version at first, but I gave it a try. You can find
> it attached in the alt-linked-tree.hs (I hope it's okay to attach code in
> files, but the code grew beyond snippetery and this way it's probably more
> comfortable to test it).
>
> Unfortunately, this doesn't work as well. The actual insert code in this
> version looks like this:
>
> -- inserts an element into a binary search tree
>
> insert :: Ord a => a -> BinTree a -> BinTree a
> insert v' (Leaf parent) =
>  let result = Node v' (Leaf result) (Leaf result) parent
>  in result
> insert v' n@(Node v l r p) =
>  case compare v' v of
>    EQ -> n
>    LT -> let inserted = insert v' l
>              result = Node v inserted r p
>          in result
>    GT -> let inserted = insert v' r
>              result = Node v l inserted p
>          in result
>
> I think the problem here is, that I don't modify the parent, but I cannot
> seem to wrap my head around it today.
>
>
>>> 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.
>
>
> This looks pretty much like my code from the beginning, but it doesn't work
> as well. However, in the meantime I played around with some complexer trees
> to come across a deficit pattern, but it's really strange. It seems to me as
> if random subtrees are missing. Sometimes there are siblings as expected,
> sometimes even children of these siblings, but there never seems to be a
> working tree.
>
> I have an intuition that it could be the case that I have to modify the
> parent as well in the recursive case, but I don't know how yet.
>
> Anyway, I'll let it go for the weekend and return to doubly linked lists for
> now. Maybe implementing more features for those will help me get a better
> intuition for these kind of problems.
>
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>



-- 
Markus Läll



More information about the Beginners mailing list