Subversion Repositories Kolibri OS

Rev

Rev 7693 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
7696 akron1 1 
(*
7597 akron1 2 
    BSD 2-Clause License
3 
 
7696 akron1 4 
    Copyright (c) 2018-2019, Anton Krotov
7597 akron1 5 
    All rights reserved.
6 
*)
7 
 
7693 akron1 8 
MODULE AVLTREES;
7597 akron1 9 
 
10 
IMPORT C := COLLECTIONS;
11 
 
12 
 
13 
TYPE
14 
 
15 
    DATA* = POINTER TO RECORD (C.ITEM) END;
16 
 
17 
    NODE* = POINTER TO RECORD (C.ITEM)
18 
 
19 
        data*: DATA;
20 
 
21 
        height: INTEGER;
22 
 
23 
        left*, right*: NODE
24 
 
25 
    END;
26 
 
27 
    CMP* = PROCEDURE (a, b: DATA): INTEGER;
28 
 
29 
    DESTRUCTOR* = PROCEDURE (VAR data: DATA);
30 
 
31 
 
32 
VAR
33 
 
34 
    nodes: C.COLLECTION;
35 
 
36 
 
37 
PROCEDURE NewNode (data: DATA): NODE;
38 
VAR
39 
    node:  NODE;
40 
    citem: C.ITEM;
41 
 
7693 akron1 42 
BEGIN
7597 akron1 43 
    citem := C.pop(nodes);
44 
    IF citem = NIL THEN
45 
        NEW(node)
46 
    ELSE
47 
        node := citem(NODE)
48 
    END;
49 
 
50 
    node.data := data;
51 
    node.left := NIL;
52 
    node.right := NIL;
53 
    node.height := 1
54 
 
55 
    RETURN node
56 
END NewNode;
57 
 
58 
 
59 
PROCEDURE height (p: NODE): INTEGER;
60 
VAR
61 
    res: INTEGER;
62 
 
63 
BEGIN
64 
    IF p = NIL THEN
65 
        res := 0
66 
    ELSE
67 
        res := p.height
68 
    END
69 
 
70 
    RETURN res
71 
END height;
72 
 
73 
 
74 
PROCEDURE bfactor (p: NODE): INTEGER;
75 
    RETURN height(p.right) - height(p.left)
76 
END bfactor;
77 
 
78 
 
79 
PROCEDURE fixheight (p: NODE);
80 
BEGIN
81 
    p.height := MAX(height(p.left), height(p.right)) + 1
82 
END fixheight;
83 
 
84 
 
85 
PROCEDURE rotateright (p: NODE): NODE;
86 
VAR
87 
    q: NODE;
88 
 
89 
BEGIN
90 
    q := p.left;
91 
    p.left := q.right;
92 
    q.right := p;
93 
    fixheight(p);
94 
    fixheight(q)
95 
 
96 
    RETURN q
97 
END rotateright;
98 
 
99 
 
100 
PROCEDURE rotateleft (q: NODE): NODE;
101 
VAR
102 
    p: NODE;
103 
 
104 
BEGIN
105 
    p := q.right;
106 
    q.right := p.left;
107 
    p.left := q;
108 
    fixheight(q);
109 
    fixheight(p)
110 
 
111 
    RETURN p
112 
END rotateleft;
113 
 
114 
 
115 
PROCEDURE balance (p: NODE): NODE;
116 
VAR
117 
    res: NODE;
118 
 
119 
BEGIN
120 
    fixheight(p);
121 
 
122 
    IF bfactor(p) = 2 THEN
123 
        IF bfactor(p.right) < 0 THEN
124 
            p.right := rotateright(p.right)
125 
        END;
126 
        res := rotateleft(p)
127 
 
128 
    ELSIF bfactor(p) = -2 THEN
129 
        IF bfactor(p.left) > 0 THEN
130 
            p.left := rotateleft(p.left)
131 
        END;
132 
        res := rotateright(p)
133 
 
134 
    ELSE
135 
        res := p
136 
    END
137 
 
138 
    RETURN res
139 
END balance;
140 
 
141 
 
142 
PROCEDURE insert* (p: NODE; data: DATA; cmp: CMP; VAR newnode: BOOLEAN; VAR node: NODE): NODE;
143 
VAR
144 
    res: NODE;
145 
    rescmp: INTEGER;
146 
 
147 
BEGIN
148 
    IF p = NIL THEN
149 
        res := NewNode(data);
150 
        node := res;
151 
        newnode := TRUE
152 
    ELSE
153 
 
154 
        rescmp := cmp(data, p.data);
155 
        IF rescmp < 0 THEN
156 
            p.left := insert(p.left, data, cmp, newnode, node);
157 
            res := balance(p)
158 
        ELSIF rescmp > 0 THEN
159 
            p.right := insert(p.right, data, cmp, newnode, node);
160 
            res := balance(p)
161 
        ELSE
162 
            res := p;
163 
            node := res;
164 
            newnode := FALSE
165 
        END
166 
 
167 
    END
168 
 
169 
    RETURN res
170 
END insert;
171 
 
172 
 
173 
PROCEDURE destroy* (VAR node: NODE; destructor: DESTRUCTOR);
174 
VAR
175 
    left, right: NODE;
176 
 
177 
BEGIN
178 
    IF node # NIL THEN
179 
        left  := node.left;
180 
        right := node.right;
181 
 
182 
        IF destructor # NIL THEN
183 
            destructor(node.data)
7693 akron1 184 
        END;
185 
 
7597 akron1 186 
        C.push(nodes, node);
187 
        node := NIL;
188 
 
189 
        destroy(left, destructor);
190 
        destroy(right, destructor)
191 
    END
192 
END destroy;
193 
 
194 
 
195 
BEGIN
196 
    nodes := C.create()
7696 akron1 197 
END AVLTREES.