Commit d9edaee1 authored by Giuseppe Castagna's avatar Giuseppe Castagna
Browse files

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 *)
| <black elem=x>[ [] [] ] -> | <black elem=x>[ [] [] ] ->
...@@ -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--*] *
| (<red elem=y>[ l r ] [] )] -> | (<red elem=y>[ l r ] [] )] ->
[ <black elem=y>[ l r ] `false x ] [ <black elem=y>[ l r ] `false x ]
(* you cannot have a red node with one empty sibling *) (* you cannot have a red node with one empty sibling *)
| <black elem=x>[ ([] <red ..>Any) | <black elem=Any>[ ([] <red ..>Any)
| (<red ..>Any []) ] -> | (<red ..>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 *)
| <red elem=x>[ ([] n) | (n []) ] -> | <red elem=x>[ ([] 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) -> <black ('a)>'b )
(* BUG TYPE ERROR *) | <_ (x)>y -> <black (x)>y
let blackify( (<_ ('a)>'b) -> <black ('a)>'b ) let redify( (<_ ('a)>'b) -> <red ('a)>'b )
| <_ x>y -> <black x>y | <_ (x)>y -> <red (x)>y
| _ -> raise "false"
let redify( (<_ ('a)>'b) -> <black ('a)>'b ) (* increase the black depth of the right child of the argument and
| <_ x>y -> <red x>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 | <black elem=y>[<red elem=x>[ ll\[] <black elem=re>[c d]] (e&<black ..>_) ] ->
| <(c) elem=e>[ l r] -> ( <black elem=re>[ <black elem=x>[(balance (redify ll)) c]
(<black elem=e>[ (blackify l) (balance(redify r)) ], c=`black] <black elem=y>[d e]
] , `true)
*) | <_ ..>[ [] _ ] ->
raise "impossible"
| <(c) elem=e>[ l r ] ->
(<black elem=e>[ (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) )
| <black elem=z>[ (e&<black ..>_) <red elem=x>[ <black elem=w>[a b] ll\[] ] ] ->
( <black elem=w>[ <black elem=z>[ e a ]
<black elem=x>[ b (balance (redify ll)) ]
] , `true )
| <_ ..>[ _ [] ] ->
raise "impossible"
| <(c) elem=e>[ l r ] ->
(<black elem=e>[ 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))
| <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!
Please register or to comment