aboutsummaryrefslogtreecommitdiff
path: root/splay.ml
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2017-11-24 09:22:24 +0100
committerSébastien Dailly <sebastien@chimrod.com>2017-11-24 09:23:38 +0100
commita6b5a6bdd138a5ccc6827bcc73580df1e9218820 (patch)
treeff577395c1a5951a61a7234322f927f6ead5ee29 /splay.ml
parentecb6fd62c275af03a07d892313ab3914d81cd40e (diff)
Moved all the code to src directory
Diffstat (limited to 'splay.ml')
-rw-r--r--splay.ml142
1 files changed, 0 insertions, 142 deletions
diff --git a/splay.ml b/splay.ml
deleted file mode 100644
index ec5750c..0000000
--- a/splay.ml
+++ /dev/null
@@ -1,142 +0,0 @@
-module type KEY = sig
-
- type 'a t
-
- val comp: 'a t -> 'b t -> ('a, 'b) Tools.cmp
-
- val repr: Format.formatter -> 'a t -> unit
-
-end
-
-module Make (El : KEY) = struct
-
- type 'a elem = 'a El.t
-
- type leaf (** Fantom type for typing the tree *)
- type node (** Fantom type for typing the tree *)
-
- type 'a treeVal =
- | Leaf : leaf treeVal
- | Node : _ treeVal * ('a elem * 'a) * _ treeVal -> node treeVal
-
- type t = T : 'a treeVal ref -> t [@@unboxed]
-
- let empty = T (ref Leaf)
-
- let isEmpty (T tree) = match !tree with
- | Leaf -> true
- | _ -> false
-
- let rec splay : type a. a elem -> node treeVal -> node treeVal = fun x t -> begin
- let Node (l, y, r) = t in
- begin match El.comp x (fst y) with
- | Tools.Eq -> t
- | Tools.Lt ->
- begin match l with
- | Leaf -> t
- | Node (ll, z, rr) ->
- begin match El.comp x (fst z) with
- | Tools.Eq -> Node (ll, z, Node (rr, y, r))
- | Tools.Lt ->
- begin match ll with
- | Leaf -> Node (ll, z, Node (rr, y, r))
- | Node _ as ll ->
- let Node (newL, newV, newR) = splay x ll
- in Node (newL, newV, Node (newR, z, Node (rr, y, r)))
- end
- | Tools.Gt ->
- begin match rr with
- | Leaf -> Node (ll, z, Node (rr, y, r))
- | Node _ as rr ->
- let Node (newL, newV, newR) = splay x rr
- in Node (Node (ll, z, newL), newV, Node (newR, y, r))
- end
- end
- end
- | Tools.Gt ->
- begin match r with
- | Leaf -> t
- | Node (ll, z, rr) ->
- begin match El.comp x (fst z) with
- | Tools.Eq -> Node (Node (l, y, ll), z, rr)
- | Tools.Lt ->
- begin match ll with
- | Leaf -> Node (Node (l, y, ll), z, rr)
- | Node _ as ll ->
- let Node (newL, newV, newR) = splay x ll
- in Node (Node (l, y, newL), newV, Node (newR, z, rr))
- end
- | Tools.Gt ->
- begin match rr with
- | Leaf -> Node (Node (l, y, ll), z, rr)
- | Node _ as rr ->
- let Node (newL, newV, newR) = splay x rr
- in Node (Node (Node(l, y, ll), z, newL), newV, newR)
- end
- end
- end
- end
- end
-
- let member: type a. a elem -> t -> bool = fun x (T t) -> match !t with
- | Leaf -> false
- | Node _ as root ->
- let root' = splay x root in
- t := root';
- let Node (_, c', _) = root' in
- begin match El.comp (fst c') x with
- | Tools.Eq -> true
- | _ -> false
- end
-
- let find: type a. a elem -> t -> a = fun x (T t) -> match !t with
- | Leaf -> raise Not_found
- | Node _ as root ->
- let root' = splay x root in
- t := root';
- let Node (_, c', _) = root' in
- begin match El.comp (fst c') x with
- | Tools.Eq -> snd c'
- | _ -> raise Not_found
- end
-
- let add: type a. a elem -> a -> t -> t = fun key value (T t) -> match !t with
- | Leaf -> T (ref (Node (Leaf, (key, value), Leaf)))
- | Node _ as root ->
- let root' = splay key root in
- let Node (l, y, r) = root' in
- begin match El.comp key (fst y) with
- | Tools.Eq -> T (ref root')
- | Tools.Lt -> T (ref (Node (l, (key, value), Node (Leaf, y, r))))
- | Tools.Gt -> T (ref (Node (Node (l, y, Leaf), (key, value), r)))
- end
-
- let repr formatter (T t) = begin
-
- let repr_edge from formatter dest = begin
- Format.fprintf formatter "\"%a\" -> \"%a\"\n"
- El.repr from
- El.repr dest
- end in
-
- let rec repr': type a b. a El.t -> Format.formatter -> b treeVal -> unit = fun parent formatter -> function
- | Leaf -> ()
- | Node (l, c, r) ->
- let key = fst c in
- Format.fprintf formatter "%a%a%a"
- (repr_edge parent) key
- (repr' key) l
- (repr' key) r in
-
- begin match !t with
- | Leaf -> Format.fprintf formatter "digraph G {}"
- | Node (l, c, r) ->
- let key = fst c in
- Format.fprintf formatter "digraph G {\n%a%a}"
- (repr' key) l
- (repr' key) r
- end
-
- end
-
-end