1 ;;; avl-tree.el --- balanced binary trees, AVL-trees
3 ;; Copyright (C) 1995, 2007 Free Software Foundation, Inc.
5 ;; Author: Per Cederqvist <ceder@lysator.liu.se>
6 ;; Inge Wallin <inge@lysator.liu.se>
7 ;; Thomas Bellman <bellman@lysator.liu.se>
9 ;; Created: 10 May 1991
10 ;; Keywords: extensions, data structures
12 ;; This file is part of GNU Emacs.
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)
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.
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.
31 ;; This file combines elib-node.el and avltree.el from Elib.
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
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.
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
46 ;; 'AVL-TREE in the car cell, and the second one having the tree
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.
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
57 ;;; ================================================================
58 ;;; Functions and macros handling an AVL tree node.
60 (defmacro avl-tree-node-create (left right data balance)
61 ;; Create and return an avl-tree node.
62 `(vector ,left ,right ,data ,balance))
64 (defmacro avl-tree-node-left (node)
65 ;; Return the left pointer of NODE.
68 (defmacro avl-tree-node-right (node)
69 ;; Return the right pointer of NODE.
72 (defmacro avl-tree-node-data (node)
73 ;; Return the data of NODE.
76 (defmacro avl-tree-node-set-left (node newleft)
77 ;; Set the left pointer of NODE to NEWLEFT.
78 `(aset ,node 0 ,newleft))
80 (defmacro avl-tree-node-set-right (node newright)
81 ;; Set the right pointer of NODE to NEWRIGHT.
82 `(aset ,node 1 ,newright))
84 (defmacro avl-tree-node-set-data (node newdata)
85 ;; Set the data of NODE to NEWDATA.
86 `(aset ,node 2 ,newdata))
88 (defmacro avl-tree-node-branch (node branch)
89 ;; Get value of a branch of a node.
91 ;; NODE is the node, and BRANCH is the branch.
92 ;; 0 for left pointer, 1 for right pointer and 2 for the data."
93 `(aref ,node ,branch))
95 (defmacro avl-tree-node-set-branch (node branch newval)
96 ;; Set value of a branch of a node.
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."
101 `(aset ,node ,branch ,newval))
103 (defmacro avl-tree-node-balance (node)
104 ;; Return the balance field of a node.
107 (defmacro avl-tree-node-set-balance (node newbal)
108 ;; Set the balance field of a node.
109 `(aset ,node 3 ,newbal))
112 ;;; ================================================================
113 ;;; Internal functions for use in the AVL tree package
115 (defmacro avl-tree-root (tree)
116 ;; Return the root node for an avl-tree. INTERNAL USE ONLY.
117 `(avl-tree-node-left (car (cdr ,tree))))
119 (defmacro avl-tree-dummyroot (tree)
120 ;; Return the dummy node of an avl-tree. INTERNAL USE ONLY.
123 (defmacro avl-tree-cmpfun (tree)
124 ;; Return the compare function of AVL tree TREE. INTERNAL USE ONLY.
127 ;; ----------------------------------------------------------------
130 (defun avl-tree-del-balance1 (node branch)
131 ;; Rebalance a tree and return t if the height of the tree has shrunk.
132 (let* ((br (avl-tree-node-branch node branch))
135 ((< (avl-tree-node-balance br) 0)
136 (avl-tree-node-set-balance br 0)
139 ((= (avl-tree-node-balance br) 0)
140 (avl-tree-node-set-balance br +1)
145 (setq p1 (avl-tree-node-right br)
146 b1 (avl-tree-node-balance p1))
148 ;; Single RR rotation.
150 (avl-tree-node-set-right br (avl-tree-node-left p1))
151 (avl-tree-node-set-left p1 br)
154 (avl-tree-node-set-balance br +1)
155 (avl-tree-node-set-balance p1 -1)
157 (avl-tree-node-set-balance br 0)
158 (avl-tree-node-set-balance p1 0)
160 (avl-tree-node-set-branch node branch p1)
163 ;; Double RL rotation.
164 (setq p2 (avl-tree-node-left p1)
165 b2 (avl-tree-node-balance p2))
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)
171 (avl-tree-node-set-balance br -1)
172 (avl-tree-node-set-balance br 0))
174 (avl-tree-node-set-balance p1 +1)
175 (avl-tree-node-set-balance p1 0))
176 (avl-tree-node-set-branch node branch p2)
177 (avl-tree-node-set-balance p2 0)
180 (defun avl-tree-del-balance2 (node branch)
181 (let* ((br (avl-tree-node-branch node branch))
184 ((> (avl-tree-node-balance br) 0)
185 (avl-tree-node-set-balance br 0)
188 ((= (avl-tree-node-balance br) 0)
189 (avl-tree-node-set-balance br -1)
194 (setq p1 (avl-tree-node-left br)
195 b1 (avl-tree-node-balance p1))
197 ;; Single LL rotation.
199 (avl-tree-node-set-left br (avl-tree-node-right p1))
200 (avl-tree-node-set-right p1 br)
203 (avl-tree-node-set-balance br -1)
204 (avl-tree-node-set-balance p1 +1)
206 (avl-tree-node-set-balance br 0)
207 (avl-tree-node-set-balance p1 0)
209 (avl-tree-node-set-branch node branch p1)
212 ;; Double LR rotation.
213 (setq p2 (avl-tree-node-right p1)
214 b2 (avl-tree-node-balance p2))
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)
220 (avl-tree-node-set-balance br +1)
221 (avl-tree-node-set-balance br 0))
223 (avl-tree-node-set-balance p1 -1)
224 (avl-tree-node-set-balance p1 0))
225 (avl-tree-node-set-branch node branch p2)
226 (avl-tree-node-set-balance p2 0)
229 (defun avl-tree-do-del-internal (node branch q)
230 (let* ((br (avl-tree-node-branch node branch)))
231 (if (avl-tree-node-right br)
232 (if (avl-tree-do-del-internal br +1 q)
233 (avl-tree-del-balance2 node branch))
234 (avl-tree-node-set-data q (avl-tree-node-data br))
235 (avl-tree-node-set-branch node branch
236 (avl-tree-node-left br))
239 (defun avl-tree-do-delete (cmpfun root branch data)
240 ;; Return t if the height of the tree has shrunk.
241 (let* ((br (avl-tree-node-branch root branch)))
246 ((funcall cmpfun data (avl-tree-node-data br))
247 (if (avl-tree-do-delete cmpfun br 0 data)
248 (avl-tree-del-balance1 root branch)))
250 ((funcall cmpfun (avl-tree-node-data br) data)
251 (if (avl-tree-do-delete cmpfun br 1 data)
252 (avl-tree-del-balance2 root branch)))
255 ;; Found it. Let's delete it.
257 ((null (avl-tree-node-right br))
258 (avl-tree-node-set-branch root branch (avl-tree-node-left br))
261 ((null (avl-tree-node-left br))
262 (avl-tree-node-set-branch root branch (avl-tree-node-right br))
266 (if (avl-tree-do-del-internal br 0 br)
267 (avl-tree-del-balance1 root branch))))))))
269 ;; ----------------------------------------------------------------
272 (defun avl-tree-enter-balance1 (node branch)
273 ;; Rebalance a tree and return t if the height of the tree has grown.
274 (let* ((br (avl-tree-node-branch node branch))
277 ((< (avl-tree-node-balance br) 0)
278 (avl-tree-node-set-balance br 0)
281 ((= (avl-tree-node-balance br) 0)
282 (avl-tree-node-set-balance br +1)
286 ;; Tree has grown => Rebalance.
287 (setq p1 (avl-tree-node-right br))
288 (if (> (avl-tree-node-balance p1) 0)
289 ;; Single RR rotation.
291 (avl-tree-node-set-right br (avl-tree-node-left p1))
292 (avl-tree-node-set-left p1 br)
293 (avl-tree-node-set-balance br 0)
294 (avl-tree-node-set-branch node branch p1))
296 ;; Double RL rotation.
297 (setq p2 (avl-tree-node-left p1)
298 b2 (avl-tree-node-balance p2))
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)
304 (avl-tree-node-set-balance br -1)
305 (avl-tree-node-set-balance br 0))
307 (avl-tree-node-set-balance p1 +1)
308 (avl-tree-node-set-balance p1 0))
309 (avl-tree-node-set-branch node branch p2))
310 (avl-tree-node-set-balance (avl-tree-node-branch node branch) 0)
313 (defun avl-tree-enter-balance2 (node branch)
314 ;; Return t if the tree has grown.
315 (let* ((br (avl-tree-node-branch node branch))
318 ((> (avl-tree-node-balance br) 0)
319 (avl-tree-node-set-balance br 0)
322 ((= (avl-tree-node-balance br) 0)
323 (avl-tree-node-set-balance br -1)
327 ;; Balance was -1 => Rebalance.
328 (setq p1 (avl-tree-node-left br))
329 (if (< (avl-tree-node-balance p1) 0)
330 ;; Single LL rotation.
332 (avl-tree-node-set-left br (avl-tree-node-right p1))
333 (avl-tree-node-set-right p1 br)
334 (avl-tree-node-set-balance br 0)
335 (avl-tree-node-set-branch node branch p1))
337 ;; Double LR rotation.
338 (setq p2 (avl-tree-node-right p1)
339 b2 (avl-tree-node-balance p2))
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)
345 (avl-tree-node-set-balance br +1)
346 (avl-tree-node-set-balance br 0))
348 (avl-tree-node-set-balance p1 -1)
349 (avl-tree-node-set-balance p1 0))
350 (avl-tree-node-set-branch node branch p2))
351 (avl-tree-node-set-balance (avl-tree-node-branch node branch) 0)
354 (defun avl-tree-do-enter (cmpfun root branch data)
355 ;; Return t if height of tree ROOT has grown. INTERNAL USE ONLY.
356 (let ((br (avl-tree-node-branch root branch)))
359 ;; Data not in tree, insert it.
360 (avl-tree-node-set-branch
361 root branch (avl-tree-node-create nil nil data 0))
364 ((funcall cmpfun data (avl-tree-node-data br))
365 (and (avl-tree-do-enter cmpfun br 0 data)
366 (avl-tree-enter-balance2 root branch)))
368 ((funcall cmpfun (avl-tree-node-data br) data)
369 (and (avl-tree-do-enter cmpfun br 1 data)
370 (avl-tree-enter-balance1 root branch)))
373 (avl-tree-node-set-data br data)
376 ;; ----------------------------------------------------------------
378 (defun avl-tree-mapc (map-function root)
379 ;; Apply MAP-FUNCTION to all nodes in the tree starting with ROOT.
380 ;; The function is applied in-order.
382 ;; Note: MAP-FUNCTION is applied to the node and not to the data itself.
383 ;; INTERNAL USE ONLY.
390 (avl-tree-node-left node))
391 ;; Do the left subtree first.
394 (setq node (avl-tree-node-left node)))
395 ;; Apply the function...
396 (funcall map-function node)
397 ;; and do the right subtree.
398 (if (avl-tree-node-right node)
399 (setq node (avl-tree-node-right node)
401 (setq node (pop stack)
404 (defun avl-tree-do-copy (root)
405 ;; Copy the tree with ROOT as root.
406 ;; Highly recursive. INTERNAL USE ONLY.
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))))
416 ;;; ================================================================
417 ;;; The public functions which operate on AVL trees.
419 (defun avl-tree-create (compare-function)
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."
424 (cons (avl-tree-node-create nil nil nil 0)
427 (defun avl-tree-p (obj)
428 "Return t if OBJ is an avl tree, nil otherwise."
429 (eq (car-safe obj) 'AVL-TREE))
431 (defun avl-tree-compare-function (tree)
432 "Return the comparision function for the avl tree TREE."
433 (avl-tree-cmpfun tree))
435 (defun avl-tree-empty (tree)
436 "Return t if TREE is emtpy, otherwise return nil."
437 (null (avl-tree-root tree)))
439 (defun avl-tree-enter (tree data)
440 "In the avl tree TREE insert DATA.
442 (avl-tree-do-enter (avl-tree-cmpfun tree)
443 (avl-tree-dummyroot tree)
448 (defun avl-tree-delete (tree data)
449 "From the avl tree TREE, delete DATA.
450 Return the element in TREE which matched DATA, nil if no element matched."
451 (avl-tree-do-delete (avl-tree-cmpfun tree)
452 (avl-tree-dummyroot tree)
456 (defun avl-tree-member (tree data)
457 "Return the element in the avl tree TREE which matches DATA.
458 Matching uses the compare function previously specified in `avl-tree-create'
459 when TREE was created.
461 If there is no such element in the tree, the value is nil."
462 (let ((node (avl-tree-root tree))
463 (compare-function (avl-tree-cmpfun tree))
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)))
475 (avl-tree-node-data node)
478 (defun avl-tree-map (__map-function__ tree)
479 "Apply MAP-FUNCTION to all elements in the avl tree TREE."
481 (function (lambda (node)
482 (avl-tree-node-set-data
483 node (funcall __map-function__
484 (avl-tree-node-data node)))))
485 (avl-tree-root tree)))
487 (defun avl-tree-first (tree)
488 "Return the first element in TREE, or nil if TREE is empty."
489 (let ((node (avl-tree-root tree)))
492 (while (avl-tree-node-left node)
493 (setq node (avl-tree-node-left node)))
494 (avl-tree-node-data node))
497 (defun avl-tree-last (tree)
498 "Return the last element in TREE, or nil if TREE is empty."
499 (let ((node (avl-tree-root tree)))
502 (while (avl-tree-node-right node)
503 (setq node (avl-tree-node-right node)))
504 (avl-tree-node-data node))
507 (defun avl-tree-copy (tree)
508 "Return a copy of the avl tree TREE."
509 (let ((new-tree (avl-tree-create (avl-tree-cmpfun tree))))
510 (avl-tree-node-set-left (avl-tree-dummyroot new-tree)
511 (avl-tree-do-copy (avl-tree-root tree)))
514 (defun avl-tree-flatten (tree)
515 "Return a sorted list containing all elements of TREE."
517 (let ((treelist nil))
519 (function (lambda (node)
520 (setq treelist (cons (avl-tree-node-data node)
522 (avl-tree-root tree))
525 (defun avl-tree-size (tree)
526 "Return the number of elements in TREE."
529 (function (lambda (data)
530 (setq treesize (1+ treesize))
532 (avl-tree-root tree))
535 (defun avl-tree-clear (tree)
536 "Clear the avl tree TREE."
537 (avl-tree-node-set-left (avl-tree-dummyroot tree) nil))
541 ;; arch-tag: 47e26701-43c9-4222-bd79-739eac6357a9
542 ;;; avl-tree.el ends here