Commit f1ec721f authored by POTTIER Francois's avatar POTTIER Francois

Added [MyMap], which is analogue to [MySet],

although the specification of [add] is more complex.
parent 47fe09d2
module Make (Ord: Map.OrderedType) =
type key = Ord.t
type 'a t =
| Node of 'a t * key * 'a * 'a t * int
let height = function
Empty -> 0
| Node(_,_,_,_,h) -> h
let create l x d r =
let hl = height l and hr = height r in
Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
let bal l x d r =
let hl = match l with Empty -> 0 | Node(_,_,_,_,h) -> h in
let hr = match r with Empty -> 0 | Node(_,_,_,_,h) -> h in
if hl > hr + 2 then begin
match l with
Empty -> invalid_arg "Map.bal"
| Node(ll, lv, ld, lr, _) ->
if height ll >= height lr then
create ll lv ld (create lr x d r)
else begin
match lr with
Empty -> invalid_arg "Map.bal"
| Node(lrl, lrv, lrd, lrr, _)->
create (create ll lv ld lrl) lrv lrd (create lrr x d r)
end else if hr > hl + 2 then begin
match r with
Empty -> invalid_arg "Map.bal"
| Node(rl, rv, rd, rr, _) ->
if height rr >= height rl then
create (create l x d rl) rv rd rr
else begin
match rl with
Empty -> invalid_arg "Map.bal"
| Node(rll, rlv, rld, rlr, _) ->
create (create l x d rll) rlv rld (create rlr rv rd rr)
end else
Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
(* [add x data f t] returns [t] (physically unchanged) if [x] is already a
member of [t] and the function [f] does not modify the data associated
with [x]. *)
let rec add x data f = function
| Empty ->
(* New binding of [x] to [f data]. *)
Node (Empty, x, f data, Empty, 1)
| Node(l, v, d, r, h) as t ->
let c = x v in
if c = 0 then
(* Existing key. Call [f]. *)
let d' = f d in
if d == d' then
(* [f] requests no change. Return the tree unchanged. *)
(* [f] requests a change. Build a new tree node. *)
Node(l, v, d', r, h)
else if c < 0 then
let l' = add x data f l in
if l == l' then t
else bal l' v d r
let r' = add x data f r in
if r == r' then t
else bal l v d r'
let empty = Empty
let rec find x = function
Empty -> raise Not_found
| Node(l, v, d, r, _) ->
let c = x v in
if c = 0 then d
else find x (if c < 0 then l else r)
let rec iter f = function
Empty -> ()
| Node(l, v, d, r, _) -> iter f l; f v d; iter f r
(* This is a stripped-down copy of the [Map] module from OCaml's standard
library. The only difference is that [add x d f m] takes both a datum
[default] and a function [f] of data to data. If the key [x] is absent in the
map [m], then a mapping of [x] to [f default] is added. If the key [x] is
present, then the existing datum if passed to [f], which produces a new
datum. If the old and new data are physically the same, then the map [m] is
returned, physically unchanged. Otherwise, an updated map is returned. This
yields fewer memory allocations and an easy way of testing whether the
binding was already present in the set before it was added. *)
module Make (Ord: Map.OrderedType) : sig
type key = Ord.t
type 'a t
val empty: 'a t
val add: key -> 'a -> ('a -> 'a) -> 'a t -> 'a t
val find: key -> 'a t -> 'a (* may raise [Not_found] *)
val iter: (key -> 'a -> unit) -> 'a t -> unit
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