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--*] * ... @@ -120,10 +120,9 @@ let cardinal ( RBtree('a) -> Int ) (* better type: [] -> 0, Any\[] -> [1--*] * (* The though case: deletion *) (* The though case: deletion *) (* remove the rightmost leave of the tree and return a flag to state (* 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]) let remove_min (RBtree('a)\[] -> [RBtree('a) Bool 'a]) (* black leaf: remove it and flag the depth decrease *) (* black leaf: remove it and flag the depth decrease *) | [ [] [] ] -> | [ [] [] ] -> ... @@ -133,37 +132,78 @@ let cardinal ( RBtree('a) -> Int ) (* better type: [] -> 0, Any\[] -> [1--*] * ... @@ -133,37 +132,78 @@ let cardinal ( RBtree('a) -> Int ) (* better type: [] -> 0, Any\[] -> [1--*] * | ([ l r ] [] )] -> | ([ l r ] [] )] -> [ [ l r ] `false x ] [ [ l r ] `false x ] (* you cannot have a red node with one empty sibling *) (* you cannot have a red node with one empty sibling *) | [ ([] Any) | [ ([] Any) | (Any []) ] -> | (Any []) ] -> raise "false" raise "impossible" (* red node with at least on empty child : remove it without any flag *) (* red node with at least on empty child : remove it without any flag *) | [ ([] n) | (n []) ] -> | [ ([] n) | (n []) ] -> [ n `false x ] [ n `false x ] (* general case of a node with two non empty childs *) (* 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 [ 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 if d then (bubble_left tree)@[e] (bubble_left tree)@[e] else else [ tree `false e ] [ tree `false e ] *) | _ -> raise "impossible" let blackify( (<_ ('a)>'b) -> 'b ) (* BUG TYPE ERROR *) | <_ (x)>y -> y let blackify( (<_ ('a)>'b) -> 'b ) let redify( (<_ ('a)>'b) -> 'b ) | <_ x>y -> y | <_ (x)>y -> y | _ -> raise "false" let redify( (<_ ('a)>'b) -> 'b ) (* increase the black depth of the right child of the argument and | <_ x>y -> y flag whether the black depth of the tree is still to be incremented *) (* let bubble_right ( RBtree('a)\[] -> (Btree('a) , Bool) ) let bubble_left | [[ ll\[] [c d]] (e&_) ] -> | <(c) elem=e>[ l r] -> ( [ [(balance (redify ll)) c] ([ (blackify l) (balance(redify r)) ], c=`black] [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!