Commit d9edaee1 by Giuseppe Castagna

### Working code ... still need to type it.

parent 8796e6aa
 ... ... @@ -120,10 +120,9 @@ let cardinal ( RBtree('a) -> Int ) (* better type: [] -> 0, Any\[] -> [1--*] * (* The though case: deletion *) (* remove the rightmost leave of the tree and return a flag to state whether the resulting tree decreased the the depth of black nodes whether the resulting tree decreased the the depth of black nodes *) let remove_min (RBtree('a)\[] -> [RBtree('a) Bool 'a]) (* black leaf: remove it and flag the depth decrease *) | [ [] [] ] -> ... ... @@ -133,37 +132,78 @@ let cardinal ( RBtree('a) -> Int ) (* better type: [] -> 0, Any\[] -> [1--*] * | ([ l r ] [] )] -> [ [ l r ] `false x ] (* you cannot have a red node with one empty sibling *) | [ ([] Any) | [ ([] Any) | (Any []) ] -> raise "false" raise "impossible" (* red node with at least on empty child : remove it without any flag *) | [ ([] n) | (n []) ] -> [ n `false x ] (* general case of a node with two non empty childs *) | <(c) elem=x>[ l r ] -> | <(c) elem=x>[ l\[] r\[] ] -> let [ ll d e ] = remove_min l in let tree = <(c) elem=x>[ ll r] in let tree = <(c) elem=x>[ ll r ] in if d then (bubble_left tree)@[e] else [ tree `false e ] *) (* BUG TYPE ERROR *) let blackify( (<_ ('a)>'b) -> 'b ) | <_ x>y -> y | _ -> raise "false" let redify( (<_ ('a)>'b) -> 'b ) | <_ x>y -> y (* let bubble_left | <(c) elem=e>[ l r] -> ([ (blackify l) (balance(redify r)) ], c=`black] *) | _ -> raise "impossible" let blackify( (<_ ('a)>'b) -> 'b ) | <_ (x)>y -> y let redify( (<_ ('a)>'b) -> 'b ) | <_ (x)>y -> y (* increase the black depth of the right child of the argument and flag whether the black depth of the tree is still to be incremented *) let bubble_right ( RBtree('a)\[] -> (Btree('a) , Bool) ) | [[ ll\[] [c d]] (e&_) ] -> ( [ [(balance (redify ll)) c] [d e] ] , `true) | <_ ..>[ [] _ ] -> raise "impossible" | <(c) elem=e>[ l r ] -> ([ (balance(redify l)) r ] , (c = `black)) (* increase the right depth of the right child of the argument and flag whether the black depth of the tree is still to be incremented *) let bubble_left ( RBtree('a)\[] -> (Btree('a) , Bool) ) | [ (e&_) [ [a b] ll\[] ] ] -> ( [ [ e a ] [ b (balance (redify ll)) ] ] , `true ) | <_ ..>[ _ [] ] -> raise "impossible" | <(c) elem=e>[ l r ] -> ([ l (balance (redify r)) ], (c = `black)) let remove(x : 'a)(t : RBtree('a) ) : RBtree('a) = let remove_aux(RBtree('a) -> (RBtree('a),Bool) ) | [] -> ([],`false) | <(c) elem=y>[ l r ] & tree -> if (x << y ) then let (ll,d) = remove_aux l in let tree = <(c) elem=y>[ ll r ] in (* we must prove that tree is well-formed *) if d then bubble_left tree else (tree,`false) else if (x >> y) then let (rr,d) = remove_aux r in let tree = <(c) elem=y>[ l rr ] in if d then bubble_right tree else (tree,`false) else (* x = y *) match tree with | <(c) ..>[ [] [] ] -> ([], (c = `black)) | [ ([] y) | (y []) ] -> (blackify y,`false) | <(c) ..>[ l r ] -> let [ ll d z ] = remove_min l in let tree = <(c) elem=z>[ ll r] in if d then bubble_left tree else (tree, `false) in let (sol,_) = remove_aux t in sol \ No newline at end of file
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!