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)
 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       (setf (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 (defun avl-tree--check (tree)
 343   "Check the tree's balance."
 344   (avl-tree--check-node (avl-tree--root tree)))
 345 (defun avl-tree--check-node (node)
 346   (if (null node) 0
 347     (let ((dl (avl-tree--check-node (avl-tree--node-left node)))
 348           (dr (avl-tree--check-node (avl-tree--node-right node))))
 349       (assert (= (- dr dl) (avl-tree--node-balance node)))
 350       (1+ (max dl dr)))))
 351
 352 ;; ----------------------------------------------------------------
 353
 354
 355 ;;; INTERNAL USE ONLY
 356 (defun avl-tree--mapc (map-function root dir)
 357   "Apply MAP-FUNCTION to all nodes in the tree starting with ROOT.
 358 The function is applied in-order, either ascending (DIR=0) or
 359 descending (DIR=1).
 360
 361 Note: MAP-FUNCTION is applied to the node and not to the data
 362 itself."
 363   (let ((node root)
 364         (stack nil)
 365         (go-dir t))
 366     (push nil stack)
 367     (while node
 368       (if (and go-dir
 369                (avl-tree--node-branch node dir))
 370           ;; Do the DIR subtree first.
 371           (progn
 372             (push node stack)
 373             (setq node (avl-tree--node-branch node dir)))
 374         ;; Apply the function...
 375         (funcall map-function node)
 376         ;; and do the opposite subtree.
 377         (setq node (if (setq go-dir (avl-tree--node-branch
 378                                      node (avl-tree--switch-dir dir)))
 379                        (avl-tree--node-branch
 380                         node (avl-tree--switch-dir dir))
 381                      (pop stack)))))))
 382
 383 ;;; INTERNAL USE ONLY
 384 (defun avl-tree--do-copy (root)
 385   "Copy the AVL tree with ROOT as root.  Highly recursive."
 386   (if (null root)
 387       nil
 388     (avl-tree--node-create
 389      (avl-tree--do-copy (avl-tree--node-left root))
 390      (avl-tree--do-copy (avl-tree--node-right root))
 391      (avl-tree--node-data root)
 392      (avl-tree--node-balance root))))
 393
 394 (defstruct (avl-tree--stack
 395             (:constructor nil)
 396             (:constructor avl-tree--stack-create
 397                           (tree &optional reverse
 398                                 &aux
 399                                 (store
 400                                  (if (avl-tree-empty tree)
 401                                      nil
 402                                    (list (avl-tree--root tree))))))
 403             (:copier nil))
 404   reverse store)
 405
 406 (defalias 'avl-tree-stack-p 'avl-tree--stack-p
 407   "Return t if argument is an avl-tree-stack, nil otherwise.")
 408
 409 (defun avl-tree--stack-repopulate (stack)
 410   ;; Recursively push children of the node at the head of STACK onto the
 411   ;; front of the STACK, until a leaf is reached.
 412   (let ((node (car (avl-tree--stack-store stack)))
 413         (dir (if (avl-tree--stack-reverse stack) 1 0)))
 414     (when node  ; check for empty stack
 415       (while (setq node (avl-tree--node-branch node dir))
 416         (push node (avl-tree--stack-store stack))))))
 417
 418
 419 ;; ================================================================
 420 ;;; The public functions which operate on AVL trees.
 421
 422 ;; define public alias for constructors so that we can set docstring
 423 (defalias 'avl-tree-create 'avl-tree--create
 424   "Create an empty AVL tree.
 425 COMPARE-FUNCTION is a function which takes two arguments, A and B,
 426 and returns non-nil if A is less than B, and nil otherwise.")
 427
 428 (defalias 'avl-tree-compare-function 'avl-tree--cmpfun
 429   "Return the comparison function for the AVL tree TREE.
 430
 431 \(fn TREE)")
 432
 433 (defun avl-tree-empty (tree)
 434   "Return t if AVL tree TREE is empty, otherwise return nil."
 435   (null (avl-tree--root tree)))
 436
 437 (defun avl-tree-enter (tree data &optional updatefun)
 438   "Insert DATA into the AVL tree TREE.
 439
 440 If an element that matches DATA (according to the tree's
 441 comparison function, see `avl-tree-create') already exists in
 442 TREE, it will be replaced by DATA by default.
 443
 444 If UPDATEFUN is supplied and an element matching DATA already
 445 exists in TREE, UPDATEFUN is called with two arguments: DATA, and
 446 the matching element.  Its return value replaces the existing
 447 element.  This value *must* itself match DATA (and hence the
 448 pre-existing data), or an error will occur.
 449
 450 Returns the new data."
 451   (cdr (avl-tree--do-enter (avl-tree--cmpfun tree)
 452                            (avl-tree--dummyroot tree)
 453                            0 data updatefun)))
 454
 455 (defun avl-tree-delete (tree data &optional test nilflag)
 456   "Delete the element matching DATA from the AVL tree TREE.
 457 Matching uses the comparison function previously specified in
 458 `avl-tree-create' when TREE was created.
 459
 460 Returns the deleted element, or nil if no matching element was
 461 found.
 462
 463 Optional argument NILFLAG specifies a value to return instead of
 464 nil if nothing was deleted, so that this case can be
 465 distinguished from the case of a successfully deleted null
 466 element.
 467
 468 If supplied, TEST specifies a test that a matching element must
 469 pass before it is deleted.  If a matching element is found, it is
 470 passed as an argument to TEST, and is deleted only if the return
 471 value is non-nil."
 472   (cdr (avl-tree--do-delete (avl-tree--cmpfun tree)
 473                             (avl-tree--dummyroot tree)
 474                             0 data test nilflag)))
 475
 476
 477 (defun avl-tree-member (tree data &optional nilflag)
 478   "Return the element in the AVL tree TREE which matches DATA.
 479 Matching uses the comparison function previously specified in
 480 `avl-tree-create' when TREE was created.
 481
 482 If there is no such element in the tree, nil is
 483 returned.  Optional argument NILFLAG specifies a value to return
 484 instead of nil in this case.  This allows non-existent elements to
 485 be distinguished from a null element.  (See also
 486 `avl-tree-member-p', which does this for you.)"
 487   (let ((node (avl-tree--root tree))
 488         (compare-function (avl-tree--cmpfun tree)))
 489     (catch 'found
 490       (while node
 491         (cond
 492          ((funcall compare-function data (avl-tree--node-data node))
 493           (setq node (avl-tree--node-left node)))
 494          ((funcall compare-function (avl-tree--node-data node) data)
 495           (setq node (avl-tree--node-right node)))
 496          (t (throw 'found (avl-tree--node-data node)))))
 497       nilflag)))
 498
 499
 500 (defun avl-tree-member-p (tree data)
 501   "Return t if an element matching DATA exists in the AVL tree TREE.
 502 Otherwise return nil.  Matching uses the comparison function
 503 previously specified in `avl-tree-create' when TREE was created."
 504   (let ((flag '(nil)))
 505     (not (eq (avl-tree-member tree data flag) flag))))
 506
 507
 508 (defun avl-tree-map (__map-function__ tree &optional reverse)
 509   "Modify all elements in the AVL tree TREE by applying FUNCTION.
 510
 511 Each element is replaced by the return value of FUNCTION applied
 512 to that element.
 513
 514 FUNCTION is applied to the elements in ascending order, or
 515 descending order if REVERSE is non-nil."
 516   (avl-tree--mapc
 517    (lambda (node)
 518      (setf (avl-tree--node-data node)
 519            (funcall __map-function__ (avl-tree--node-data node))))
 520    (avl-tree--root tree)
 521    (if reverse 1 0)))
 522
 523
 524 (defun avl-tree-mapc (__map-function__ tree &optional reverse)
 525   "Apply FUNCTION to all elements in AVL tree TREE,
 526 for side-effect only.
 527
 528 FUNCTION is applied to the elements in ascending order, or
 529 descending order if REVERSE is non-nil."
 530   (avl-tree--mapc
 531    (lambda (node)
 532      (funcall __map-function__ (avl-tree--node-data node)))
 533    (avl-tree--root tree)
 534    (if reverse 1 0)))
 535
 536
 537 (defun avl-tree-mapf
 538   (__map-function__ combinator tree &optional reverse)
 539   "Apply FUNCTION to all elements in AVL tree TREE,
 540 and combine the results using COMBINATOR.
 541
 542 The FUNCTION is applied and the results are combined in ascending
 543 order, or descending order if REVERSE is non-nil."
 544   (let (avl-tree-mapf--accumulate)
 545     (avl-tree--mapc
 546      (lambda (node)
 547        (setq avl-tree-mapf--accumulate
 548              (funcall combinator
 549                       (funcall __map-function__
 550                                (avl-tree--node-data node))
 551                       avl-tree-mapf--accumulate)))
 552      (avl-tree--root tree)
 553      (if reverse 0 1))
 554     (nreverse avl-tree-mapf--accumulate)))
 555
 556
 557 (defun avl-tree-mapcar (__map-function__ tree &optional reverse)
 558   "Apply FUNCTION to all elements in AVL tree TREE,
 559 and make a list of the results.
 560
 561 The FUNCTION is applied and the list constructed in ascending
 562 order, or descending order if REVERSE is non-nil.
 563
 564 Note that if you don't care about the order in which FUNCTION is
 565 applied, just that the resulting list is in the correct order,
 566 then
 567
 568   (avl-tree-mapf function 'cons tree (not reverse))
 569
 570 is more efficient."
 571   (nreverse (avl-tree-mapf __map-function__ 'cons tree reverse)))
 572
 573
 574 (defun avl-tree-first (tree)
 575   "Return the first element in TREE, or nil if TREE is empty."
 576   (let ((node (avl-tree--root tree)))
 577     (when node
 578       (while (avl-tree--node-left node)
 579         (setq node (avl-tree--node-left node)))
 580       (avl-tree--node-data node))))
 581
 582 (defun avl-tree-last (tree)
 583   "Return the last element in TREE, or nil if TREE is empty."
 584   (let ((node (avl-tree--root tree)))
 585     (when node
 586       (while (avl-tree--node-right node)
 587         (setq node (avl-tree--node-right node)))
 588       (avl-tree--node-data node))))
 589
 590 (defun avl-tree-copy (tree)
 591   "Return a copy of the AVL tree TREE."
 592   (let ((new-tree (avl-tree-create (avl-tree--cmpfun tree))))
 593     (setf (avl-tree--root new-tree) (avl-tree--do-copy (avl-tree--root tree)))
 594     new-tree))
 595
 596 (defun avl-tree-flatten (tree)
 597   "Return a sorted list containing all elements of TREE."
 598    (let ((treelist nil))
 599      (avl-tree--mapc
 600       (lambda (node) (push (avl-tree--node-data node) treelist))
 601       (avl-tree--root tree) 1)
 602      treelist))
 603
 604 (defun avl-tree-size (tree)
 605   "Return the number of elements in TREE."
 606   (let ((treesize 0))
 607     (avl-tree--mapc
 608      (lambda (data) (setq treesize (1+ treesize)))
 609      (avl-tree--root tree) 0)
 610     treesize))
 611
 612 (defun avl-tree-clear (tree)
 613   "Clear the AVL tree TREE."
 614   (setf (avl-tree--root tree) nil))
 615
 616
 617 (defun avl-tree-stack (tree &optional reverse)
 618   "Return an object that behaves like a sorted stack
 619 of all elements of TREE.
 620
 621 If REVERSE is non-nil, the stack is sorted in reverse order.
 622 \(See also `avl-tree-stack-pop'\).
 623
 624 Note that any modification to TREE *immediately* invalidates all
 625 avl-tree-stacks created before the modification (in particular,
 626 calling `avl-tree-stack-pop' will give unpredictable results).
 627
 628 Operations on these objects are significantly more efficient than
 629 constructing a real stack with `avl-tree-flatten' and using
 630 standard stack functions.  As such, they can be useful in
 631 implementing efficient algorithms of AVL trees.  However, in cases
 632 where mapping functions `avl-tree-mapc', `avl-tree-mapcar' or
 633 `avl-tree-mapf' would be sufficient, it is better to use one of
 634 those instead."
 635   (let ((stack (avl-tree--stack-create tree reverse)))
 636     (avl-tree--stack-repopulate stack)
 637     stack))
 638
 639
 640 (defun avl-tree-stack-pop (avl-tree-stack &optional nilflag)
 641   "Pop the first element from AVL-TREE-STACK.
 642 \(See also `avl-tree-stack').
 643
 644 Returns nil if the stack is empty, or NILFLAG if specified.
 645 \(The latter allows an empty stack to be distinguished from
 646 a null element stored in the AVL tree.)"
 647   (let (node next)
 648     (if (not (setq node (pop (avl-tree--stack-store avl-tree-stack))))
 649         nilflag
 650       (when (setq next
 651                   (avl-tree--node-branch
 652                    node
 653                    (if (avl-tree--stack-reverse avl-tree-stack) 0 1)))
 654         (push next (avl-tree--stack-store avl-tree-stack))
 655         (avl-tree--stack-repopulate avl-tree-stack))
 656       (avl-tree--node-data node))))
 657
 658
 659 (defun avl-tree-stack-first (avl-tree-stack &optional nilflag)
 660   "Return the first element of AVL-TREE-STACK, without removing it
 661 from the stack.
 662
 663 Returns nil if the stack is empty, or NILFLAG if specified.
 664 \(The latter allows an empty stack to be distinguished from
 665 a null element stored in the AVL tree.)"
 666   (or (car (avl-tree--stack-store avl-tree-stack))
 667       nilflag))
 668
 669
 670 (defun avl-tree-stack-empty-p (avl-tree-stack)
 671   "Return t if AVL-TREE-STACK is empty, nil otherwise."
 672   (null (avl-tree--stack-store avl-tree-stack)))
 673
 674
 675 (provide 'avl-tree)
 676
 677 ;;; avl-tree.el ends here