[Haskell-beginners] Tying the knot with binary trees

David McBride toad3k at gmail.com
Fri Apr 13 19:52:05 CEST 2012


Sorry this snippet should have been:

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

I did not test that code, but it should work.

On Fri, Apr 13, 2012 at 1:49 PM, David McBride <toad3k at gmail.com> wrote:
> 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



More information about the Beginners mailing list