Commit | Line | Data |
---|---|---|
1e38b8ff TTN |
1 | ;;;; $Id: elib-node.el,v 0.8 1995/12/11 00:11:19 ceder Exp $ |
2 | ;;;; Nodes used in binary trees and doubly linked lists. | |
3 | ||
4 | ;; Copyright (C) 1991-1995 Free Software Foundation | |
5 | ||
6 | ;; Author: Per Cederqvist <ceder@lysator.liu.se> | |
7 | ;; Inge Wallin <inge@lysator.liu.se> | |
8 | ;; Maintainer: elib-maintainers@lysator.liu.se | |
9 | ;; Created: 20 May 1991 | |
10 | ;; Keywords: extensions, lisp | |
11 | ||
12 | ;;;; This file is part of the GNU Emacs lisp library, Elib. | |
13 | ;;;; | |
14 | ;;;; GNU Elib 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 2, or (at your option) | |
17 | ;;;; any later version. | |
18 | ;;;; | |
19 | ;;;; GNU Elib 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. | |
23 | ;;;; | |
24 | ;;;; You should have received a copy of the GNU General Public License | |
25 | ;;;; along with GNU Elib; see the file COPYING. If not, write to | |
26 | ;;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
27 | ;;;; Boston, MA 02111-1307, USA | |
28 | ;;;; | |
29 | ;;;; Author: Inge Wallin | |
30 | ;;;; | |
31 | ||
32 | ;;; Commentary: | |
33 | ||
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 | ||
44 | ;;; Code: | |
45 | ||
46 | ;;; Begin HACKS to make avl-tree.el standalone. | |
47 | ;;; | |
48 | ;;; 0/ Don't do this. | |
49 | ;;; (provide 'elib-node) | |
50 | ;;; | |
51 | ;;; End HACKS to make avl-tree.el standalone. | |
52 | ||
53 | ||
54 | (defmacro elib-node-create (left right data) | |
55 | ||
56 | ;; Create a tree node from LEFT, RIGHT and DATA. | |
57 | (` (vector (, left) (, right) (, data)))) | |
58 | ||
59 | ||
60 | (defmacro elib-node-left (node) | |
61 | ||
62 | ;; Return the left pointer of NODE. | |
63 | (` (aref (, node) 0))) | |
64 | ||
65 | ||
66 | (defmacro elib-node-right (node) | |
67 | ||
68 | ;; Return the right pointer of NODE. | |
69 | (` (aref (, node) 1))) | |
70 | ||
71 | ||
72 | (defmacro elib-node-data (node) | |
73 | ||
74 | ;; Return the data of NODE. | |
75 | (` (aref (, node) 2))) | |
76 | ||
77 | ||
78 | (defmacro elib-node-set-left (node newleft) | |
79 | ||
80 | ;; Set the left pointer of NODE to NEWLEFT. | |
81 | (` (aset (, node) 0 (, newleft)))) | |
82 | ||
83 | ||
84 | (defmacro elib-node-set-right (node newright) | |
85 | ||
86 | ;; Set the right pointer of NODE to NEWRIGHT. | |
87 | (` (aset (, node) 1 (, newright)))) | |
88 | ||
89 | ||
90 | (defmacro elib-node-set-data (node newdata) | |
91 | ;; Set the data of NODE to NEWDATA. | |
92 | (` (aset (, node) 2 (, newdata)))) | |
93 | ||
94 | ||
95 | ||
96 | (defmacro elib-node-branch (node branch) | |
97 | ||
98 | ;; Get value of a branch of a node. | |
99 | ;; | |
100 | ;; NODE is the node, and BRANCH is the branch. | |
101 | ;; 0 for left pointer, 1 for right pointer and 2 for the data." | |
102 | (` (aref (, node) (, branch)))) | |
103 | ||
104 | ||
105 | (defmacro elib-node-set-branch (node branch newval) | |
106 | ||
107 | ;; Set value of a branch of a node. | |
108 | ;; | |
109 | ;; NODE is the node, and BRANCH is the branch. | |
110 | ;; 0 for left pointer, 1 for the right pointer and 2 for the data. | |
111 | ;; NEWVAL is new value of the branch." | |
112 | (` (aset (, node) (, branch) (, newval)))) | |
113 | ||
114 | ;;; elib-node.el ends here. | |
115 | ;;;; $Id: avltree.el,v 0.8 1995/12/11 00:10:54 ceder Exp $ | |
116 | ;;;; This file implements balanced binary trees, AVL-trees. | |
117 | ||
118 | ;; Copyright (C) 1991-1995 Free Software Foundation | |
119 | ||
120 | ;; Author: Inge Wallin <inge@lysator.liu.se> | |
121 | ;; Thomas Bellman <bellman@lysator.liu.se> | |
122 | ;; Maintainer: elib-maintainers@lysator.liu.se | |
123 | ;; Created: 10 May 1991 | |
124 | ;; Keywords: extensions, lisp | |
125 | ||
126 | ;;;; This file is part of the GNU Emacs lisp library, Elib. | |
127 | ;;;; | |
128 | ;;;; GNU Elib is free software; you can redistribute it and/or modify | |
129 | ;;;; it under the terms of the GNU General Public License as published by | |
130 | ;;;; the Free Software Foundation; either version 2, or (at your option) | |
131 | ;;;; any later version. | |
132 | ;;;; | |
133 | ;;;; GNU Elib is distributed in the hope that it will be useful, | |
134 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
135 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
136 | ;;;; GNU General Public License for more details. | |
137 | ;;;; | |
138 | ;;;; You should have received a copy of the GNU General Public License | |
139 | ;;;; along with GNU Elib; see the file COPYING. If not, write to | |
140 | ;;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
141 | ;;;; Boston, MA 02111-1307, USA | |
142 | ;;;; | |
143 | ;;;; Initial author: Thomas Bellman | |
144 | ;;;; Lysator Computer Club | |
145 | ;;;; Linkoping University | |
146 | ;;;; Sweden | |
147 | ;;;; | |
148 | ;;;; Bugfixes and completion: Inge Wallin | |
149 | ;;;; | |
150 | ||
151 | ||
152 | ;;; Commentary: | |
153 | ;;; | |
154 | ;;; An AVL tree is a nearly-perfect balanced binary tree. A tree | |
155 | ;;; consists of two cons cells, the first one holding the tag | |
156 | ;;; 'AVLTREE in the car cell, and the second one having the tree | |
157 | ;;; in the car and the compare function in the cdr cell. The tree has | |
158 | ;;; a dummy node as its root with the real tree in the left pointer. | |
159 | ;;; | |
160 | ;;; Each node of the tree consists of one data element, one left | |
161 | ;;; sub-tree and one right sub-tree. Each node also has a balance | |
162 | ;;; count, which is the difference in depth of the left and right | |
163 | ;;; sub-trees. | |
164 | ;;; | |
165 | ||
166 | ;;; Code: | |
167 | ||
168 | ;;; Begin HACKS to make avl-tree.el standalone. | |
169 | ;;; | |
170 | ;;; 1/ See above for inlined elib-node.el. | |
171 | ;;; (require 'elib-node) | |
172 | ;;; | |
173 | ;;; 2/ This requirement has been replaced w/ new code. | |
174 | ;;; (require 'stack-m) | |
175 | ;;; | |
176 | ;;; 3/ New code: | |
177 | (eval-when-compile (require 'cl)) | |
178 | (defun elib-stack-create () (list)) | |
179 | (defmacro elib-stack-push (stack object) `(push ,object ,stack)) | |
180 | (defmacro elib-stack-pop (stack) `(pop ,stack)) | |
181 | ;;; | |
182 | ;;; 4/ Provide `avl-tree' instead of `avltree'. | |
183 | (provide 'avl-tree) | |
184 | ;;; | |
185 | ;;; End HACKS to make avl-tree.el standalone. | |
186 | ||
187 | ||
188 | ;;; ================================================================ | |
189 | ;;; Functions and macros handling an AVL tree node. | |
190 | ||
191 | ;; | |
192 | ;; The rest of the functions needed here can be found in | |
193 | ;; elib-node.el. | |
194 | ;; | |
195 | ||
196 | ||
197 | (defmacro elib-avl-node-create (left right data balance) | |
198 | ||
199 | ;; Create and return an avl-tree node. | |
200 | (` (vector (, left) (, right) (, data) (, balance)))) | |
201 | ||
202 | ||
203 | (defmacro elib-avl-node-balance (node) | |
204 | ||
205 | ;; Return the balance field of a node. | |
206 | (` (aref (, node) 3))) | |
207 | ||
208 | ||
209 | (defmacro elib-avl-node-set-balance (node newbal) | |
210 | ||
211 | ;; Set the balance field of a node. | |
212 | (` (aset (, node) 3 (, newbal)))) | |
213 | ||
214 | ||
215 | \f | |
216 | ;;; ================================================================ | |
217 | ;;; Internal functions for use in the AVL tree package | |
218 | ||
219 | ;;; | |
220 | ;;; The functions and macros in this section all start with `elib-avl-'. | |
221 | ;;; | |
222 | ||
223 | ||
224 | (defmacro elib-avl-root (tree) | |
225 | ||
226 | ;; Return the root node for an avl-tree. INTERNAL USE ONLY. | |
227 | (` (elib-node-left (car (cdr (, tree)))))) | |
228 | ||
229 | ||
230 | (defmacro elib-avl-dummyroot (tree) | |
231 | ||
232 | ;; Return the dummy node of an avl-tree. INTERNAL USE ONLY. | |
233 | ||
234 | (` (car (cdr (, tree))))) | |
235 | ||
236 | ||
237 | (defmacro elib-avl-cmpfun (tree) | |
238 | ||
239 | ;; Return the compare function of AVL tree TREE. INTERNAL USE ONLY. | |
240 | (` (cdr (cdr (, tree))))) | |
241 | ||
242 | ||
243 | ;; ---------------------------------------------------------------- | |
244 | ;; Deleting data | |
245 | ||
246 | ||
247 | (defun elib-avl-del-balance1 (node branch) | |
248 | ||
249 | ;; Rebalance a tree and return t if the height of the tree has shrunk. | |
250 | (let* ((br (elib-node-branch node branch)) | |
251 | p1 | |
252 | b1 | |
253 | p2 | |
254 | b2 | |
255 | result) | |
256 | (cond | |
257 | ((< (elib-avl-node-balance br) 0) | |
258 | (elib-avl-node-set-balance br 0) | |
259 | t) | |
260 | ||
261 | ((= (elib-avl-node-balance br) 0) | |
262 | (elib-avl-node-set-balance br +1) | |
263 | nil) | |
264 | ||
265 | (t ; Rebalance | |
266 | (setq p1 (elib-node-right br) | |
267 | b1 (elib-avl-node-balance p1)) | |
268 | (if (>= b1 0) | |
269 | ;; Single RR rotation | |
270 | (progn | |
271 | (elib-node-set-right br (elib-node-left p1)) | |
272 | (elib-node-set-left p1 br) | |
273 | (if (= 0 b1) | |
274 | (progn | |
275 | (elib-avl-node-set-balance br +1) | |
276 | (elib-avl-node-set-balance p1 -1) | |
277 | (setq result nil)) | |
278 | (elib-avl-node-set-balance br 0) | |
279 | (elib-avl-node-set-balance p1 0) | |
280 | (setq result t)) | |
281 | (elib-node-set-branch node branch p1) | |
282 | result) | |
283 | ||
284 | ;; Double RL rotation | |
285 | (setq p2 (elib-node-left p1) | |
286 | b2 (elib-avl-node-balance p2)) | |
287 | (elib-node-set-left p1 (elib-node-right p2)) | |
288 | (elib-node-set-right p2 p1) | |
289 | (elib-node-set-right br (elib-node-left p2)) | |
290 | (elib-node-set-left p2 br) | |
291 | (if (> b2 0) | |
292 | (elib-avl-node-set-balance br -1) | |
293 | (elib-avl-node-set-balance br 0)) | |
294 | (if (< b2 0) | |
295 | (elib-avl-node-set-balance p1 +1) | |
296 | (elib-avl-node-set-balance p1 0)) | |
297 | (elib-node-set-branch node branch p2) | |
298 | (elib-avl-node-set-balance p2 0) | |
299 | t) | |
300 | )) | |
301 | )) | |
302 | ||
303 | ||
304 | (defun elib-avl-del-balance2 (node branch) | |
305 | ||
306 | (let* ((br (elib-node-branch node branch)) | |
307 | p1 | |
308 | b1 | |
309 | p2 | |
310 | b2 | |
311 | result) | |
312 | (cond | |
313 | ((> (elib-avl-node-balance br) 0) | |
314 | (elib-avl-node-set-balance br 0) | |
315 | t) | |
316 | ||
317 | ((= (elib-avl-node-balance br) 0) | |
318 | (elib-avl-node-set-balance br -1) | |
319 | nil) | |
320 | ||
321 | (t ; Rebalance | |
322 | (setq p1 (elib-node-left br) | |
323 | b1 (elib-avl-node-balance p1)) | |
324 | (if (<= b1 0) | |
325 | ;; Single LL rotation | |
326 | (progn | |
327 | (elib-node-set-left br (elib-node-right p1)) | |
328 | (elib-node-set-right p1 br) | |
329 | (if (= 0 b1) | |
330 | (progn | |
331 | (elib-avl-node-set-balance br -1) | |
332 | (elib-avl-node-set-balance p1 +1) | |
333 | (setq result nil)) | |
334 | (elib-avl-node-set-balance br 0) | |
335 | (elib-avl-node-set-balance p1 0) | |
336 | (setq result t)) | |
337 | (elib-node-set-branch node branch p1) | |
338 | result) | |
339 | ||
340 | ;; Double LR rotation | |
341 | (setq p2 (elib-node-right p1) | |
342 | b2 (elib-avl-node-balance p2)) | |
343 | (elib-node-set-right p1 (elib-node-left p2)) | |
344 | (elib-node-set-left p2 p1) | |
345 | (elib-node-set-left br (elib-node-right p2)) | |
346 | (elib-node-set-right p2 br) | |
347 | (if (< b2 0) | |
348 | (elib-avl-node-set-balance br +1) | |
349 | (elib-avl-node-set-balance br 0)) | |
350 | (if (> b2 0) | |
351 | (elib-avl-node-set-balance p1 -1) | |
352 | (elib-avl-node-set-balance p1 0)) | |
353 | (elib-node-set-branch node branch p2) | |
354 | (elib-avl-node-set-balance p2 0) | |
355 | t) | |
356 | )) | |
357 | )) | |
358 | ||
359 | ||
360 | (defun elib-avl-do-del-internal (node branch q) | |
361 | ||
362 | (let* ((br (elib-node-branch node branch))) | |
363 | (if (elib-node-right br) | |
364 | (if (elib-avl-do-del-internal br +1 q) | |
365 | (elib-avl-del-balance2 node branch)) | |
366 | (elib-node-set-data q (elib-node-data br)) | |
367 | (elib-node-set-branch node branch | |
368 | (elib-node-left br)) | |
369 | t))) | |
370 | ||
371 | ||
372 | ||
373 | (defun elib-avl-do-delete (cmpfun root branch data) | |
374 | ||
375 | ;; Return t if the height of the tree has shrunk. | |
376 | (let* ((br (elib-node-branch root branch))) | |
377 | (cond | |
378 | ((null br) | |
379 | nil) | |
380 | ||
381 | ((funcall cmpfun data (elib-node-data br)) | |
382 | (if (elib-avl-do-delete cmpfun br 0 data) | |
383 | (elib-avl-del-balance1 root branch))) | |
384 | ||
385 | ((funcall cmpfun (elib-node-data br) data) | |
386 | (if (elib-avl-do-delete cmpfun br 1 data) | |
387 | (elib-avl-del-balance2 root branch))) | |
388 | ||
389 | (t | |
390 | ;; Found it. Let's delete it. | |
391 | (cond | |
392 | ((null (elib-node-right br)) | |
393 | (elib-node-set-branch root branch (elib-node-left br)) | |
394 | t) | |
395 | ||
396 | ((null (elib-node-left br)) | |
397 | (elib-node-set-branch root branch (elib-node-right br)) | |
398 | t) | |
399 | ||
400 | (t | |
401 | (if (elib-avl-do-del-internal br 0 br) | |
402 | (elib-avl-del-balance1 root branch))))) | |
403 | ))) | |
404 | ||
405 | ||
406 | ;; ---------------------------------------------------------------- | |
407 | ;; Entering data | |
408 | ||
409 | ||
410 | ||
411 | (defun elib-avl-enter-balance1 (node branch) | |
412 | ||
413 | ;; Rebalance a tree and return t if the height of the tree has grown. | |
414 | (let* ((br (elib-node-branch node branch)) | |
415 | p1 | |
416 | p2 | |
417 | b2 | |
418 | result) | |
419 | (cond | |
420 | ((< (elib-avl-node-balance br) 0) | |
421 | (elib-avl-node-set-balance br 0) | |
422 | nil) | |
423 | ||
424 | ((= (elib-avl-node-balance br) 0) | |
425 | (elib-avl-node-set-balance br +1) | |
426 | t) | |
427 | ||
428 | (t | |
429 | ;; Tree has grown => Rebalance | |
430 | (setq p1 (elib-node-right br)) | |
431 | (if (> (elib-avl-node-balance p1) 0) | |
432 | ;; Single RR rotation | |
433 | (progn | |
434 | (elib-node-set-right br (elib-node-left p1)) | |
435 | (elib-node-set-left p1 br) | |
436 | (elib-avl-node-set-balance br 0) | |
437 | (elib-node-set-branch node branch p1)) | |
438 | ||
439 | ;; Double RL rotation | |
440 | (setq p2 (elib-node-left p1) | |
441 | b2 (elib-avl-node-balance p2)) | |
442 | (elib-node-set-left p1 (elib-node-right p2)) | |
443 | (elib-node-set-right p2 p1) | |
444 | (elib-node-set-right br (elib-node-left p2)) | |
445 | (elib-node-set-left p2 br) | |
446 | (if (> b2 0) | |
447 | (elib-avl-node-set-balance br -1) | |
448 | (elib-avl-node-set-balance br 0)) | |
449 | (if (< b2 0) | |
450 | (elib-avl-node-set-balance p1 +1) | |
451 | (elib-avl-node-set-balance p1 0)) | |
452 | (elib-node-set-branch node branch p2)) | |
453 | (elib-avl-node-set-balance (elib-node-branch node branch) 0) | |
454 | nil)) | |
455 | )) | |
456 | ||
457 | ||
458 | (defun elib-avl-enter-balance2 (node branch) | |
459 | ||
460 | ;; Return t if the tree has grown. | |
461 | (let* ((br (elib-node-branch node branch)) | |
462 | p1 | |
463 | p2 | |
464 | b2) | |
465 | (cond | |
466 | ((> (elib-avl-node-balance br) 0) | |
467 | (elib-avl-node-set-balance br 0) | |
468 | nil) | |
469 | ||
470 | ((= (elib-avl-node-balance br) 0) | |
471 | (elib-avl-node-set-balance br -1) | |
472 | t) | |
473 | ||
474 | (t | |
475 | ;; Balance was -1 => Rebalance | |
476 | (setq p1 (elib-node-left br)) | |
477 | (if (< (elib-avl-node-balance p1) 0) | |
478 | ;; Single LL rotation | |
479 | (progn | |
480 | (elib-node-set-left br (elib-node-right p1)) | |
481 | (elib-node-set-right p1 br) | |
482 | (elib-avl-node-set-balance br 0) | |
483 | (elib-node-set-branch node branch p1)) | |
484 | ||
485 | ;; Double LR rotation | |
486 | (setq p2 (elib-node-right p1) | |
487 | b2 (elib-avl-node-balance p2)) | |
488 | (elib-node-set-right p1 (elib-node-left p2)) | |
489 | (elib-node-set-left p2 p1) | |
490 | (elib-node-set-left br (elib-node-right p2)) | |
491 | (elib-node-set-right p2 br) | |
492 | (if (< b2 0) | |
493 | (elib-avl-node-set-balance br +1) | |
494 | (elib-avl-node-set-balance br 0)) | |
495 | (if (> b2 0) | |
496 | (elib-avl-node-set-balance p1 -1) | |
497 | (elib-avl-node-set-balance p1 0)) | |
498 | (elib-node-set-branch node branch p2)) | |
499 | (elib-avl-node-set-balance (elib-node-branch node branch) 0) | |
500 | nil)) | |
501 | )) | |
502 | ||
503 | ||
504 | (defun elib-avl-do-enter (cmpfun root branch data) | |
505 | ||
506 | ;; Return t if height of tree ROOT has grown. INTERNAL USE ONLY. | |
507 | (let ((br (elib-node-branch root branch))) | |
508 | (cond | |
509 | ((null br) | |
510 | ;; Data not in tree, insert it | |
511 | (elib-node-set-branch root branch | |
512 | (elib-avl-node-create nil nil data 0)) | |
513 | t) | |
514 | ||
515 | ((funcall cmpfun data (elib-node-data br)) | |
516 | (and (elib-avl-do-enter cmpfun | |
517 | br | |
518 | 0 data) | |
519 | (elib-avl-enter-balance2 root branch))) | |
520 | ||
521 | ((funcall cmpfun (elib-node-data br) data) | |
522 | (and (elib-avl-do-enter cmpfun | |
523 | br | |
524 | 1 data) | |
525 | (elib-avl-enter-balance1 root branch))) | |
526 | ||
527 | (t | |
528 | (elib-node-set-data br data) | |
529 | nil)))) | |
530 | ||
531 | ||
532 | ;; ---------------------------------------------------------------- | |
533 | ||
534 | ||
535 | (defun elib-avl-mapc (map-function root) | |
536 | ;; Apply MAP-FUNCTION to all nodes in the tree starting with ROOT. | |
537 | ;; The function is applied in-order. | |
538 | ;; | |
539 | ;; Note: MAP-FUNCTION is applied to the node and not to the data itself. | |
540 | ;; INTERNAL USE ONLY. | |
541 | ||
542 | (let ((node root) | |
543 | (stack (elib-stack-create)) | |
544 | (go-left t)) | |
545 | (elib-stack-push stack nil) | |
546 | (while node | |
547 | (if (and go-left | |
548 | (elib-node-left node)) | |
549 | (progn ; Do the left subtree first. | |
550 | (elib-stack-push stack node) | |
551 | (setq node (elib-node-left node))) | |
552 | (funcall map-function node) ; Apply the function... | |
553 | (if (elib-node-right node) ; and do the right subtree. | |
554 | (setq node (elib-node-right node) | |
555 | go-left t) | |
556 | (setq node (elib-stack-pop stack) | |
557 | go-left nil)))))) | |
558 | ||
559 | ||
560 | (defun elib-avl-do-copy (root) | |
561 | ;; Copy the tree with ROOT as root. | |
562 | ;; Highly recursive. INTERNAL USE ONLY. | |
563 | (if (null root) | |
564 | nil | |
565 | (elib-avl-node-create (elib-avl-do-copy (elib-node-left root)) | |
566 | (elib-avl-do-copy (elib-node-right root)) | |
567 | (elib-node-data root) | |
568 | (elib-avl-node-balance root)))) | |
569 | ||
570 | ||
571 | \f | |
572 | ;;; ================================================================ | |
573 | ;;; The public functions which operate on AVL trees. | |
574 | ||
575 | ||
576 | (defun avltree-create (compare-function) | |
577 | "Create an empty avl tree. | |
578 | COMPARE-FUNCTION is a function which takes two arguments, A and B, | |
579 | and returns non-nil if A is less than B, and nil otherwise." | |
580 | (cons 'AVLTREE | |
581 | (cons (elib-avl-node-create nil nil nil 0) | |
582 | compare-function))) | |
583 | ||
584 | ||
585 | (defun avltree-p (obj) | |
586 | "Return t if OBJ is an avl tree, nil otherwise." | |
587 | (eq (car-safe obj) 'AVLTREE)) | |
588 | ||
589 | ||
590 | (defun avltree-compare-function (tree) | |
591 | "Return the comparision function for the avl tree TREE." | |
592 | (elib-avl-cmpfun tree)) | |
593 | ||
594 | ||
595 | (defun avltree-empty (tree) | |
596 | "Return t if TREE is emtpy, otherwise return nil." | |
597 | (null (elib-avl-root tree))) | |
598 | ||
599 | ||
600 | (defun avltree-enter (tree data) | |
601 | "In the avl tree TREE insert DATA. | |
602 | Return DATA." | |
603 | ||
604 | (elib-avl-do-enter (elib-avl-cmpfun tree) | |
605 | (elib-avl-dummyroot tree) | |
606 | 0 | |
607 | data) | |
608 | data) | |
609 | ||
610 | ||
611 | (defun avltree-delete (tree data) | |
612 | "From the avl tree TREE, delete DATA. | |
613 | Return the element in TREE which matched DATA, nil if no element matched." | |
614 | ||
615 | (elib-avl-do-delete (elib-avl-cmpfun tree) | |
616 | (elib-avl-dummyroot tree) | |
617 | 0 | |
618 | data)) | |
619 | ||
620 | ||
621 | (defun avltree-member (tree data) | |
622 | "Return the element in the avl tree TREE which matches DATA. | |
623 | Matching uses the compare function previously specified in `avltree-create' | |
624 | when TREE was created. | |
625 | ||
626 | If there is no such element in the tree, the value is nil." | |
627 | ||
628 | (let ((node (elib-avl-root tree)) | |
629 | (compare-function (elib-avl-cmpfun tree)) | |
630 | found) | |
631 | (while (and node | |
632 | (not found)) | |
633 | (cond | |
634 | ((funcall compare-function data (elib-node-data node)) | |
635 | (setq node (elib-node-left node))) | |
636 | ((funcall compare-function (elib-node-data node) data) | |
637 | (setq node (elib-node-right node))) | |
638 | (t | |
639 | (setq found t)))) | |
640 | ||
641 | (if node | |
642 | (elib-node-data node) | |
643 | nil))) | |
644 | ||
645 | ||
646 | ||
647 | (defun avltree-map (__map-function__ tree) | |
648 | "Apply MAP-FUNCTION to all elements in the avl tree TREE." | |
649 | (elib-avl-mapc | |
650 | (function (lambda (node) | |
651 | (elib-node-set-data node | |
652 | (funcall __map-function__ | |
653 | (elib-node-data node))))) | |
654 | (elib-avl-root tree))) | |
655 | ||
656 | ||
657 | ||
658 | (defun avltree-first (tree) | |
659 | "Return the first element in TREE, or nil if TREE is empty." | |
660 | ||
661 | (let ((node (elib-avl-root tree))) | |
662 | (if node | |
663 | (progn | |
664 | (while (elib-node-left node) | |
665 | (setq node (elib-node-left node))) | |
666 | (elib-node-data node)) | |
667 | nil))) | |
668 | ||
669 | ||
670 | (defun avltree-last (tree) | |
671 | "Return the last element in TREE, or nil if TREE is empty." | |
672 | (let ((node (elib-avl-root tree))) | |
673 | (if node | |
674 | (progn | |
675 | (while (elib-node-right node) | |
676 | (setq node (elib-node-right node))) | |
677 | (elib-node-data node)) | |
678 | nil))) | |
679 | ||
680 | ||
681 | (defun avltree-copy (tree) | |
682 | "Return a copy of the avl tree TREE." | |
683 | (let ((new-tree (avltree-create | |
684 | (elib-avl-cmpfun tree)))) | |
685 | (elib-node-set-left (elib-avl-dummyroot new-tree) | |
686 | (elib-avl-do-copy (elib-avl-root tree))) | |
687 | new-tree)) | |
688 | ||
689 | ||
690 | (defun avltree-flatten (tree) | |
691 | "Return a sorted list containing all elements of TREE." | |
692 | (nreverse | |
693 | (let ((treelist nil)) | |
694 | (elib-avl-mapc (function (lambda (node) | |
695 | (setq treelist (cons (elib-node-data node) | |
696 | treelist)))) | |
697 | (elib-avl-root tree)) | |
698 | treelist))) | |
699 | ||
700 | ||
701 | (defun avltree-size (tree) | |
702 | "Return the number of elements in TREE." | |
703 | (let ((treesize 0)) | |
704 | (elib-avl-mapc (function (lambda (data) | |
705 | (setq treesize (1+ treesize)) | |
706 | data)) | |
707 | (elib-avl-root tree)) | |
708 | treesize)) | |
709 | ||
710 | ||
711 | (defun avltree-clear (tree) | |
712 | "Clear the avl tree TREE." | |
713 | (elib-node-set-left (elib-avl-dummyroot tree) nil)) | |
714 | ||
715 | ;;; avltree.el ends here |