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