summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/avl-tree.el
blob: 75c732269e28b55507677feb4c54268dc2029f41 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
;;; avl-tree.el --- balanced binary trees, AVL-trees  -*- lexical-binding:t -*-

;; Copyright (C) 1995, 2007-2021 Free Software Foundation, Inc.

;; Author: Per Cederqvist <ceder@lysator.liu.se>
;;         Inge Wallin <inge@lysator.liu.se>
;;         Thomas Bellman <bellman@lysator.liu.se>
;;         Toby Cubitt <toby-predictive@dr-qubit.org>
;; Maintainer: emacs-devel@gnu.org
;; Created: 10 May 1991
;; Keywords: extensions, data structures, AVL, tree

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; An AVL tree is a self-balancing binary tree.  As such, inserting,
;; deleting, and retrieving data from an AVL tree containing n elements
;; is O(log n).  It is somewhat more rigidly balanced than other
;; self-balancing binary trees (such as red-black trees and AA trees),
;; making insertion slightly slower, deletion somewhat slower, and
;; retrieval somewhat faster (the asymptotic scaling is of course the
;; same for all types).  Thus it may be a good choice when the tree will
;; be relatively static, i.e. data will be retrieved more often than
;; they are modified.
;;
;; Internally, a tree consists of two elements, the root node and the
;; comparison function.  The actual tree has a dummy node as its root
;; with the real root in the left pointer, which allows the root node to
;; be treated on a par with all other nodes.
;;
;; Each node of the tree consists of one data element, one left
;; sub-tree, one right sub-tree, and a balance count.  The latter is the
;; difference in depth of the left and right sub-trees.
;;
;; The functions with names of the form "avl-tree--" are intended for
;; internal use only.

;;; Code:

(eval-when-compile (require 'cl-lib))
(require 'generator)


;; ================================================================
;;; Internal functions and macros for use in the AVL tree package


;; ----------------------------------------------------------------
;; Functions and macros handling an AVL tree.

(cl-defstruct (avl-tree-
            ;; A tagged list is the pre-defstruct representation.
            ;; (:type list)
            :named
            (:constructor nil)
            (:constructor avl-tree--create (cmpfun))
            (:predicate avl-tree-p)
            (:copier nil))
  (dummyroot (avl-tree--node-create nil nil nil 0))
  cmpfun)

(defmacro avl-tree--root (tree)
  ;; Return the root node for an AVL tree.  INTERNAL USE ONLY.
  `(avl-tree--node-left (avl-tree--dummyroot ,tree)))

;; ----------------------------------------------------------------
;; Functions and macros handling an AVL tree node.

(cl-defstruct (avl-tree--node
            ;; We force a representation without tag so it matches the
            ;; pre-defstruct representation. Also we use the underlying
            ;; representation in the implementation of
            ;; avl-tree--node-branch.
            (:type vector)
            (:constructor nil)
            (:constructor avl-tree--node-create (left right data balance))
            (:copier nil))
  left right data balance)


(defalias 'avl-tree--node-branch #'aref
  ;; This implementation is efficient but breaks the defstruct
  ;; abstraction.  An alternative could be (funcall (aref [avl-tree-left
  ;; avl-tree-right avl-tree-data] branch) node)
  "Get value of a branch of a node.
NODE is the node, and BRANCH is the branch.
0 for left pointer, 1 for right pointer and 2 for the data.
\n(fn BRANCH NODE)")


;; The funcall/aref trick wouldn't work for the setf method, unless we
;; tried to access the underlying setter function, but this wouldn't be
;; portable either.
(gv-define-simple-setter avl-tree--node-branch aset)



;; ----------------------------------------------------------------
;; Convenience macros

(defmacro avl-tree--switch-dir (dir)
  "Return opposite direction to DIR (0 = left, 1 = right)."
  `(- 1 ,dir))

(defmacro avl-tree--dir-to-sign (dir)
  "Convert direction (0,1) to sign factor (-1,+1)."
  `(1- (* 2 ,dir)))

(defmacro avl-tree--sign-to-dir (dir)
  "Convert sign factor (-x,+x) to direction (0,1)."
  `(if (< ,dir 0) 0 1))


;; ----------------------------------------------------------------
;;                          Deleting data

(defun avl-tree--del-balance (node branch dir)
  "Rebalance a tree after deleting a node.
The deletion was done from the left (DIR=0) or right (DIR=1) sub-tree
of the left (BRANCH=0) or right (BRANCH=1) child of NODE.
Return t if the height of the tree has shrunk."
  ;; (or is it vice-versa for BRANCH?)
  (let ((br (avl-tree--node-branch node branch))
	;; opposite direction: 0,1 -> 1,0
	(opp (avl-tree--switch-dir dir))
	;; direction 0,1 -> sign factor -1,+1
	(sgn (avl-tree--dir-to-sign dir))
        p1 b1 p2 b2)
    (cond
     ((> (* sgn (avl-tree--node-balance br)) 0)
      (setf (avl-tree--node-balance br) 0)
      t)

     ((= (avl-tree--node-balance br) 0)
      (setf (avl-tree--node-balance br) (- sgn))
      nil)

     (t
      ;; Rebalance.
      (setq p1 (avl-tree--node-branch br opp)
            b1 (avl-tree--node-balance p1))
      (if (<= (* sgn b1) 0)
          ;; Single rotation.
          (progn
            (setf (avl-tree--node-branch br opp)
		    (avl-tree--node-branch p1 dir)
		  (avl-tree--node-branch p1 dir) br
		  (avl-tree--node-branch node branch) p1)
            (if (= 0 b1)
                (progn
                  (setf (avl-tree--node-balance br) (- sgn)
			(avl-tree--node-balance p1) sgn)
                  nil)  ; height hasn't changed
              (setf (avl-tree--node-balance br) 0)
              (setf (avl-tree--node-balance p1) 0)
              t))  ; height has changed

        ;; Double rotation.
        (setf p2 (avl-tree--node-branch p1 dir)
              b2 (avl-tree--node-balance p2)
	      (avl-tree--node-branch p1 dir)
	        (avl-tree--node-branch p2 opp)
	      (avl-tree--node-branch p2 opp) p1
	      (avl-tree--node-branch br opp)
	        (avl-tree--node-branch p2 dir)
	      (avl-tree--node-branch p2 dir) br
	      (avl-tree--node-balance br)
	        (if (< (* sgn b2) 0) sgn 0)
	      (avl-tree--node-balance p1)
	        (if (> (* sgn b2) 0) (- sgn) 0)
	      (avl-tree--node-branch node branch) p2
	      (avl-tree--node-balance p2) 0)
        t)))))

(defun avl-tree--do-del-internal (node branch q)
  (let ((br (avl-tree--node-branch node branch)))
    (if (avl-tree--node-right br)
        (if (avl-tree--do-del-internal br 1 q)
            (avl-tree--del-balance node branch 1))
      (setf (avl-tree--node-data q) (avl-tree--node-data br)
	    (avl-tree--node-branch node branch)
              (avl-tree--node-left br))
      t)))

(defun avl-tree--do-delete (cmpfun root branch data test nilflag)
  "Delete DATA from BRANCH of node ROOT.
\(See `avl-tree-delete' for TEST and NILFLAG).

Return cons cell (SHRUNK . DATA), where SHRUNK is t if the
height of the tree has shrunk and nil otherwise, and DATA is
the related data."
  (let ((br (avl-tree--node-branch root branch)))
    (cond
     ;; DATA not in tree.
     ((null br)
      (cons nil nilflag))

     ((funcall cmpfun data (avl-tree--node-data br))
      (let ((ret (avl-tree--do-delete cmpfun br 0 data test nilflag)))
	(cons (if (car ret) (avl-tree--del-balance root branch 0))
	      (cdr ret))))

     ((funcall cmpfun (avl-tree--node-data br) data)
      (let ((ret (avl-tree--do-delete cmpfun br 1 data test nilflag)))
	(cons (if (car ret) (avl-tree--del-balance root branch 1))
	      (cdr ret))))

     (t  ; Found it.
      ;; if it fails TEST, do nothing
      (if (and test (not (funcall test (avl-tree--node-data br))))
	  (cons nil nilflag)
	(cond
	 ((null (avl-tree--node-right br))
	  (setf (avl-tree--node-branch root branch)
		(avl-tree--node-left br))
	  (cons t (avl-tree--node-data br)))

	 ((null (avl-tree--node-left br))
	  (setf (avl-tree--node-branch root branch)
		(avl-tree--node-right br))
	  (cons t (avl-tree--node-data br)))

	 (t
	  (if (avl-tree--do-del-internal br 0 br)
	      (cons (avl-tree--del-balance root branch 0)
		    (avl-tree--node-data br))
	    (cons nil (avl-tree--node-data br))))
	 ))))))



;; ----------------------------------------------------------------
;;                           Entering data

(defun avl-tree--enter-balance (node branch dir)
  "Rebalance tree after an insertion
into the left (DIR=0) or right (DIR=1) sub-tree of the
left (BRANCH=0) or right (BRANCH=1) child of NODE.
Return t if the height of the tree has grown."
  (let ((br (avl-tree--node-branch node branch))
	;; opposite direction: 0,1 -> 1,0
	(opp (avl-tree--switch-dir dir))
	;; direction 0,1 -> sign factor -1,+1
	(sgn (avl-tree--dir-to-sign dir))
        p1 p2 b2)
    (cond
     ((< (* sgn (avl-tree--node-balance br)) 0)
      (setf (avl-tree--node-balance br) 0)
      nil)

     ((= (avl-tree--node-balance br) 0)
      (setf (avl-tree--node-balance br) sgn)
      t)

     (t
      ;; Tree has grown => Rebalance.
      (setq p1 (avl-tree--node-branch br dir))
      (if (> (* sgn (avl-tree--node-balance p1)) 0)
          ;; Single rotation.
          (progn
            (setf (avl-tree--node-branch br dir)
		  (avl-tree--node-branch p1 opp))
            (setf (avl-tree--node-branch p1 opp) br)
            (setf (avl-tree--node-balance br) 0)
            (setf (avl-tree--node-branch node branch) p1))

        ;; Double rotation.
        (setf p2 (avl-tree--node-branch p1 opp)
	      b2 (avl-tree--node-balance p2)
	      (avl-tree--node-branch p1 opp)
	        (avl-tree--node-branch p2 dir)
	      (avl-tree--node-branch p2 dir) p1
	      (avl-tree--node-branch br dir)
	        (avl-tree--node-branch p2 opp)
	      (avl-tree--node-branch p2 opp) br
	      (avl-tree--node-balance br)
	        (if (> (* sgn b2) 0) (- sgn) 0)
	      (avl-tree--node-balance p1)
	        (if (< (* sgn b2) 0) sgn 0)
                (avl-tree--node-branch node branch) p2))
      (setf (avl-tree--node-balance
             (avl-tree--node-branch node branch))
            0)
      nil))))

(defun avl-tree--do-enter (cmpfun root branch data &optional updatefun)
  "Enter DATA in BRANCH of ROOT node.
\(See `avl-tree-enter' for UPDATEFUN).

Return cons cell (GREW . DATA), where GREW is t if height
of tree ROOT has grown and nil otherwise, and DATA is the
inserted data."
  (let ((br (avl-tree--node-branch root branch)))
    (cond
     ((null br)
      ;; Data not in tree, insert it.
      (setf (avl-tree--node-branch root branch)
            (avl-tree--node-create nil nil data 0))
      (cons t data))

     ((funcall cmpfun data (avl-tree--node-data br))
      (let ((ret (avl-tree--do-enter cmpfun br 0 data updatefun)))
	(cons (and (car ret) (avl-tree--enter-balance root branch 0))
	      (cdr ret))))

     ((funcall cmpfun (avl-tree--node-data br) data)
      (let ((ret (avl-tree--do-enter cmpfun br 1 data updatefun)))
	(cons (and (car ret) (avl-tree--enter-balance root branch 1))
	      (cdr ret))))

     ;; Data already in tree, update it.
     (t
      (let ((newdata
	     (if updatefun
		 (funcall updatefun data (avl-tree--node-data br))
	       data)))
	(if (or (funcall cmpfun newdata data)
		(funcall cmpfun data newdata))
	    (error "avl-tree-enter:\
 updated data does not match existing data"))
	(setf (avl-tree--node-data br) newdata)
	(cons nil newdata))  ; return value
      ))))

(defun avl-tree--check (tree)
  "Check the tree's balance."
  (avl-tree--check-node (avl-tree--root tree)))
(defun avl-tree--check-node (node)
  (if (null node) 0
    (let ((dl (avl-tree--check-node (avl-tree--node-left node)))
	  (dr (avl-tree--check-node (avl-tree--node-right node))))
      (cl-assert (= (- dr dl) (avl-tree--node-balance node)))
      (1+ (max dl dr)))))

;; ----------------------------------------------------------------


;;; INTERNAL USE ONLY
(defun avl-tree--mapc (map-function root dir)
  "Apply MAP-FUNCTION to all nodes in the tree starting with ROOT.
The function is applied in-order, either ascending (DIR=0) or
descending (DIR=1).

Note: MAP-FUNCTION is applied to the node and not to the data
itself."
  (let ((node root)
        (stack nil)
        (go-dir t))
    (push nil stack)
    (while node
      (if (and go-dir
               (avl-tree--node-branch node dir))
          ;; Do the DIR subtree first.
          (progn
            (push node stack)
            (setq node (avl-tree--node-branch node dir)))
        ;; Apply the function...
        (funcall map-function node)
        ;; and do the opposite subtree.
        (setq node (if (setq go-dir (avl-tree--node-branch
				     node (avl-tree--switch-dir dir)))
                       (avl-tree--node-branch
			node (avl-tree--switch-dir dir))
                     (pop stack)))))))

;;; INTERNAL USE ONLY
(defun avl-tree--do-copy (root)
  "Copy the AVL tree with ROOT as root.  Highly recursive."
  (if (null root)
      nil
    (avl-tree--node-create
     (avl-tree--do-copy (avl-tree--node-left root))
     (avl-tree--do-copy (avl-tree--node-right root))
     (avl-tree--node-data root)
     (avl-tree--node-balance root))))

(cl-defstruct (avl-tree--stack
	    (:constructor nil)
	    (:constructor avl-tree--stack-create
			  (tree &optional reverse
				&aux
				(store
				 (if (avl-tree-empty tree)
				     nil
				   (list (avl-tree--root tree))))))
	    (:copier nil))
  reverse store)

(defalias 'avl-tree-stack-p #'avl-tree--stack-p
  "Return t if OBJ is an avl-tree-stack, nil otherwise.
\n(fn OBJ)")

(defun avl-tree--stack-repopulate (stack)
  ;; Recursively push children of the node at the head of STACK onto the
  ;; front of the STACK, until a leaf is reached.
  (let ((node (car (avl-tree--stack-store stack)))
	(dir (if (avl-tree--stack-reverse stack) 1 0)))
    (when node  ; check for empty stack
      (while (setq node (avl-tree--node-branch node dir))
	(push node (avl-tree--stack-store stack))))))


;; ================================================================
;;; The public functions which operate on AVL trees.

;; define public alias for constructors so that we can set docstring
(defalias 'avl-tree-create #'avl-tree--create
  "Create an empty AVL tree.
COMPARE-FUNCTION is a function which takes two arguments, A and B,
and returns non-nil if A is less than B, and nil otherwise.
\n(fn COMPARE-FUNCTION)")

(defalias 'avl-tree-compare-function #'avl-tree--cmpfun
  "Return the comparison function for the AVL tree TREE.
\n(fn TREE)")

(defun avl-tree-empty (tree)
  "Return t if AVL tree TREE is empty, otherwise return nil."
  (null (avl-tree--root tree)))

(defun avl-tree-enter (tree data &optional updatefun)
  "Insert DATA into the AVL tree TREE.

If an element that matches DATA (according to the tree's
comparison function, see `avl-tree-create') already exists in
TREE, it will be replaced by DATA by default.

If UPDATEFUN is supplied and an element matching DATA already
exists in TREE, UPDATEFUN is called with two arguments: DATA, and
the matching element.  Its return value replaces the existing
element.  This value *must* itself match DATA (and hence the
pre-existing data), or an error will occur.

Returns the new data."
  (cdr (avl-tree--do-enter (avl-tree--cmpfun tree)
			   (avl-tree--dummyroot tree)
			   0 data updatefun)))

(defun avl-tree-delete (tree data &optional test nilflag)
  "Delete the element matching DATA from the AVL tree TREE.
Matching uses the comparison function previously specified in
`avl-tree-create' when TREE was created.

Returns the deleted element, or nil if no matching element was
found.

Optional argument NILFLAG specifies a value to return instead of
nil if nothing was deleted, so that this case can be
distinguished from the case of a successfully deleted null
element.

If supplied, TEST specifies a test that a matching element must
pass before it is deleted.  If a matching element is found, it is
passed as an argument to TEST, and is deleted only if the return
value is non-nil."
  (cdr (avl-tree--do-delete (avl-tree--cmpfun tree)
			    (avl-tree--dummyroot tree)
			    0 data test nilflag)))


(defun avl-tree-member (tree data &optional nilflag)
  "Return the element in the AVL tree TREE which matches DATA.
Matching uses the comparison function previously specified in
`avl-tree-create' when TREE was created.

If there is no such element in the tree, nil is returned.
Optional argument NILFLAG specifies a value to return instead of nil
in this case.  This allows non-existent elements to be distinguished
from a null element.  (See also `avl-tree-member-p', which does this
for you.)"
  (let ((node (avl-tree--root tree))
	(compare-function (avl-tree--cmpfun tree)))
    (catch 'found
      (while node
	(cond
	 ((funcall compare-function data (avl-tree--node-data node))
	  (setq node (avl-tree--node-left node)))
	 ((funcall compare-function (avl-tree--node-data node) data)
	  (setq node (avl-tree--node-right node)))
	 (t (throw 'found (avl-tree--node-data node)))))
      nilflag)))


(defun avl-tree-member-p (tree data)
  "Return t if an element matching DATA exists in the AVL tree TREE.
Otherwise return nil.  Matching uses the comparison function
previously specified in `avl-tree-create' when TREE was created."
  (let ((flag '(nil)))
    (not (eq (avl-tree-member tree data flag) flag))))


(defun avl-tree-map (fun tree &optional reverse)
  "Modify all elements in the AVL tree TREE by applying FUNCTION.

Each element is replaced by the return value of FUNCTION applied
to that element.

FUNCTION is applied to the elements in ascending order, or
descending order if REVERSE is non-nil."
  (avl-tree--mapc
   (lambda (node)
     (setf (avl-tree--node-data node)
           (funcall fun (avl-tree--node-data node))))
   (avl-tree--root tree)
   (if reverse 1 0)))


(defun avl-tree-mapc (fun tree &optional reverse)
  "Apply FUNCTION to all elements in AVL tree TREE,
for side-effect only.

FUNCTION is applied to the elements in ascending order, or
descending order if REVERSE is non-nil."
  (avl-tree--mapc
   (lambda (node)
     (funcall fun (avl-tree--node-data node)))
   (avl-tree--root tree)
   (if reverse 1 0)))


(defun avl-tree-mapf
  (fun combinator tree &optional reverse)
  "Apply FUNCTION to all elements in AVL tree TREE,
and combine the results using COMBINATOR.

The FUNCTION is applied and the results are combined in ascending
order, or descending order if REVERSE is non-nil."
  (let (avl-tree-mapf--accumulate)
    (avl-tree--mapc
     (lambda (node)
       (setq avl-tree-mapf--accumulate
	     (funcall combinator
		      (funcall fun
			       (avl-tree--node-data node))
		      avl-tree-mapf--accumulate)))
     (avl-tree--root tree)
     (if reverse 0 1))
    (nreverse avl-tree-mapf--accumulate)))


(defun avl-tree-mapcar (fun tree &optional reverse)
  "Apply function FUN to all elements in AVL tree TREE,
and make a list of the results.

The function is applied and the list constructed in ascending
order, or descending order if REVERSE is non-nil.

Note that if you don't care about the order in which FUN is
applied, just that the resulting list is in the correct order,
then

  (avl-tree-mapf function \\='cons tree (not reverse))

is more efficient."
  (nreverse (avl-tree-mapf fun 'cons tree reverse)))


(defun avl-tree-first (tree)
  "Return the first element in TREE, or nil if TREE is empty."
  (let ((node (avl-tree--root tree)))
    (when node
      (while (avl-tree--node-left node)
        (setq node (avl-tree--node-left node)))
      (avl-tree--node-data node))))

(defun avl-tree-last (tree)
  "Return the last element in TREE, or nil if TREE is empty."
  (let ((node (avl-tree--root tree)))
    (when node
      (while (avl-tree--node-right node)
        (setq node (avl-tree--node-right node)))
      (avl-tree--node-data node))))

(defun avl-tree-copy (tree)
  "Return a copy of the AVL tree TREE."
  (let ((new-tree (avl-tree-create (avl-tree--cmpfun tree))))
    (setf (avl-tree--root new-tree) (avl-tree--do-copy (avl-tree--root tree)))
    new-tree))

(defun avl-tree-flatten (tree)
  "Return a sorted list containing all elements of TREE."
   (let ((treelist nil))
     (avl-tree--mapc
      (lambda (node) (push (avl-tree--node-data node) treelist))
      (avl-tree--root tree) 1)
     treelist))

(defun avl-tree-size (tree)
  "Return the number of elements in TREE."
  (let ((treesize 0))
    (avl-tree--mapc
     (lambda (_) (setq treesize (1+ treesize)))
     (avl-tree--root tree) 0)
    treesize))

(defun avl-tree-clear (tree)
  "Clear the AVL tree TREE."
  (setf (avl-tree--root tree) nil))


(defun avl-tree-stack (tree &optional reverse)
  "Return an object that behaves like a sorted stack
of all elements of TREE.

If REVERSE is non-nil, the stack is sorted in reverse order.
\(See also `avl-tree-stack-pop').

Note that any modification to TREE *immediately* invalidates all
avl-tree-stacks created before the modification (in particular,
calling `avl-tree-stack-pop' will give unpredictable results).

Operations on these objects are significantly more efficient than
constructing a real stack with `avl-tree-flatten' and using
standard stack functions.  As such, they can be useful in
implementing efficient algorithms of AVL trees.  However, in cases
where mapping functions `avl-tree-mapc', `avl-tree-mapcar' or
`avl-tree-mapf' would be sufficient, it is better to use one of
those instead."
  (let ((stack (avl-tree--stack-create tree reverse)))
    (avl-tree--stack-repopulate stack)
    stack))


(defun avl-tree-stack-pop (avl-tree-stack &optional nilflag)
  "Pop the first element from AVL-TREE-STACK.
\(See also `avl-tree-stack').

Returns nil if the stack is empty, or NILFLAG if specified.
\(The latter allows an empty stack to be distinguished from
a null element stored in the AVL tree.)"
  (let (node next)
    (if (not (setq node (pop (avl-tree--stack-store avl-tree-stack))))
	nilflag
      (when (setq next
		  (avl-tree--node-branch
		   node
		   (if (avl-tree--stack-reverse avl-tree-stack) 0 1)))
	(push next (avl-tree--stack-store avl-tree-stack))
	(avl-tree--stack-repopulate avl-tree-stack))
      (avl-tree--node-data node))))


(defun avl-tree-stack-first (avl-tree-stack &optional nilflag)
  "Return the first element of AVL-TREE-STACK, without removing it
from the stack.

Returns nil if the stack is empty, or NILFLAG if specified.
\(The latter allows an empty stack to be distinguished from
a null element stored in the AVL tree.)"
  (or (car (avl-tree--stack-store avl-tree-stack))
      nilflag))


(defun avl-tree-stack-empty-p (avl-tree-stack)
  "Return t if AVL-TREE-STACK is empty, nil otherwise."
  (null (avl-tree--stack-store avl-tree-stack)))


(iter-defun avl-tree-iter (tree &optional reverse)
  "Return an AVL tree iterator object.

Calling `iter-next' on this object will retrieve the next element
from TREE.  If REVERSE is non-nil, elements are returned in
reverse order.

Note that any modification to TREE *immediately* invalidates all
iterators created from TREE before the modification (in
particular, calling `iter-next' will give unpredictable results)."
  (let ((stack (avl-tree-stack tree reverse)))
    (while (not (avl-tree-stack-empty-p stack))
      (iter-yield (avl-tree-stack-pop stack)))))


(provide 'avl-tree)

;;; avl-tree.el ends here