~ubuntu-branches/ubuntu/lucid/camomile/lucid

« back to all changes in this revision

Viewing changes to internal/avlTree.ml

  • Committer: Bazaar Package Importer
  • Author(s): Sylvain Le Gall
  • Date: 2005-12-03 01:18:55 UTC
  • Revision ID: james.westby@ubuntu.com-20051203011855-qzvwlld1xyqnl62t
Tags: upstream-0.6.3
ImportĀ upstreamĀ versionĀ 0.6.3

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
(* $Id: avlTree.ml,v 1.2 2003/06/08 04:50:48 yori Exp $ *)
 
2
(* Copyright 2003 Yamagata Yoriyuki. distributed with LGPL *)
 
3
 
 
4
type 'a tree = Empty | Node of 'a tree * 'a * 'a tree * int
 
5
 
 
6
let empty = Empty
 
7
 
 
8
let is_empty = function Empty -> true | _ -> false
 
9
 
 
10
let singleton_tree x = Node (Empty, x, Empty, 1)
 
11
 
 
12
let left_branch = function
 
13
    Empty -> raise Not_found
 
14
  | Node (l, _, _, _) -> l
 
15
 
 
16
let right_branch = function
 
17
    Empty -> raise Not_found
 
18
  | Node (_, _, r, _) -> r
 
19
 
 
20
let root = function
 
21
    Empty -> raise Not_found
 
22
  | Node (_, v, _, _) -> v
 
23
 
 
24
let height = function
 
25
    Empty -> 0
 
26
  | Node (_, _, _, h) -> h
 
27
 
 
28
let create l v r =
 
29
  let h' = 1 + max (height l) (height r) in
 
30
  Node (l, v, r, h')
 
31
 
 
32
let rec make_tree l v r =
 
33
  let hl = height l in
 
34
  let hr = height r in
 
35
  if hl >= hr + 2 then
 
36
    match l with
 
37
      Empty -> assert false
 
38
    | Node (ll, u, lr, _) ->
 
39
        create ll u (make_tree lr v r)
 
40
  else if hr >= hl + 2 then
 
41
    match r with
 
42
      Empty -> assert false
 
43
    | Node (rl, u, rr, _) ->
 
44
        create (make_tree l v rl) u rr
 
45
  else
 
46
    create l v r
 
47
 
 
48
(* Utilities *)
 
49
let rec split_leftmost = function
 
50
    Empty -> raise Not_found
 
51
  | Node (Empty, v, r, _) -> (v, r)
 
52
  | Node (l, v, r, _) ->
 
53
      let v0, l' = split_leftmost l in
 
54
      (v0, make_tree l' v r)
 
55
 
 
56
let rec split_rightmost = function
 
57
    Empty -> raise Not_found
 
58
  | Node (l, v, Empty, _) -> (v, l)
 
59
  | Node (l, v, r, _) ->
 
60
      let v0, r' = split_rightmost r in
 
61
      (v0, make_tree l v r')
 
62
 
 
63
let rec concat t1 t2 =
 
64
  match t1, t2 with
 
65
    Empty, _ -> t2
 
66
  | _, Empty -> t1
 
67
  | Node (l1, v1, r1, h1), Node (l2, v2, r2, h2) ->
 
68
      if h1 < h2 then
 
69
        make_tree (concat t1 l2) v2 r2
 
70
      else
 
71
        make_tree l1 v1 (concat r1 t2)
 
72
 
 
73
let rec iter proc = function
 
74
    Empty -> ()
 
75
  | Node (l, v, r, _) ->
 
76
      iter proc l;
 
77
      proc v;
 
78
      iter proc r
 
79
 
 
80
let rec fold f t init =
 
81
  match t with
 
82
    Empty -> init
 
83
  | Node (l, v, r, _) ->
 
84
      let x = fold f l init in
 
85
      let x = f v x in
 
86
      fold f r x