lisp/emacs-lisp/avl-tree.el

   1 ;;; avl-tree.el --- balanced binary trees, AVL-trees
   2
   3 ;; Copyright (C) 1995, 2007-2012  Free Software Foundation, Inc.
   4
   5 ;; Author: Per Cederqvist <ceder@lysator.liu.se>
   6 ;;         Inge Wallin <inge@lysator.liu.se>
   7 ;;         Thomas Bellman <bellman@lysator.liu.se>
   8 ;;         Toby Cubitt <toby-predictive@dr-qubit.org>
   9 ;; Maintainer: FSF
  10 ;; Created: 10 May 1991
  11 ;; Keywords: extensions, data structures, AVL, tree
  12
  13 ;; This file is part of GNU Emacs.
  14
  15 ;; GNU Emacs is free software: you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation, either version 3 of the License, or
  18 ;; (at your option) any later version.
  19
  20 ;; GNU Emacs is distributed in the hope that it will be useful,
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;; GNU General Public License for more details.
  24
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  27
  28 ;;; Commentary:
  29
  30 ;; An AVL tree is a self-balancing binary tree. As such, inserting,
  31 ;; deleting, and retrieving data from an AVL tree containing n elements
  32 ;; is O(log n). It is somewhat more rigidly balanced than other
  33 ;; self-balancing binary trees (such as red-black trees and AA trees),
  34 ;; making insertion slightly slower, deletion somewhat slower, and
  35 ;; retrieval somewhat faster (the asymptotic scaling is of course the
  36 ;; same for all types). Thus it may be a good choice when the tree will
  37 ;; be relatively static, i.e. data will be retrieved more often than
  38 ;; they are modified.
  39 ;;
  40 ;; Internally, a tree consists of two elements, the root node and the
  41 ;; comparison function. The actual tree has a dummy node as its root
  42 ;; with the real root in the left pointer, which allows the root node to
  43 ;; be treated on a par with all other nodes.
  44 ;;
  45 ;; Each node of the tree consists of one data element, one left
  46 ;; sub-tree, one right sub-tree, and a balance count. The latter is the
  47 ;; difference in depth of the left and right sub-trees.
  48 ;;
  49 ;; The functions with names of the form "avl-tree--" are intended for
  50 ;; internal use only.
  51
  52 ;;; Code:
  53
  54 (eval-when-compile (require 'cl))
  55
  56
  57
  58 ;; ================================================================
  59 ;;; Internal functions and macros for use in the AVL tree package
  60
  61
  62 ;; ----------------------------------------------------------------
  63 ;; Functions and macros handling an AVL tree.
  64
  65 (defstruct (avl-tree-
  66             ;; A tagged list is the pre-defstruct representation.
  67             ;; (:type list)
  68             :named
  69             (:constructor nil)
  70             (:constructor avl-tree--create (cmpfun))
  71             (:predicate avl-tree-p)
  72             (:copier nil))
  73   (dummyroot (avl-tree--node-create nil nil nil 0))
  74   cmpfun)
  75
  76 (defmacro avl-tree--root (tree)
  77   ;; Return the root node for an AVL tree.  INTERNAL USE ONLY.
  78   `(avl-tree--node-left (avl-tree--dummyroot ,tree)))
  79
  80 (defsetf avl-tree--root (tree) (node)
  81   `(setf (avl-tree--node-left (avl-tree--dummyroot ,tree)) ,node))
  82
  83
  84
  85 ;; ----------------------------------------------------------------
  86 ;; Functions and macros handling an AVL tree node.
  87
  88 (defstruct (avl-tree--node
  89             ;; We force a representation without tag so it matches the
  90             ;; pre-defstruct representation. Also we use the underlying
  91             ;; representation in the implementation of
  92             ;; avl-tree--node-branch.
  93             (:type vector)
  94             (:constructor nil)
  95             (:constructor avl-tree--node-create (left right data balance))
  96             (:copier nil))
  97   left right data balance)
  98
  99
 100 (defalias 'avl-tree--node-branch 'aref
 101   ;; This implementation is efficient but breaks the defstruct
 102   ;; abstraction.  An alternative could be (funcall (aref [avl-tree-left
 103   ;; avl-tree-right avl-tree-data] branch) node)
 104   "Get value of a branch of a node.
 105 NODE is the node, and BRANCH is the branch.
 106 0 for left pointer, 1 for right pointer and 2 for the data.")
 107
 108
 109 ;; The funcall/aref trick wouldn't work for the setf method, unless we
 110 ;; tried to access the underlying setter function, but this wouldn't be
 111 ;; portable either.
 112 (defsetf avl-tree--node-branch aset)
 113
 114
 115
 116 ;; ----------------------------------------------------------------
 117 ;; Convenience macros
 118
 119 (defmacro avl-tree--switch-dir (dir)
 120   "Return opposite direction to DIR (0 = left, 1 = right)."
 121   `(- 1 ,dir))
 122
 123 (defmacro avl-tree--dir-to-sign (dir)
 124   "Convert direction (0,1) to sign factor (-1,+1)."
 125   `(1- (* 2 ,dir)))
 126
 127 (defmacro avl-tree--sign-to-dir (dir)
 128   "Convert sign factor (-x,+x) to direction (0,1)."
 129   `(if (< ,dir 0) 0 1))
 130
 131
 132 ;; ----------------------------------------------------------------
 133 ;;                          Deleting data
 134
 135 (defun avl-tree--del-balance (node branch dir)
 136   "Rebalance a tree after deleting a node.
 137 The deletion was done from the left (DIR=0) or right (DIR=1) sub-tree of the
 138 left (BRANCH=0) or right (BRANCH=1) child of NODE.
 139 Return t if the height of the tree has shrunk."
 140   ;; (or is it vice-versa for BRANCH?)
 141   (let ((br (avl-tree--node-branch node branch))
 142         ;; opposite direction: 0,1 -> 1,0
 143         (opp (avl-tree--switch-dir dir))
 144         ;; direction 0,1 -> sign factor -1,+1
 145         (sgn (avl-tree--dir-to-sign dir))
 146         p1 b1 p2 b2)
 147     (cond
 148      ((> (* sgn (avl-tree--node-balance br)) 0)
 149       (setf (avl-tree--node-balance br) 0)
 150       t)
 151
 152      ((= (avl-tree--node-balance br) 0)
 153       (setf (avl-tree--node-balance br) (- sgn))
 154       nil)
 155
 156      (t
 157       ;; Rebalance.
 158       (setq p1 (avl-tree--node-branch br opp)
 159             b1 (avl-tree--node-balance p1))
 160       (if (<= (* sgn b1) 0)
 161           ;; Single rotation.
 162           (progn
 163             (setf (avl-tree--node-branch br opp)
 164                     (avl-tree--node-branch p1 dir)
 165                   (avl-tree--node-branch p1 dir) br
 166                   (avl-tree--node-branch node branch) p1)
 167             (if (= 0 b1)
 168                 (progn
 169                   (setf (avl-tree--node-balance br) (- sgn)
 170                         (avl-tree--node-balance p1) sgn)
 171                   nil)  ; height hasn't changed
 172               (setf (avl-tree--node-balance br) 0)
 173               (setf (avl-tree--node-balance p1) 0)
 174               t))  ; height has changed
 175
 176         ;; Double rotation.
 177         (setf p2 (avl-tree--node-branch p1 dir)
 178               b2 (avl-tree--node-balance p2)
 179               (avl-tree--node-branch p1 dir)
 180                 (avl-tree--node-branch p2 opp)
 181               (avl-tree--node-branch p2 opp) p1
 182               (avl-tree--node-branch br opp)
 183                 (avl-tree--node-branch p2 dir)
 184               (avl-tree--node-branch p2 dir) br
 185               (avl-tree--node-balance br)
 186                 (if (< (* sgn b2) 0) sgn 0)
 187               (avl-tree--node-balance p1)
 188                 (if (> (* sgn b2) 0) (- sgn) 0)
 189               (avl-tree--node-branch node branch) p2
 190               (avl-tree--node-balance p2) 0)
 191         t)))))
 192
 193 (defun avl-tree--do-del-internal (node branch q)
 194   (let ((br (avl-tree--node-branch node branch)))
 195     (if (avl-tree--node-right br)
 196         (if (avl-tree--do-del-internal br 1 q)
 197             (avl-tree--del-balance node branch 1))
 198       (setf (avl-tree--node-data q) (avl-tree--node-data br)
 199             (avl-tree--node-branch node branch)
 200               (avl-tree--node-left br))
 201       t)))
 202
 203 (defun avl-tree--do-delete (cmpfun root branch data test nilflag)
 204   "Delete DATA from BRANCH of node ROOT.
 205 \(See `avl-tree-delete' for TEST and NILFLAG).
 206
 207 Return cons cell (SHRUNK . DATA), where SHRUNK is t if the
 208 height of the tree has shrunk and nil otherwise, and DATA is
 209 the related data."
 210   (let ((br (avl-tree--node-branch root branch)))
 211     (cond
 212      ;; DATA not in tree.
 213      ((null br)
 214       (cons nil nilflag))
 215
 216      ((funcall cmpfun data (avl-tree--node-data br))
 217       (let ((ret (avl-tree--do-delete cmpfun br 0 data test nilflag)))
 218         (cons (if (car ret) (avl-tree--del-balance root branch 0))
 219               (cdr ret))))
 220
 221      ((funcall cmpfun (avl-tree--node-data br) data)
 222       (let ((ret (avl-tree--do-delete cmpfun br 1 data test nilflag)))
 223         (cons (if (car ret) (avl-tree--del-balance root branch 1))
 224               (cdr ret))))
 225
 226      (t  ; Found it.
 227       ;; if it fails TEST, do nothing
 228       (if (and test (not (funcall test (avl-tree--node-data br))))
 229           (cons nil nilflag)
 230         (cond
 231          ((null (avl-tree--node-right br))
 232           (setf (avl-tree--node-branch root branch)
 233                 (avl-tree--node-left br))
 234           (cons t (avl-tree--node-data br)))
 235
 236          ((null (avl-tree--node-left br))
 237           (setf (avl-tree--node-branch root branch)
 238                 (avl-tree--node-right br))
 239           (cons t (avl-tree--node-data br)))
 240
 241          (t
 242           (if (avl-tree--do-del-internal br 0 br)
 243               (cons (avl-tree--del-balance root branch 0)
 244                     (avl-tree--node-data br))
 245             (cons nil (avl-tree--node-data br))))
 246          ))))))
 247
 248
 249
 250 ;; ----------------------------------------------------------------
 251 ;;                           Entering data
 252
 253 (defun avl-tree--enter-balance (node branch dir)
 254   "Rebalance tree after an insertion
 255 into the left (DIR=0) or right (DIR=1) sub-tree of the
 256 left (BRANCH=0) or right (BRANCH=1) child of NODE.
 257 Return t if the height of the tree has grown."
 258   (let ((br (avl-tree--node-branch node branch))
 259         ;; opposite direction: 0,1 -> 1,0
 260         (opp (avl-tree--switch-dir dir))
 261         ;; direction 0,1 -> sign factor -1,+1
 262         (sgn (avl-tree--dir-to-sign dir))
 263         p1 p2 b2 result)
 264     (cond
 265      ((< (* sgn (avl-tree--node-balance br)) 0)
 266       (setf (avl-tree--node-balance br) 0)
 267       nil)
 268
 269      ((= (avl-tree--node-balance br) 0)
 270       (setf (avl-tree--node-balance br) sgn)
 271       t)
 272
 273      (t
 274       ;; Tree has grown => Rebalance.
 275       (setq p1 (avl-tree--node-branch br dir))
 276       (if (> (* sgn (avl-tree--node-balance p1)) 0)
 277           ;; Single rotation.
 278           (progn
 279             (setf (avl-tree--node-branch br dir)
 280                   (avl-tree--node-branch p1 opp))
 281             (setf (avl-tree--node-branch p1 opp) br)
 282             (setf (avl-tree--node-balance br) 0)
 283             (setf (avl-tree--node-branch node branch) p1))
 284
 285         ;; Double rotation.
 286         (setf p2 (avl-tree--node-branch p1 opp)
 287               b2 (avl-tree--node-balance p2)
 288               (avl-tree--node-branch p1 opp)
 289                 (avl-tree--node-branch p2 dir)
 290               (avl-tree--node-branch p2 dir) p1
 291               (avl-tree--node-branch br dir)
 292                 (avl-tree--node-branch p2 opp)
 293               (avl-tree--node-branch p2 opp) br
 294               (avl-tree--node-balance br)
 295                 (if (> (* sgn b2) 0) (- sgn) 0)
 296               (avl-tree--node-balance p1)
 297                 (if (< (* sgn b2) 0) sgn 0)
 298               (avl-tree--node-branch node branch) p2
 299               (avl-tree--node-balance
 300                (avl-tree--node-branch node branch)) 0))
 301       nil))))
 302
 303 (defun avl-tree--do-enter (cmpfun root branch data &optional updatefun)
 304   "Enter DATA in BRANCH of ROOT node.
 305 \(See `avl-tree-enter' for UPDATEFUN).
 306
 307 Return cons cell (GREW . DATA), where GREW is t if height
 308 of tree ROOT has grown and nil otherwise, and DATA is the
 309 inserted data."
 310   (let ((br (avl-tree--node-branch root branch)))
 311     (cond
 312      ((null br)
 313       ;; Data not in tree, insert it.
 314       (setf (avl-tree--node-branch root branch)
 315             (avl-tree--node-create nil nil data 0))
 316       (cons t data))
 317
 318      ((funcall cmpfun data (avl-tree--node-data br))
 319       (let ((ret (avl-tree--do-enter cmpfun br 0 data updatefun)))
 320         (cons (and (car ret) (avl-tree--enter-balance root branch 0))
 321               (cdr ret))))
 322
 323      ((funcall cmpfun (avl-tree--node-data br) data)
 324       (let ((ret (avl-tree--do-enter cmpfun br 1 data updatefun)))
 325         (cons (and (car ret) (avl-tree--enter-balance root branch 1))
 326               (cdr ret))))
 327
 328      ;; Data already in tree, update it.
 329      (t
 330       (let ((newdata
 331              (if updatefun
 332                  (funcall updatefun data (avl-tree--node-data br))
 333                data)))
 334         (if (or (funcall cmpfun newdata data)
 335                 (funcall cmpfun data newdata))
 336             (error "avl-tree-enter:\
 337  updated data does not match existing data"))
 338         (setf (avl-tree--node-data br) newdata)
 339         (cons nil newdata))  ; return value
 340       ))))
 341
 342 ;; ----------------------------------------------------------------
 343
 344
 345 ;;; INTERNAL USE ONLY
 346 (defun avl-tree--mapc (map-function root dir)
 347   "Apply MAP-FUNCTION to all nodes in the tree starting with ROOT.
 348 The function is applied in-order, either ascending (DIR=0) or
 349 descending (DIR=1).
 350
 351 Note: MAP-FUNCTION is applied to the node and not to the data
 352 itself."
 353   (let ((node root)
 354         (stack nil)
 355         (go-dir t))
 356     (push nil stack)
 357     (while node
 358       (if (and go-dir
 359                (avl-tree--node-branch node dir))
 360           ;; Do the DIR subtree first.
 361           (progn
 362             (push node stack)
 363             (setq node (avl-tree--node-branch node dir)))
 364         ;; Apply the function...
 365         (funcall map-function node)
 366         ;; and do the opposite subtree.
 367         (setq node (if (setq go-dir (avl-tree--node-branch
 368                                      node (avl-tree--switch-dir dir)))
 369                        (avl-tree--node-branch
 370                         node (avl-tree--switch-dir dir))
 371                      (pop stack)))))))
 372
 373 ;;; INTERNAL USE ONLY
 374 (defun avl-tree--do-copy (root)
 375   "Copy the AVL tree with ROOT as root.  Highly recursive."
 376   (if (null root)
 377       nil
 378     (avl-tree--node-create
 379      (avl-tree--do-copy (avl-tree--node-left root))
 380      (avl-tree--do-copy (avl-tree--node-right root))
 381      (avl-tree--node-data root)
 382      (avl-tree--node-balance root))))
 383
 384 (defstruct (avl-tree--stack
 385             (:constructor nil)
 386             (:constructor avl-tree--stack-create
 387                           (tree &optional reverse
 388                                 &aux
 389                                 (store
 390                                  (if (avl-tree-empty tree)
 391                                      nil
 392                                    (list (avl-tree--root tree))))))
 393             (:copier nil))
 394   reverse store)
 395
 396 (defalias 'avl-tree-stack-p 'avl-tree--stack-p
 397   "Return t if argument is an avl-tree-stack, nil otherwise.")
 398
 399 (defun avl-tree--stack-repopulate (stack)
 400   ;; Recursively push children of the node at the head of STACK onto the
 401   ;; front of the STACK, until a leaf is reached.
 402   (let ((node (car (avl-tree--stack-store stack)))
 403         (dir (if (avl-tree--stack-reverse stack) 1 0)))
 404     (when node  ; check for empty stack
 405       (while (setq node (avl-tree--node-branch node dir))
 406         (push node (avl-tree--stack-store stack))))))
 407
 408
 409 ;; ================================================================
 410 ;;; The public functions which operate on AVL trees.
 411
 412 ;; define public alias for constructors so that we can set docstring
 413 (defalias 'avl-tree-create 'avl-tree--create
 414   "Create an empty AVL tree.
 415 COMPARE-FUNCTION is a function which takes two arguments, A and B,
 416 and returns non-nil if A is less than B, and nil otherwise.")
 417
 418 (defalias 'avl-tree-compare-function 'avl-tree--cmpfun
 419   "Return the comparison function for the AVL tree TREE.
 420
 421 \(fn TREE)")
 422
 423 (defun avl-tree-empty (tree)
 424   "Return t if AVL tree TREE is empty, otherwise return nil."
 425   (null (avl-tree--root tree)))
 426
 427 (defun avl-tree-enter (tree data &optional updatefun)
 428   "Insert DATA into the AVL tree TREE.
 429
 430 If an element that matches DATA (according to the tree's
 431 comparison function, see `avl-tree-create') already exists in
 432 TREE, it will be replaced by DATA by default.
 433
 434 If UPDATEFUN is supplied and an element matching DATA already
 435 exists in TREE, UPDATEFUN is called with two arguments: DATA, and
 436 the matching element.  Its return value replaces the existing
 437 element.  This value *must* itself match DATA (and hence the
 438 pre-existing data), or an error will occur.
 439
 440 Returns the new data."
 441   (cdr (avl-tree--do-enter (avl-tree--cmpfun tree)
 442                            (avl-tree--dummyroot tree)
 443                            0 data updatefun)))
 444
 445 (defun avl-tree-delete (tree data &optional test nilflag)
 446   "Delete the element matching DATA from the AVL tree TREE.
 447 Matching uses the comparison function previously specified in
 448 `avl-tree-create' when TREE was created.
 449
 450 Returns the deleted element, or nil if no matching element was
 451 found.
 452
 453 Optional argument NILFLAG specifies a value to return instead of
 454 nil if nothing was deleted, so that this case can be
 455 distinguished from the case of a successfully deleted null
 456 element.
 457
 458 If supplied, TEST specifies a test that a matching element must
 459 pass before it is deleted.  If a matching element is found, it is
 460 passed as an argument to TEST, and is deleted only if the return
 461 value is non-nil."
 462   (cdr (avl-tree--do-delete (avl-tree--cmpfun tree)
 463                             (avl-tree--dummyroot tree)
 464                             0 data test nilflag)))
 465
 466
 467 (defun avl-tree-member (tree data &optional nilflag)
 468   "Return the element in the AVL tree TREE which matches DATA.
 469 Matching uses the comparison function previously specified in
 470 `avl-tree-create' when TREE was created.
 471
 472 If there is no such element in the tree, nil is
 473 returned.  Optional argument NILFLAG specifies a value to return
 474 instead of nil in this case.  This allows non-existent elements to
 475 be distinguished from a null element.  (See also
 476 `avl-tree-member-p', which does this for you.)"
 477   (let ((node (avl-tree--root tree))
 478         (compare-function (avl-tree--cmpfun tree)))
 479     (catch 'found
 480       (while node
 481         (cond
 482          ((funcall compare-function data (avl-tree--node-data node))
 483           (setq node (avl-tree--node-left node)))
 484          ((funcall compare-function (avl-tree--node-data node) data)
 485           (setq node (avl-tree--node-right node)))
 486          (t (throw 'found (avl-tree--node-data node)))))
 487       nilflag)))
 488
 489
 490 (defun avl-tree-member-p (tree data)
 491   "Return t if an element matching DATA exists in the AVL tree TREE.
 492 Otherwise return nil.  Matching uses the comparison function
 493 previously specified in `avl-tree-create' when TREE was created."
 494   (let ((flag '(nil)))
 495     (not (eq (avl-tree-member tree data flag) flag))))
 496
 497
 498 (defun avl-tree-map (__map-function__ tree &optional reverse)
 499   "Modify all elements in the AVL tree TREE by applying FUNCTION.
 500
 501 Each element is replaced by the return value of FUNCTION applied
 502 to that element.
 503
 504 FUNCTION is applied to the elements in ascending order, or
 505 descending order if REVERSE is non-nil."
 506   (avl-tree--mapc
 507    (lambda (node)
 508      (setf (avl-tree--node-data node)
 509            (funcall __map-function__ (avl-tree--node-data node))))
 510    (avl-tree--root tree)
 511    (if reverse 1 0)))
 512
 513
 514 (defun avl-tree-mapc (__map-function__ tree &optional reverse)
 515   "Apply FUNCTION to all elements in AVL tree TREE,
 516 for side-effect only.
 517
 518 FUNCTION is applied to the elements in ascending order, or
 519 descending order if REVERSE is non-nil."
 520   (avl-tree--mapc
 521    (lambda (node)
 522      (funcall __map-function__ (avl-tree--node-data node)))
 523    (avl-tree--root tree)
 524    (if reverse 1 0)))
 525
 526
 527 (defun avl-tree-mapf
 528   (__map-function__ combinator tree &optional reverse)
 529   "Apply FUNCTION to all elements in AVL tree TREE,
 530 and combine the results using COMBINATOR.
 531
 532 The FUNCTION is applied and the results are combined in ascending
 533 order, or descending order if REVERSE is non-nil."
 534   (let (avl-tree-mapf--accumulate)
 535     (avl-tree--mapc
 536      (lambda (node)
 537        (setq avl-tree-mapf--accumulate
 538              (funcall combinator
 539                       (funcall __map-function__
 540                                (avl-tree--node-data node))
 541                       avl-tree-mapf--accumulate)))
 542      (avl-tree--root tree)
 543      (if reverse 0 1))
 544     (nreverse avl-tree-mapf--accumulate)))
 545
 546
 547 (defun avl-tree-mapcar (__map-function__ tree &optional reverse)
 548   "Apply FUNCTION to all elements in AVL tree TREE,
 549 and make a list of the results.
 550
 551 The FUNCTION is applied and the list constructed in ascending
 552 order, or descending order if REVERSE is non-nil.
 553
 554 Note that if you don't care about the order in which FUNCTION is
 555 applied, just that the resulting list is in the correct order,
 556 then
 557
 558   (avl-tree-mapf function 'cons tree (not reverse))
 559
 560 is more efficient."
 561   (nreverse (avl-tree-mapf __map-function__ 'cons tree reverse)))
 562
 563
 564 (defun avl-tree-first (tree)
 565   "Return the first element in TREE, or nil if TREE is empty."
 566   (let ((node (avl-tree--root tree)))
 567     (when node
 568       (while (avl-tree--node-left node)
 569         (setq node (avl-tree--node-left node)))
 570       (avl-tree--node-data node))))
 571
 572 (defun avl-tree-last (tree)
 573   "Return the last element in TREE, or nil if TREE is empty."
 574   (let ((node (avl-tree--root tree)))
 575     (when node
 576       (while (avl-tree--node-right node)
 577         (setq node (avl-tree--node-right node)))
 578       (avl-tree--node-data node))))
 579
 580 (defun avl-tree-copy (tree)
 581   "Return a copy of the AVL tree TREE."
 582   (let ((new-tree (avl-tree-create (avl-tree--cmpfun tree))))
 583     (setf (avl-tree--root new-tree) (avl-tree--do-copy (avl-tree--root tree)))
 584     new-tree))
 585
 586 (defun avl-tree-flatten (tree)
 587   "Return a sorted list containing all elements of TREE."
 588    (let ((treelist nil))
 589      (avl-tree--mapc
 590       (lambda (node) (push (avl-tree--node-data node) treelist))
 591       (avl-tree--root tree) 1)
 592      treelist))
 593
 594 (defun avl-tree-size (tree)
 595   "Return the number of elements in TREE."
 596   (let ((treesize 0))
 597     (avl-tree--mapc
 598      (lambda (data) (setq treesize (1+ treesize)))
 599      (avl-tree--root tree) 0)
 600     treesize))
 601
 602 (defun avl-tree-clear (tree)
 603   "Clear the AVL tree TREE."
 604   (setf (avl-tree--root tree) nil))
 605
 606
 607 (defun avl-tree-stack (tree &optional reverse)
 608   "Return an object that behaves like a sorted stack
 609 of all elements of TREE.
 610
 611 If REVERSE is non-nil, the stack is sorted in reverse order.
 612 \(See also `avl-tree-stack-pop'\).
 613
 614 Note that any modification to TREE *immediately* invalidates all
 615 avl-tree-stacks created before the modification (in particular,
 616 calling `avl-tree-stack-pop' will give unpredictable results).
 617
 618 Operations on these objects are significantly more efficient than
 619 constructing a real stack with `avl-tree-flatten' and using
 620 standard stack functions.  As such, they can be useful in
 621 implementing efficient algorithms of AVL trees.  However, in cases
 622 where mapping functions `avl-tree-mapc', `avl-tree-mapcar' or
 623 `avl-tree-mapf' would be sufficient, it is better to use one of
 624 those instead."
 625   (let ((stack (avl-tree--stack-create tree reverse)))
 626     (avl-tree--stack-repopulate stack)
 627     stack))
 628
 629
 630 (defun avl-tree-stack-pop (avl-tree-stack &optional nilflag)
 631   "Pop the first element from AVL-TREE-STACK.
 632 \(See also `avl-tree-stack').
 633
 634 Returns nil if the stack is empty, or NILFLAG if specified.
 635 \(The latter allows an empty stack to be distinguished from
 636 a null element stored in the AVL tree.)"
 637   (let (node next)
 638     (if (not (setq node (pop (avl-tree--stack-store avl-tree-stack))))
 639         nilflag
 640       (when (setq next
 641                   (avl-tree--node-branch
 642                    node
 643                    (if (avl-tree--stack-reverse avl-tree-stack) 0 1)))
 644         (push next (avl-tree--stack-store avl-tree-stack))
 645         (avl-tree--stack-repopulate avl-tree-stack))
 646       (avl-tree--node-data node))))
 647
 648
 649 (defun avl-tree-stack-first (avl-tree-stack &optional nilflag)
 650   "Return the first element of AVL-TREE-STACK, without removing it
 651 from the stack.
 652
 653 Returns nil if the stack is empty, or NILFLAG if specified.
 654 \(The latter allows an empty stack to be distinguished from
 655 a null element stored in the AVL tree.)"
 656   (or (car (avl-tree--stack-store avl-tree-stack))
 657       nilflag))
 658
 659
 660 (defun avl-tree-stack-empty-p (avl-tree-stack)
 661   "Return t if AVL-TREE-STACK is empty, nil otherwise."
 662   (null (avl-tree--stack-store avl-tree-stack)))
 663
 664
 665 (provide 'avl-tree)
 666
 667 ;;; avl-tree.el ends here