Commit | Line | Data |
---|---|---|
b74e26bb | 1 | ;;; avl-tree.el --- balanced binary trees, AVL-trees |
1e38b8ff | 2 | |
b74e26bb | 3 | ;; Copyright (C) 1995, 2007 Free Software Foundation, Inc. |
1e38b8ff TTN |
4 | |
5 | ;; Author: Per Cederqvist <ceder@lysator.liu.se> | |
6 | ;; Inge Wallin <inge@lysator.liu.se> | |
b74e26bb TTN |
7 | ;; Thomas Bellman <bellman@lysator.liu.se> |
8 | ;; Maintainer: FSF | |
9 | ;; Created: 10 May 1991 | |
10 | ;; Keywords: extensions, data structures | |
1e38b8ff | 11 | |
b74e26bb | 12 | ;; This file is part of GNU Emacs. |
1e38b8ff | 13 | |
b74e26bb TTN |
14 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
15 | ;; it under the terms of the GNU General Public License as published by | |
16 | ;; the Free Software Foundation; either version 3, or (at your option) | |
17 | ;; any later version. | |
1e38b8ff | 18 | |
b74e26bb TTN |
19 | ;; GNU Emacs is distributed in the hope that it will be useful, |
20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 | ;; GNU General Public License for more details. | |
1e38b8ff | 23 | |
b74e26bb TTN |
24 | ;; You should have received a copy of the GNU General Public License |
25 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
26 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
27 | ;; Boston, MA 02110-1301, USA. | |
1e38b8ff | 28 | |
b74e26bb | 29 | ;;; Commentary: |
1e38b8ff | 30 | |
b74e26bb TTN |
31 | ;; This file combines elib-node.el and avltree.el from Elib. |
32 | ;; | |
33 | ;; * Comments from elib-node.el | |
34 | ;; A node is implemented as an array with three elements, using | |
35 | ;; (elt node 0) as the left pointer | |
36 | ;; (elt node 1) as the right pointer | |
37 | ;; (elt node 2) as the data | |
38 | ;; | |
39 | ;; Some types of trees, e.g. AVL trees, need bigger nodes, but | |
40 | ;; as long as the first three parts are the left pointer, the | |
41 | ;; right pointer and the data field, these macros can be used. | |
42 | ;; | |
43 | ;; * Comments from avltree.el | |
44 | ;; An AVL tree is a nearly-perfect balanced binary tree. A tree | |
45 | ;; consists of two cons cells, the first one holding the tag | |
85718043 | 46 | ;; 'AVL-TREE in the car cell, and the second one having the tree |
b74e26bb TTN |
47 | ;; in the car and the compare function in the cdr cell. The tree has |
48 | ;; a dummy node as its root with the real tree in the left pointer. | |
49 | ;; | |
50 | ;; Each node of the tree consists of one data element, one left | |
51 | ;; sub-tree and one right sub-tree. Each node also has a balance | |
52 | ;; count, which is the difference in depth of the left and right | |
53 | ;; sub-trees. | |
1e38b8ff | 54 | |
b74e26bb TTN |
55 | ;;; Code: |
56 | ||
5fa11cc2 TTN |
57 | ;;; ================================================================ |
58 | ;;; Functions and macros handling an AVL tree node. | |
59 | ||
60 | (defmacro avl-tree-node-create (left right data balance) | |
61 | ;; Create and return an avl-tree node. | |
62 | `(vector ,left ,right ,data ,balance)) | |
63 | ||
bdf0a828 | 64 | (defmacro avl-tree-node-left (node) |
1e38b8ff | 65 | ;; Return the left pointer of NODE. |
92313548 | 66 | `(aref ,node 0)) |
1e38b8ff | 67 | |
bdf0a828 | 68 | (defmacro avl-tree-node-right (node) |
1e38b8ff | 69 | ;; Return the right pointer of NODE. |
92313548 | 70 | `(aref ,node 1)) |
1e38b8ff | 71 | |
bdf0a828 | 72 | (defmacro avl-tree-node-data (node) |
1e38b8ff | 73 | ;; Return the data of NODE. |
92313548 | 74 | `(aref ,node 2)) |
1e38b8ff | 75 | |
bdf0a828 | 76 | (defmacro avl-tree-node-set-left (node newleft) |
1e38b8ff | 77 | ;; Set the left pointer of NODE to NEWLEFT. |
92313548 | 78 | `(aset ,node 0 ,newleft)) |
1e38b8ff | 79 | |
bdf0a828 | 80 | (defmacro avl-tree-node-set-right (node newright) |
1e38b8ff | 81 | ;; Set the right pointer of NODE to NEWRIGHT. |
92313548 | 82 | `(aset ,node 1 ,newright)) |
1e38b8ff | 83 | |
bdf0a828 | 84 | (defmacro avl-tree-node-set-data (node newdata) |
1e38b8ff | 85 | ;; Set the data of NODE to NEWDATA. |
92313548 | 86 | `(aset ,node 2 ,newdata)) |
1e38b8ff | 87 | |
bdf0a828 | 88 | (defmacro avl-tree-node-branch (node branch) |
1e38b8ff TTN |
89 | ;; Get value of a branch of a node. |
90 | ;; | |
91 | ;; NODE is the node, and BRANCH is the branch. | |
92 | ;; 0 for left pointer, 1 for right pointer and 2 for the data." | |
92313548 | 93 | `(aref ,node ,branch)) |
1e38b8ff | 94 | |
bdf0a828 | 95 | (defmacro avl-tree-node-set-branch (node branch newval) |
1e38b8ff TTN |
96 | ;; Set value of a branch of a node. |
97 | ;; | |
98 | ;; NODE is the node, and BRANCH is the branch. | |
99 | ;; 0 for left pointer, 1 for the right pointer and 2 for the data. | |
100 | ;; NEWVAL is new value of the branch." | |
92313548 | 101 | `(aset ,node ,branch ,newval)) |
1e38b8ff | 102 | |
dfd4af17 | 103 | (defmacro avl-tree-node-balance (node) |
1e38b8ff | 104 | ;; Return the balance field of a node. |
92313548 | 105 | `(aref ,node 3)) |
1e38b8ff | 106 | |
dfd4af17 | 107 | (defmacro avl-tree-node-set-balance (node newbal) |
1e38b8ff | 108 | ;; Set the balance field of a node. |
92313548 | 109 | `(aset ,node 3 ,newbal)) |
1e38b8ff | 110 | |
1e38b8ff TTN |
111 | \f |
112 | ;;; ================================================================ | |
113 | ;;; Internal functions for use in the AVL tree package | |
114 | ||
5afb301b | 115 | (defmacro avl-tree-root (tree) |
1e38b8ff | 116 | ;; Return the root node for an avl-tree. INTERNAL USE ONLY. |
bdf0a828 | 117 | `(avl-tree-node-left (car (cdr ,tree)))) |
1e38b8ff | 118 | |
5afb301b | 119 | (defmacro avl-tree-dummyroot (tree) |
1e38b8ff | 120 | ;; Return the dummy node of an avl-tree. INTERNAL USE ONLY. |
92313548 | 121 | `(car (cdr ,tree))) |
1e38b8ff | 122 | |
5afb301b | 123 | (defmacro avl-tree-cmpfun (tree) |
1e38b8ff | 124 | ;; Return the compare function of AVL tree TREE. INTERNAL USE ONLY. |
92313548 | 125 | `(cdr (cdr ,tree))) |
1e38b8ff | 126 | |
1e38b8ff TTN |
127 | ;; ---------------------------------------------------------------- |
128 | ;; Deleting data | |
129 | ||
5afb301b | 130 | (defun avl-tree-del-balance1 (node branch) |
1e38b8ff | 131 | ;; Rebalance a tree and return t if the height of the tree has shrunk. |
8fa13442 TTN |
132 | (let ((br (avl-tree-node-branch node branch)) |
133 | p1 b1 p2 b2 result) | |
1e38b8ff | 134 | (cond |
dfd4af17 TTN |
135 | ((< (avl-tree-node-balance br) 0) |
136 | (avl-tree-node-set-balance br 0) | |
1e38b8ff TTN |
137 | t) |
138 | ||
dfd4af17 TTN |
139 | ((= (avl-tree-node-balance br) 0) |
140 | (avl-tree-node-set-balance br +1) | |
1e38b8ff TTN |
141 | nil) |
142 | ||
b74e26bb TTN |
143 | (t |
144 | ;; Rebalance. | |
bdf0a828 | 145 | (setq p1 (avl-tree-node-right br) |
dfd4af17 | 146 | b1 (avl-tree-node-balance p1)) |
1e38b8ff | 147 | (if (>= b1 0) |
b74e26bb TTN |
148 | ;; Single RR rotation. |
149 | (progn | |
bdf0a828 TTN |
150 | (avl-tree-node-set-right br (avl-tree-node-left p1)) |
151 | (avl-tree-node-set-left p1 br) | |
b74e26bb TTN |
152 | (if (= 0 b1) |
153 | (progn | |
dfd4af17 TTN |
154 | (avl-tree-node-set-balance br +1) |
155 | (avl-tree-node-set-balance p1 -1) | |
b74e26bb | 156 | (setq result nil)) |
dfd4af17 TTN |
157 | (avl-tree-node-set-balance br 0) |
158 | (avl-tree-node-set-balance p1 0) | |
b74e26bb | 159 | (setq result t)) |
bdf0a828 | 160 | (avl-tree-node-set-branch node branch p1) |
b74e26bb TTN |
161 | result) |
162 | ||
163 | ;; Double RL rotation. | |
bdf0a828 | 164 | (setq p2 (avl-tree-node-left p1) |
dfd4af17 | 165 | b2 (avl-tree-node-balance p2)) |
bdf0a828 TTN |
166 | (avl-tree-node-set-left p1 (avl-tree-node-right p2)) |
167 | (avl-tree-node-set-right p2 p1) | |
168 | (avl-tree-node-set-right br (avl-tree-node-left p2)) | |
169 | (avl-tree-node-set-left p2 br) | |
b74e26bb | 170 | (if (> b2 0) |
dfd4af17 TTN |
171 | (avl-tree-node-set-balance br -1) |
172 | (avl-tree-node-set-balance br 0)) | |
b74e26bb | 173 | (if (< b2 0) |
dfd4af17 TTN |
174 | (avl-tree-node-set-balance p1 +1) |
175 | (avl-tree-node-set-balance p1 0)) | |
bdf0a828 | 176 | (avl-tree-node-set-branch node branch p2) |
dfd4af17 | 177 | (avl-tree-node-set-balance p2 0) |
b74e26bb | 178 | t))))) |
1e38b8ff | 179 | |
5afb301b | 180 | (defun avl-tree-del-balance2 (node branch) |
8fa13442 TTN |
181 | (let ((br (avl-tree-node-branch node branch)) |
182 | p1 b1 p2 b2 result) | |
1e38b8ff | 183 | (cond |
dfd4af17 TTN |
184 | ((> (avl-tree-node-balance br) 0) |
185 | (avl-tree-node-set-balance br 0) | |
1e38b8ff TTN |
186 | t) |
187 | ||
dfd4af17 TTN |
188 | ((= (avl-tree-node-balance br) 0) |
189 | (avl-tree-node-set-balance br -1) | |
1e38b8ff TTN |
190 | nil) |
191 | ||
b74e26bb TTN |
192 | (t |
193 | ;; Rebalance. | |
bdf0a828 | 194 | (setq p1 (avl-tree-node-left br) |
dfd4af17 | 195 | b1 (avl-tree-node-balance p1)) |
1e38b8ff | 196 | (if (<= b1 0) |
b74e26bb TTN |
197 | ;; Single LL rotation. |
198 | (progn | |
bdf0a828 TTN |
199 | (avl-tree-node-set-left br (avl-tree-node-right p1)) |
200 | (avl-tree-node-set-right p1 br) | |
b74e26bb TTN |
201 | (if (= 0 b1) |
202 | (progn | |
dfd4af17 TTN |
203 | (avl-tree-node-set-balance br -1) |
204 | (avl-tree-node-set-balance p1 +1) | |
b74e26bb | 205 | (setq result nil)) |
dfd4af17 TTN |
206 | (avl-tree-node-set-balance br 0) |
207 | (avl-tree-node-set-balance p1 0) | |
b74e26bb | 208 | (setq result t)) |
bdf0a828 | 209 | (avl-tree-node-set-branch node branch p1) |
b74e26bb TTN |
210 | result) |
211 | ||
212 | ;; Double LR rotation. | |
bdf0a828 | 213 | (setq p2 (avl-tree-node-right p1) |
dfd4af17 | 214 | b2 (avl-tree-node-balance p2)) |
bdf0a828 TTN |
215 | (avl-tree-node-set-right p1 (avl-tree-node-left p2)) |
216 | (avl-tree-node-set-left p2 p1) | |
217 | (avl-tree-node-set-left br (avl-tree-node-right p2)) | |
218 | (avl-tree-node-set-right p2 br) | |
b74e26bb | 219 | (if (< b2 0) |
dfd4af17 TTN |
220 | (avl-tree-node-set-balance br +1) |
221 | (avl-tree-node-set-balance br 0)) | |
b74e26bb | 222 | (if (> b2 0) |
dfd4af17 TTN |
223 | (avl-tree-node-set-balance p1 -1) |
224 | (avl-tree-node-set-balance p1 0)) | |
bdf0a828 | 225 | (avl-tree-node-set-branch node branch p2) |
dfd4af17 | 226 | (avl-tree-node-set-balance p2 0) |
b74e26bb | 227 | t))))) |
1e38b8ff | 228 | |
5afb301b | 229 | (defun avl-tree-do-del-internal (node branch q) |
8fa13442 | 230 | (let ((br (avl-tree-node-branch node branch))) |
bdf0a828 | 231 | (if (avl-tree-node-right br) |
5afb301b TTN |
232 | (if (avl-tree-do-del-internal br +1 q) |
233 | (avl-tree-del-balance2 node branch)) | |
bdf0a828 TTN |
234 | (avl-tree-node-set-data q (avl-tree-node-data br)) |
235 | (avl-tree-node-set-branch node branch | |
5fa11cc2 | 236 | (avl-tree-node-left br)) |
b74e26bb | 237 | t))) |
1e38b8ff | 238 | |
5afb301b | 239 | (defun avl-tree-do-delete (cmpfun root branch data) |
1e38b8ff | 240 | ;; Return t if the height of the tree has shrunk. |
8fa13442 | 241 | (let ((br (avl-tree-node-branch root branch))) |
1e38b8ff TTN |
242 | (cond |
243 | ((null br) | |
244 | nil) | |
245 | ||
bdf0a828 | 246 | ((funcall cmpfun data (avl-tree-node-data br)) |
5afb301b TTN |
247 | (if (avl-tree-do-delete cmpfun br 0 data) |
248 | (avl-tree-del-balance1 root branch))) | |
1e38b8ff | 249 | |
bdf0a828 | 250 | ((funcall cmpfun (avl-tree-node-data br) data) |
5afb301b TTN |
251 | (if (avl-tree-do-delete cmpfun br 1 data) |
252 | (avl-tree-del-balance2 root branch))) | |
1e38b8ff TTN |
253 | |
254 | (t | |
255 | ;; Found it. Let's delete it. | |
256 | (cond | |
bdf0a828 TTN |
257 | ((null (avl-tree-node-right br)) |
258 | (avl-tree-node-set-branch root branch (avl-tree-node-left br)) | |
b74e26bb | 259 | t) |
1e38b8ff | 260 | |
bdf0a828 TTN |
261 | ((null (avl-tree-node-left br)) |
262 | (avl-tree-node-set-branch root branch (avl-tree-node-right br)) | |
b74e26bb | 263 | t) |
1e38b8ff TTN |
264 | |
265 | (t | |
5afb301b TTN |
266 | (if (avl-tree-do-del-internal br 0 br) |
267 | (avl-tree-del-balance1 root branch)))))))) | |
1e38b8ff TTN |
268 | |
269 | ;; ---------------------------------------------------------------- | |
270 | ;; Entering data | |
271 | ||
5afb301b | 272 | (defun avl-tree-enter-balance1 (node branch) |
1e38b8ff | 273 | ;; Rebalance a tree and return t if the height of the tree has grown. |
8fa13442 TTN |
274 | (let ((br (avl-tree-node-branch node branch)) |
275 | p1 p2 b2 result) | |
1e38b8ff | 276 | (cond |
dfd4af17 TTN |
277 | ((< (avl-tree-node-balance br) 0) |
278 | (avl-tree-node-set-balance br 0) | |
1e38b8ff TTN |
279 | nil) |
280 | ||
dfd4af17 TTN |
281 | ((= (avl-tree-node-balance br) 0) |
282 | (avl-tree-node-set-balance br +1) | |
1e38b8ff TTN |
283 | t) |
284 | ||
285 | (t | |
b74e26bb | 286 | ;; Tree has grown => Rebalance. |
bdf0a828 | 287 | (setq p1 (avl-tree-node-right br)) |
dfd4af17 | 288 | (if (> (avl-tree-node-balance p1) 0) |
b74e26bb TTN |
289 | ;; Single RR rotation. |
290 | (progn | |
bdf0a828 TTN |
291 | (avl-tree-node-set-right br (avl-tree-node-left p1)) |
292 | (avl-tree-node-set-left p1 br) | |
dfd4af17 | 293 | (avl-tree-node-set-balance br 0) |
bdf0a828 | 294 | (avl-tree-node-set-branch node branch p1)) |
b74e26bb TTN |
295 | |
296 | ;; Double RL rotation. | |
bdf0a828 | 297 | (setq p2 (avl-tree-node-left p1) |
dfd4af17 | 298 | b2 (avl-tree-node-balance p2)) |
bdf0a828 TTN |
299 | (avl-tree-node-set-left p1 (avl-tree-node-right p2)) |
300 | (avl-tree-node-set-right p2 p1) | |
301 | (avl-tree-node-set-right br (avl-tree-node-left p2)) | |
302 | (avl-tree-node-set-left p2 br) | |
b74e26bb | 303 | (if (> b2 0) |
dfd4af17 TTN |
304 | (avl-tree-node-set-balance br -1) |
305 | (avl-tree-node-set-balance br 0)) | |
b74e26bb | 306 | (if (< b2 0) |
dfd4af17 TTN |
307 | (avl-tree-node-set-balance p1 +1) |
308 | (avl-tree-node-set-balance p1 0)) | |
bdf0a828 TTN |
309 | (avl-tree-node-set-branch node branch p2)) |
310 | (avl-tree-node-set-balance (avl-tree-node-branch node branch) 0) | |
b74e26bb | 311 | nil)))) |
1e38b8ff | 312 | |
5afb301b | 313 | (defun avl-tree-enter-balance2 (node branch) |
1e38b8ff | 314 | ;; Return t if the tree has grown. |
8fa13442 TTN |
315 | (let ((br (avl-tree-node-branch node branch)) |
316 | p1 p2 b2) | |
1e38b8ff | 317 | (cond |
dfd4af17 TTN |
318 | ((> (avl-tree-node-balance br) 0) |
319 | (avl-tree-node-set-balance br 0) | |
1e38b8ff TTN |
320 | nil) |
321 | ||
dfd4af17 TTN |
322 | ((= (avl-tree-node-balance br) 0) |
323 | (avl-tree-node-set-balance br -1) | |
1e38b8ff TTN |
324 | t) |
325 | ||
326 | (t | |
b74e26bb | 327 | ;; Balance was -1 => Rebalance. |
bdf0a828 | 328 | (setq p1 (avl-tree-node-left br)) |
dfd4af17 | 329 | (if (< (avl-tree-node-balance p1) 0) |
b74e26bb TTN |
330 | ;; Single LL rotation. |
331 | (progn | |
bdf0a828 TTN |
332 | (avl-tree-node-set-left br (avl-tree-node-right p1)) |
333 | (avl-tree-node-set-right p1 br) | |
dfd4af17 | 334 | (avl-tree-node-set-balance br 0) |
bdf0a828 | 335 | (avl-tree-node-set-branch node branch p1)) |
b74e26bb TTN |
336 | |
337 | ;; Double LR rotation. | |
bdf0a828 | 338 | (setq p2 (avl-tree-node-right p1) |
dfd4af17 | 339 | b2 (avl-tree-node-balance p2)) |
bdf0a828 TTN |
340 | (avl-tree-node-set-right p1 (avl-tree-node-left p2)) |
341 | (avl-tree-node-set-left p2 p1) | |
342 | (avl-tree-node-set-left br (avl-tree-node-right p2)) | |
343 | (avl-tree-node-set-right p2 br) | |
b74e26bb | 344 | (if (< b2 0) |
dfd4af17 TTN |
345 | (avl-tree-node-set-balance br +1) |
346 | (avl-tree-node-set-balance br 0)) | |
b74e26bb | 347 | (if (> b2 0) |
dfd4af17 TTN |
348 | (avl-tree-node-set-balance p1 -1) |
349 | (avl-tree-node-set-balance p1 0)) | |
bdf0a828 TTN |
350 | (avl-tree-node-set-branch node branch p2)) |
351 | (avl-tree-node-set-balance (avl-tree-node-branch node branch) 0) | |
b74e26bb | 352 | nil)))) |
1e38b8ff | 353 | |
5afb301b | 354 | (defun avl-tree-do-enter (cmpfun root branch data) |
1e38b8ff | 355 | ;; Return t if height of tree ROOT has grown. INTERNAL USE ONLY. |
bdf0a828 | 356 | (let ((br (avl-tree-node-branch root branch))) |
1e38b8ff TTN |
357 | (cond |
358 | ((null br) | |
b74e26bb | 359 | ;; Data not in tree, insert it. |
5fa11cc2 TTN |
360 | (avl-tree-node-set-branch |
361 | root branch (avl-tree-node-create nil nil data 0)) | |
1e38b8ff TTN |
362 | t) |
363 | ||
bdf0a828 | 364 | ((funcall cmpfun data (avl-tree-node-data br)) |
5fa11cc2 | 365 | (and (avl-tree-do-enter cmpfun br 0 data) |
5afb301b | 366 | (avl-tree-enter-balance2 root branch))) |
1e38b8ff | 367 | |
bdf0a828 | 368 | ((funcall cmpfun (avl-tree-node-data br) data) |
5fa11cc2 | 369 | (and (avl-tree-do-enter cmpfun br 1 data) |
5afb301b | 370 | (avl-tree-enter-balance1 root branch))) |
1e38b8ff TTN |
371 | |
372 | (t | |
bdf0a828 | 373 | (avl-tree-node-set-data br data) |
1e38b8ff TTN |
374 | nil)))) |
375 | ||
1e38b8ff TTN |
376 | ;; ---------------------------------------------------------------- |
377 | ||
5afb301b | 378 | (defun avl-tree-mapc (map-function root) |
1e38b8ff TTN |
379 | ;; Apply MAP-FUNCTION to all nodes in the tree starting with ROOT. |
380 | ;; The function is applied in-order. | |
381 | ;; | |
382 | ;; Note: MAP-FUNCTION is applied to the node and not to the data itself. | |
383 | ;; INTERNAL USE ONLY. | |
1e38b8ff | 384 | (let ((node root) |
25e32569 | 385 | (stack nil) |
b74e26bb | 386 | (go-left t)) |
25e32569 | 387 | (push nil stack) |
1e38b8ff TTN |
388 | (while node |
389 | (if (and go-left | |
bdf0a828 | 390 | (avl-tree-node-left node)) |
b74e26bb TTN |
391 | ;; Do the left subtree first. |
392 | (progn | |
25e32569 | 393 | (push node stack) |
bdf0a828 | 394 | (setq node (avl-tree-node-left node))) |
b74e26bb TTN |
395 | ;; Apply the function... |
396 | (funcall map-function node) | |
397 | ;; and do the right subtree. | |
bdf0a828 TTN |
398 | (if (avl-tree-node-right node) |
399 | (setq node (avl-tree-node-right node) | |
b74e26bb | 400 | go-left t) |
25e32569 | 401 | (setq node (pop stack) |
b74e26bb | 402 | go-left nil)))))) |
1e38b8ff | 403 | |
5afb301b | 404 | (defun avl-tree-do-copy (root) |
1e38b8ff TTN |
405 | ;; Copy the tree with ROOT as root. |
406 | ;; Highly recursive. INTERNAL USE ONLY. | |
407 | (if (null root) | |
408 | nil | |
5fa11cc2 TTN |
409 | (avl-tree-node-create |
410 | (avl-tree-do-copy (avl-tree-node-left root)) | |
411 | (avl-tree-do-copy (avl-tree-node-right root)) | |
412 | (avl-tree-node-data root) | |
413 | (avl-tree-node-balance root)))) | |
1e38b8ff TTN |
414 | |
415 | \f | |
416 | ;;; ================================================================ | |
417 | ;;; The public functions which operate on AVL trees. | |
418 | ||
85718043 | 419 | (defun avl-tree-create (compare-function) |
1e38b8ff TTN |
420 | "Create an empty avl tree. |
421 | COMPARE-FUNCTION is a function which takes two arguments, A and B, | |
422 | and returns non-nil if A is less than B, and nil otherwise." | |
85718043 | 423 | (cons 'AVL-TREE |
dfd4af17 | 424 | (cons (avl-tree-node-create nil nil nil 0) |
b74e26bb | 425 | compare-function))) |
1e38b8ff | 426 | |
85718043 | 427 | (defun avl-tree-p (obj) |
1e38b8ff | 428 | "Return t if OBJ is an avl tree, nil otherwise." |
85718043 | 429 | (eq (car-safe obj) 'AVL-TREE)) |
1e38b8ff | 430 | |
85718043 | 431 | (defun avl-tree-compare-function (tree) |
1e38b8ff | 432 | "Return the comparision function for the avl tree TREE." |
5afb301b | 433 | (avl-tree-cmpfun tree)) |
1e38b8ff | 434 | |
85718043 | 435 | (defun avl-tree-empty (tree) |
1e38b8ff | 436 | "Return t if TREE is emtpy, otherwise return nil." |
5afb301b | 437 | (null (avl-tree-root tree))) |
1e38b8ff | 438 | |
85718043 | 439 | (defun avl-tree-enter (tree data) |
1e38b8ff TTN |
440 | "In the avl tree TREE insert DATA. |
441 | Return DATA." | |
5afb301b TTN |
442 | (avl-tree-do-enter (avl-tree-cmpfun tree) |
443 | (avl-tree-dummyroot tree) | |
b74e26bb TTN |
444 | 0 |
445 | data) | |
1e38b8ff TTN |
446 | data) |
447 | ||
85718043 | 448 | (defun avl-tree-delete (tree data) |
1e38b8ff TTN |
449 | "From the avl tree TREE, delete DATA. |
450 | Return the element in TREE which matched DATA, nil if no element matched." | |
5afb301b TTN |
451 | (avl-tree-do-delete (avl-tree-cmpfun tree) |
452 | (avl-tree-dummyroot tree) | |
b74e26bb TTN |
453 | 0 |
454 | data)) | |
1e38b8ff | 455 | |
85718043 | 456 | (defun avl-tree-member (tree data) |
1e38b8ff | 457 | "Return the element in the avl tree TREE which matches DATA. |
85718043 | 458 | Matching uses the compare function previously specified in `avl-tree-create' |
1e38b8ff TTN |
459 | when TREE was created. |
460 | ||
461 | If there is no such element in the tree, the value is nil." | |
5afb301b TTN |
462 | (let ((node (avl-tree-root tree)) |
463 | (compare-function (avl-tree-cmpfun tree)) | |
b74e26bb | 464 | found) |
1e38b8ff | 465 | (while (and node |
b74e26bb | 466 | (not found)) |
1e38b8ff | 467 | (cond |
bdf0a828 TTN |
468 | ((funcall compare-function data (avl-tree-node-data node)) |
469 | (setq node (avl-tree-node-left node))) | |
470 | ((funcall compare-function (avl-tree-node-data node) data) | |
471 | (setq node (avl-tree-node-right node))) | |
1e38b8ff | 472 | (t |
b74e26bb | 473 | (setq found t)))) |
1e38b8ff | 474 | (if node |
bdf0a828 | 475 | (avl-tree-node-data node) |
1e38b8ff TTN |
476 | nil))) |
477 | ||
85718043 | 478 | (defun avl-tree-map (__map-function__ tree) |
1e38b8ff | 479 | "Apply MAP-FUNCTION to all elements in the avl tree TREE." |
5afb301b | 480 | (avl-tree-mapc |
1e38b8ff | 481 | (function (lambda (node) |
5fa11cc2 TTN |
482 | (avl-tree-node-set-data |
483 | node (funcall __map-function__ | |
484 | (avl-tree-node-data node))))) | |
5afb301b | 485 | (avl-tree-root tree))) |
1e38b8ff | 486 | |
85718043 | 487 | (defun avl-tree-first (tree) |
1e38b8ff | 488 | "Return the first element in TREE, or nil if TREE is empty." |
5afb301b | 489 | (let ((node (avl-tree-root tree))) |
1e38b8ff | 490 | (if node |
b74e26bb | 491 | (progn |
bdf0a828 TTN |
492 | (while (avl-tree-node-left node) |
493 | (setq node (avl-tree-node-left node))) | |
494 | (avl-tree-node-data node)) | |
1e38b8ff TTN |
495 | nil))) |
496 | ||
85718043 | 497 | (defun avl-tree-last (tree) |
1e38b8ff | 498 | "Return the last element in TREE, or nil if TREE is empty." |
5afb301b | 499 | (let ((node (avl-tree-root tree))) |
1e38b8ff | 500 | (if node |
b74e26bb | 501 | (progn |
bdf0a828 TTN |
502 | (while (avl-tree-node-right node) |
503 | (setq node (avl-tree-node-right node))) | |
504 | (avl-tree-node-data node)) | |
1e38b8ff TTN |
505 | nil))) |
506 | ||
85718043 | 507 | (defun avl-tree-copy (tree) |
1e38b8ff | 508 | "Return a copy of the avl tree TREE." |
5fa11cc2 | 509 | (let ((new-tree (avl-tree-create (avl-tree-cmpfun tree)))) |
bdf0a828 | 510 | (avl-tree-node-set-left (avl-tree-dummyroot new-tree) |
5fa11cc2 | 511 | (avl-tree-do-copy (avl-tree-root tree))) |
1e38b8ff TTN |
512 | new-tree)) |
513 | ||
85718043 | 514 | (defun avl-tree-flatten (tree) |
1e38b8ff TTN |
515 | "Return a sorted list containing all elements of TREE." |
516 | (nreverse | |
517 | (let ((treelist nil)) | |
5fa11cc2 TTN |
518 | (avl-tree-mapc |
519 | (function (lambda (node) | |
520 | (setq treelist (cons (avl-tree-node-data node) | |
521 | treelist)))) | |
522 | (avl-tree-root tree)) | |
1e38b8ff TTN |
523 | treelist))) |
524 | ||
85718043 | 525 | (defun avl-tree-size (tree) |
1e38b8ff TTN |
526 | "Return the number of elements in TREE." |
527 | (let ((treesize 0)) | |
5fa11cc2 TTN |
528 | (avl-tree-mapc |
529 | (function (lambda (data) | |
530 | (setq treesize (1+ treesize)) | |
531 | data)) | |
532 | (avl-tree-root tree)) | |
1e38b8ff TTN |
533 | treesize)) |
534 | ||
85718043 | 535 | (defun avl-tree-clear (tree) |
1e38b8ff | 536 | "Clear the avl tree TREE." |
bdf0a828 | 537 | (avl-tree-node-set-left (avl-tree-dummyroot tree) nil)) |
1e38b8ff | 538 | |
fb5da2db TTN |
539 | (provide 'avl-tree) |
540 | ||
37840380 | 541 | ;; arch-tag: 47e26701-43c9-4222-bd79-739eac6357a9 |
85718043 | 542 | ;;; avl-tree.el ends here |