Mercurial > emacs
comparison lisp/emacs-lisp/avl-tree.el @ 82901:18391b91e11f
Move things around; munge whitespace, indentation; nfc.
author | Thien-Thi Nguyen <ttn@gnuvola.org> |
---|---|
date | Mon, 27 Aug 2007 02:40:25 +0000 |
parents | 0ff5cfe89663 |
children | c27b2ab395b6 |
comparison
equal
deleted
inserted
replaced
82900:0ff5cfe89663 | 82901:18391b91e11f |
---|---|
52 ;; count, which is the difference in depth of the left and right | 52 ;; count, which is the difference in depth of the left and right |
53 ;; sub-trees. | 53 ;; sub-trees. |
54 | 54 |
55 ;;; Code: | 55 ;;; Code: |
56 | 56 |
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 | |
57 (defmacro avl-tree-node-left (node) | 64 (defmacro avl-tree-node-left (node) |
58 ;; Return the left pointer of NODE. | 65 ;; Return the left pointer of NODE. |
59 `(aref ,node 0)) | 66 `(aref ,node 0)) |
60 | 67 |
61 (defmacro avl-tree-node-right (node) | 68 (defmacro avl-tree-node-right (node) |
91 ;; NODE is the node, and BRANCH is the branch. | 98 ;; NODE is the node, and BRANCH is the branch. |
92 ;; 0 for left pointer, 1 for the right pointer and 2 for the data. | 99 ;; 0 for left pointer, 1 for the right pointer and 2 for the data. |
93 ;; NEWVAL is new value of the branch." | 100 ;; NEWVAL is new value of the branch." |
94 `(aset ,node ,branch ,newval)) | 101 `(aset ,node ,branch ,newval)) |
95 | 102 |
96 ;;; ================================================================ | |
97 ;;; Functions and macros handling an AVL tree node. | |
98 | |
99 (defmacro avl-tree-node-create (left right data balance) | |
100 ;; Create and return an avl-tree node. | |
101 `(vector ,left ,right ,data ,balance)) | |
102 | |
103 (defmacro avl-tree-node-balance (node) | 103 (defmacro avl-tree-node-balance (node) |
104 ;; Return the balance field of a node. | 104 ;; Return the balance field of a node. |
105 `(aref ,node 3)) | 105 `(aref ,node 3)) |
106 | 106 |
107 (defmacro avl-tree-node-set-balance (node newbal) | 107 (defmacro avl-tree-node-set-balance (node newbal) |
128 ;; Deleting data | 128 ;; Deleting data |
129 | 129 |
130 (defun avl-tree-del-balance1 (node branch) | 130 (defun avl-tree-del-balance1 (node branch) |
131 ;; Rebalance a tree and return t if the height of the tree has shrunk. | 131 ;; Rebalance a tree and return t if the height of the tree has shrunk. |
132 (let* ((br (avl-tree-node-branch node branch)) | 132 (let* ((br (avl-tree-node-branch node branch)) |
133 p1 | 133 p1 b1 p2 b2 result) |
134 b1 | |
135 p2 | |
136 b2 | |
137 result) | |
138 (cond | 134 (cond |
139 ((< (avl-tree-node-balance br) 0) | 135 ((< (avl-tree-node-balance br) 0) |
140 (avl-tree-node-set-balance br 0) | 136 (avl-tree-node-set-balance br 0) |
141 t) | 137 t) |
142 | 138 |
181 (avl-tree-node-set-balance p2 0) | 177 (avl-tree-node-set-balance p2 0) |
182 t))))) | 178 t))))) |
183 | 179 |
184 (defun avl-tree-del-balance2 (node branch) | 180 (defun avl-tree-del-balance2 (node branch) |
185 (let* ((br (avl-tree-node-branch node branch)) | 181 (let* ((br (avl-tree-node-branch node branch)) |
186 p1 | 182 p1 b1 p2 b2 result) |
187 b1 | |
188 p2 | |
189 b2 | |
190 result) | |
191 (cond | 183 (cond |
192 ((> (avl-tree-node-balance br) 0) | 184 ((> (avl-tree-node-balance br) 0) |
193 (avl-tree-node-set-balance br 0) | 185 (avl-tree-node-set-balance br 0) |
194 t) | 186 t) |
195 | 187 |
233 (avl-tree-node-set-branch node branch p2) | 225 (avl-tree-node-set-branch node branch p2) |
234 (avl-tree-node-set-balance p2 0) | 226 (avl-tree-node-set-balance p2 0) |
235 t))))) | 227 t))))) |
236 | 228 |
237 (defun avl-tree-do-del-internal (node branch q) | 229 (defun avl-tree-do-del-internal (node branch q) |
238 | |
239 (let* ((br (avl-tree-node-branch node branch))) | 230 (let* ((br (avl-tree-node-branch node branch))) |
240 (if (avl-tree-node-right br) | 231 (if (avl-tree-node-right br) |
241 (if (avl-tree-do-del-internal br +1 q) | 232 (if (avl-tree-do-del-internal br +1 q) |
242 (avl-tree-del-balance2 node branch)) | 233 (avl-tree-del-balance2 node branch)) |
243 (avl-tree-node-set-data q (avl-tree-node-data br)) | 234 (avl-tree-node-set-data q (avl-tree-node-data br)) |
244 (avl-tree-node-set-branch node branch | 235 (avl-tree-node-set-branch node branch |
245 (avl-tree-node-left br)) | 236 (avl-tree-node-left br)) |
246 t))) | 237 t))) |
247 | 238 |
248 (defun avl-tree-do-delete (cmpfun root branch data) | 239 (defun avl-tree-do-delete (cmpfun root branch data) |
249 ;; Return t if the height of the tree has shrunk. | 240 ;; Return t if the height of the tree has shrunk. |
250 (let* ((br (avl-tree-node-branch root branch))) | 241 (let* ((br (avl-tree-node-branch root branch))) |
279 ;; Entering data | 270 ;; Entering data |
280 | 271 |
281 (defun avl-tree-enter-balance1 (node branch) | 272 (defun avl-tree-enter-balance1 (node branch) |
282 ;; Rebalance a tree and return t if the height of the tree has grown. | 273 ;; Rebalance a tree and return t if the height of the tree has grown. |
283 (let* ((br (avl-tree-node-branch node branch)) | 274 (let* ((br (avl-tree-node-branch node branch)) |
284 p1 | 275 p1 p2 b2 result) |
285 p2 | |
286 b2 | |
287 result) | |
288 (cond | 276 (cond |
289 ((< (avl-tree-node-balance br) 0) | 277 ((< (avl-tree-node-balance br) 0) |
290 (avl-tree-node-set-balance br 0) | 278 (avl-tree-node-set-balance br 0) |
291 nil) | 279 nil) |
292 | 280 |
323 nil)))) | 311 nil)))) |
324 | 312 |
325 (defun avl-tree-enter-balance2 (node branch) | 313 (defun avl-tree-enter-balance2 (node branch) |
326 ;; Return t if the tree has grown. | 314 ;; Return t if the tree has grown. |
327 (let* ((br (avl-tree-node-branch node branch)) | 315 (let* ((br (avl-tree-node-branch node branch)) |
328 p1 | 316 p1 p2 b2) |
329 p2 | |
330 b2) | |
331 (cond | 317 (cond |
332 ((> (avl-tree-node-balance br) 0) | 318 ((> (avl-tree-node-balance br) 0) |
333 (avl-tree-node-set-balance br 0) | 319 (avl-tree-node-set-balance br 0) |
334 nil) | 320 nil) |
335 | 321 |
369 ;; Return t if height of tree ROOT has grown. INTERNAL USE ONLY. | 355 ;; Return t if height of tree ROOT has grown. INTERNAL USE ONLY. |
370 (let ((br (avl-tree-node-branch root branch))) | 356 (let ((br (avl-tree-node-branch root branch))) |
371 (cond | 357 (cond |
372 ((null br) | 358 ((null br) |
373 ;; Data not in tree, insert it. | 359 ;; Data not in tree, insert it. |
374 (avl-tree-node-set-branch root branch | 360 (avl-tree-node-set-branch |
375 (avl-tree-node-create nil nil data 0)) | 361 root branch (avl-tree-node-create nil nil data 0)) |
376 t) | 362 t) |
377 | 363 |
378 ((funcall cmpfun data (avl-tree-node-data br)) | 364 ((funcall cmpfun data (avl-tree-node-data br)) |
379 (and (avl-tree-do-enter cmpfun | 365 (and (avl-tree-do-enter cmpfun br 0 data) |
380 br | |
381 0 data) | |
382 (avl-tree-enter-balance2 root branch))) | 366 (avl-tree-enter-balance2 root branch))) |
383 | 367 |
384 ((funcall cmpfun (avl-tree-node-data br) data) | 368 ((funcall cmpfun (avl-tree-node-data br) data) |
385 (and (avl-tree-do-enter cmpfun | 369 (and (avl-tree-do-enter cmpfun br 1 data) |
386 br | |
387 1 data) | |
388 (avl-tree-enter-balance1 root branch))) | 370 (avl-tree-enter-balance1 root branch))) |
389 | 371 |
390 (t | 372 (t |
391 (avl-tree-node-set-data br data) | 373 (avl-tree-node-set-data br data) |
392 nil)))) | 374 nil)))) |
422 (defun avl-tree-do-copy (root) | 404 (defun avl-tree-do-copy (root) |
423 ;; Copy the tree with ROOT as root. | 405 ;; Copy the tree with ROOT as root. |
424 ;; Highly recursive. INTERNAL USE ONLY. | 406 ;; Highly recursive. INTERNAL USE ONLY. |
425 (if (null root) | 407 (if (null root) |
426 nil | 408 nil |
427 (avl-tree-node-create (avl-tree-do-copy (avl-tree-node-left root)) | 409 (avl-tree-node-create |
428 (avl-tree-do-copy (avl-tree-node-right root)) | 410 (avl-tree-do-copy (avl-tree-node-left root)) |
429 (avl-tree-node-data root) | 411 (avl-tree-do-copy (avl-tree-node-right root)) |
430 (avl-tree-node-balance root)))) | 412 (avl-tree-node-data root) |
413 (avl-tree-node-balance root)))) | |
431 | 414 |
432 | 415 |
433 ;;; ================================================================ | 416 ;;; ================================================================ |
434 ;;; The public functions which operate on AVL trees. | 417 ;;; The public functions which operate on AVL trees. |
435 | 418 |
486 (setq node (avl-tree-node-left node))) | 469 (setq node (avl-tree-node-left node))) |
487 ((funcall compare-function (avl-tree-node-data node) data) | 470 ((funcall compare-function (avl-tree-node-data node) data) |
488 (setq node (avl-tree-node-right node))) | 471 (setq node (avl-tree-node-right node))) |
489 (t | 472 (t |
490 (setq found t)))) | 473 (setq found t)))) |
491 | |
492 (if node | 474 (if node |
493 (avl-tree-node-data node) | 475 (avl-tree-node-data node) |
494 nil))) | 476 nil))) |
495 | 477 |
496 (defun avl-tree-map (__map-function__ tree) | 478 (defun avl-tree-map (__map-function__ tree) |
497 "Apply MAP-FUNCTION to all elements in the avl tree TREE." | 479 "Apply MAP-FUNCTION to all elements in the avl tree TREE." |
498 (avl-tree-mapc | 480 (avl-tree-mapc |
499 (function (lambda (node) | 481 (function (lambda (node) |
500 (avl-tree-node-set-data node | 482 (avl-tree-node-set-data |
501 (funcall __map-function__ | 483 node (funcall __map-function__ |
502 (avl-tree-node-data node))))) | 484 (avl-tree-node-data node))))) |
503 (avl-tree-root tree))) | 485 (avl-tree-root tree))) |
504 | 486 |
505 (defun avl-tree-first (tree) | 487 (defun avl-tree-first (tree) |
506 "Return the first element in TREE, or nil if TREE is empty." | 488 "Return the first element in TREE, or nil if TREE is empty." |
507 (let ((node (avl-tree-root tree))) | 489 (let ((node (avl-tree-root tree))) |
522 (avl-tree-node-data node)) | 504 (avl-tree-node-data node)) |
523 nil))) | 505 nil))) |
524 | 506 |
525 (defun avl-tree-copy (tree) | 507 (defun avl-tree-copy (tree) |
526 "Return a copy of the avl tree TREE." | 508 "Return a copy of the avl tree TREE." |
527 (let ((new-tree (avl-tree-create | 509 (let ((new-tree (avl-tree-create (avl-tree-cmpfun tree)))) |
528 (avl-tree-cmpfun tree)))) | |
529 (avl-tree-node-set-left (avl-tree-dummyroot new-tree) | 510 (avl-tree-node-set-left (avl-tree-dummyroot new-tree) |
530 (avl-tree-do-copy (avl-tree-root tree))) | 511 (avl-tree-do-copy (avl-tree-root tree))) |
531 new-tree)) | 512 new-tree)) |
532 | 513 |
533 (defun avl-tree-flatten (tree) | 514 (defun avl-tree-flatten (tree) |
534 "Return a sorted list containing all elements of TREE." | 515 "Return a sorted list containing all elements of TREE." |
535 (nreverse | 516 (nreverse |
536 (let ((treelist nil)) | 517 (let ((treelist nil)) |
537 (avl-tree-mapc (function (lambda (node) | 518 (avl-tree-mapc |
538 (setq treelist (cons (avl-tree-node-data node) | 519 (function (lambda (node) |
539 treelist)))) | 520 (setq treelist (cons (avl-tree-node-data node) |
540 (avl-tree-root tree)) | 521 treelist)))) |
522 (avl-tree-root tree)) | |
541 treelist))) | 523 treelist))) |
542 | 524 |
543 (defun avl-tree-size (tree) | 525 (defun avl-tree-size (tree) |
544 "Return the number of elements in TREE." | 526 "Return the number of elements in TREE." |
545 (let ((treesize 0)) | 527 (let ((treesize 0)) |
546 (avl-tree-mapc (function (lambda (data) | 528 (avl-tree-mapc |
547 (setq treesize (1+ treesize)) | 529 (function (lambda (data) |
548 data)) | 530 (setq treesize (1+ treesize)) |
549 (avl-tree-root tree)) | 531 data)) |
532 (avl-tree-root tree)) | |
550 treesize)) | 533 treesize)) |
551 | 534 |
552 (defun avl-tree-clear (tree) | 535 (defun avl-tree-clear (tree) |
553 "Clear the avl tree TREE." | 536 "Clear the avl tree TREE." |
554 (avl-tree-node-set-left (avl-tree-dummyroot tree) nil)) | 537 (avl-tree-node-set-left (avl-tree-dummyroot tree) nil)) |