cgit.sxemacs.org Git - packages/blob - xemacs-packages/elib/avltree.el

   1 ;;;; $Id: avltree.el,v 1.1.1.1 1998-10-07 11:10:57 jareth Exp $
   2 ;;;; This file implements balanced binary trees, AVL-trees.
   3
   4 ;; Copyright (C) 1991-1995 Free Software Foundation
   5
   6 ;; Author: Inge Wallin <inge@lysator.liu.se>
   7 ;;      Thomas Bellman <bellman@lysator.liu.se>
   8 ;; Maintainer: elib-maintainers@lysator.liu.se
   9 ;; Created: 10 May 1991
  10 ;; Keywords: extensions, lisp
  11
  12 ;;;; This file is part of the GNU Emacs lisp library, Elib.
  13 ;;;;
  14 ;;;; GNU Elib is free software; you can redistribute it and/or modify
  15 ;;;; it under the terms of the GNU General Public License as published by
  16 ;;;; the Free Software Foundation; either version 2, or (at your option)
  17 ;;;; any later version.
  18 ;;;;
  19 ;;;; GNU Elib is distributed in the hope that it will be useful,
  20 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;;;; GNU General Public License for more details.
  23 ;;;;
  24 ;;;; You should have received a copy of the GNU General Public License
  25 ;;;; along with GNU Elib; see the file COPYING.  If not, write to
  26 ;;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  27 ;;;; Boston, MA 02111-1307, USA
  28 ;;;;
  29 ;;;; Initial author:     Thomas Bellman
  30 ;;;;                     Lysator Computer Club
  31 ;;;;                     Linkoping University
  32 ;;;;                     Sweden
  33 ;;;;
  34 ;;;; Bugfixes and completion: Inge Wallin
  35 ;;;;
  36
  37
  38 ;;; Commentary:
  39 ;;;
  40 ;;; An AVL tree is a nearly-perfect balanced binary tree.  A tree
  41 ;;; consists of two cons cells, the first one holding the tag
  42 ;;; 'AVLTREE in the car cell, and the second one having the tree
  43 ;;; in the car and the compare function in the cdr cell.  The tree has
  44 ;;; a dummy node as its root with the real tree in the left pointer.
  45 ;;;
  46 ;;; Each node of the tree consists of one data element, one left
  47 ;;; sub-tree and one right sub-tree.  Each node also has a balance
  48 ;;; count, which is the difference in depth of the left and right
  49 ;;; sub-trees.
  50 ;;;
  51
  52 ;;; Code:
  53
  54 (require 'elib-node)
  55 (require 'stack-m)
  56
  57 (provide 'avltree)
  58
  59
  60 ;;; ================================================================
  61 ;;;        Functions and macros handling an AVL tree node.
  62
  63 ;;
  64 ;; The rest of the functions needed here can be found in
  65 ;; elib-node.el.
  66 ;;
  67
  68
  69 (defmacro elib-avl-node-create (left right data balance)
  70
  71   ;; Create and return an avl-tree node.
  72   (` (vector (, left) (, right) (, data) (, balance))))
  73
  74
  75 (defmacro elib-avl-node-balance (node)
  76
  77   ;; Return the balance field of a node.
  78   (` (aref (, node) 3)))
  79
  80
  81 (defmacro elib-avl-node-set-balance (node newbal)
  82
  83   ;; Set the balance field of a node.
  84   (` (aset (, node) 3 (, newbal))))
  85
  86
  87 \f
  88 ;;; ================================================================
  89 ;;;       Internal functions for use in the AVL tree package
  90
  91 ;;;
  92 ;;; The functions and macros in this section all start with `elib-avl-'.
  93 ;;;
  94
  95
  96 (defmacro elib-avl-root (tree)
  97
  98   ;; Return the root node for an avl-tree.  INTERNAL USE ONLY.
  99   (` (elib-node-left (car (cdr (, tree))))))
 100
 101
 102 (defmacro elib-avl-dummyroot (tree)
 103
 104   ;; Return the dummy node of an avl-tree.  INTERNAL USE ONLY.
 105
 106   (` (car (cdr (, tree)))))
 107
 108
 109 (defmacro elib-avl-cmpfun (tree)
 110
 111   ;; Return the compare function of AVL tree TREE.  INTERNAL USE ONLY.
 112   (` (cdr (cdr (, tree)))))
 113
 114
 115 ;; ----------------------------------------------------------------
 116 ;;                          Deleting data
 117
 118
 119 (defun elib-avl-del-balance1 (node branch)
 120
 121   ;; Rebalance a tree and return t if the height of the tree has shrunk.
 122   (let* ((br (elib-node-branch node branch))
 123          p1
 124          b1
 125          p2
 126          b2
 127          result)
 128     (cond
 129      ((< (elib-avl-node-balance br) 0)
 130       (elib-avl-node-set-balance br 0)
 131       t)
 132
 133      ((= (elib-avl-node-balance br) 0)
 134       (elib-avl-node-set-balance br +1)
 135       nil)
 136
 137      (t                                 ; Rebalance
 138       (setq p1 (elib-node-right br)
 139             b1 (elib-avl-node-balance p1))
 140       (if (>= b1 0)
 141           ;; Single RR rotation
 142           (progn
 143             (elib-node-set-right br (elib-node-left p1))
 144             (elib-node-set-left p1 br)
 145             (if (= 0 b1)
 146                 (progn
 147                   (elib-avl-node-set-balance br +1)
 148                   (elib-avl-node-set-balance p1 -1)
 149                   (setq result nil))
 150               (elib-avl-node-set-balance br 0)
 151               (elib-avl-node-set-balance p1 0)
 152               (setq result t))
 153             (elib-node-set-branch node branch p1)
 154             result)
 155
 156         ;; Double RL rotation
 157         (setq p2 (elib-node-left p1)
 158               b2 (elib-avl-node-balance p2))
 159         (elib-node-set-left p1 (elib-node-right p2))
 160         (elib-node-set-right p2 p1)
 161         (elib-node-set-right br (elib-node-left p2))
 162         (elib-node-set-left p2 br)
 163         (if (> b2 0)
 164             (elib-avl-node-set-balance br -1)
 165           (elib-avl-node-set-balance br 0))
 166         (if (< b2 0)
 167             (elib-avl-node-set-balance p1 +1)
 168           (elib-avl-node-set-balance p1 0))
 169         (elib-node-set-branch node branch p2)
 170         (elib-avl-node-set-balance p2 0)
 171         t)
 172       ))
 173     ))
 174
 175
 176 (defun elib-avl-del-balance2 (node branch)
 177
 178   (let* ((br (elib-node-branch node branch))
 179          p1
 180          b1
 181          p2
 182          b2
 183          result)
 184     (cond
 185      ((> (elib-avl-node-balance br) 0)
 186       (elib-avl-node-set-balance br 0)
 187       t)
 188
 189      ((= (elib-avl-node-balance br) 0)
 190       (elib-avl-node-set-balance br -1)
 191       nil)
 192
 193      (t                                 ; Rebalance
 194       (setq p1 (elib-node-left br)
 195             b1 (elib-avl-node-balance p1))
 196       (if (<= b1 0)
 197           ;; Single LL rotation
 198           (progn
 199             (elib-node-set-left br (elib-node-right p1))
 200             (elib-node-set-right p1 br)
 201             (if (= 0 b1)
 202                 (progn
 203                   (elib-avl-node-set-balance br -1)
 204                   (elib-avl-node-set-balance p1 +1)
 205                   (setq result nil))
 206               (elib-avl-node-set-balance br 0)
 207               (elib-avl-node-set-balance p1 0)
 208               (setq result t))
 209             (elib-node-set-branch node branch p1)
 210             result)
 211
 212         ;; Double LR rotation
 213         (setq p2 (elib-node-right p1)
 214               b2 (elib-avl-node-balance p2))
 215         (elib-node-set-right p1 (elib-node-left p2))
 216         (elib-node-set-left p2 p1)
 217         (elib-node-set-left br (elib-node-right p2))
 218         (elib-node-set-right p2 br)
 219         (if (< b2 0)
 220             (elib-avl-node-set-balance br +1)
 221           (elib-avl-node-set-balance br 0))
 222         (if (> b2 0)
 223             (elib-avl-node-set-balance p1 -1)
 224           (elib-avl-node-set-balance p1 0))
 225         (elib-node-set-branch node branch p2)
 226         (elib-avl-node-set-balance p2 0)
 227         t)
 228       ))
 229     ))
 230
 231
 232 (defun elib-avl-do-del-internal (node branch q)
 233
 234   (let* ((br (elib-node-branch node branch)))
 235       (if (elib-node-right br)
 236           (if (elib-avl-do-del-internal br +1 q)
 237               (elib-avl-del-balance2 node branch))
 238         (elib-node-set-data q (elib-node-data br))
 239         (elib-node-set-branch node branch
 240                               (elib-node-left br))
 241         t)))
 242
 243
 244
 245 (defun elib-avl-do-delete (cmpfun root branch data)
 246
 247   ;; Return t if the height of the tree has shrunk.
 248   (let* ((br (elib-node-branch root branch)))
 249     (cond
 250      ((null br)
 251       nil)
 252
 253      ((funcall cmpfun data (elib-node-data br))
 254       (if (elib-avl-do-delete cmpfun br 0 data)
 255           (elib-avl-del-balance1 root branch)))
 256
 257      ((funcall cmpfun (elib-node-data br) data)
 258       (if (elib-avl-do-delete cmpfun br 1 data)
 259           (elib-avl-del-balance2 root branch)))
 260
 261      (t
 262       ;; Found it.  Let's delete it.
 263       (cond
 264        ((null (elib-node-right br))
 265         (elib-node-set-branch root branch (elib-node-left br))
 266         t)
 267
 268        ((null (elib-node-left br))
 269         (elib-node-set-branch root branch (elib-node-right br))
 270         t)
 271
 272        (t
 273         (if (elib-avl-do-del-internal br 0 br)
 274             (elib-avl-del-balance1 root branch)))))
 275      )))
 276
 277
 278 ;; ----------------------------------------------------------------
 279 ;;                           Entering data
 280
 281
 282
 283 (defun elib-avl-enter-balance1 (node branch)
 284
 285   ;; Rebalance a tree and return t if the height of the tree has grown.
 286   (let* ((br (elib-node-branch node branch))
 287          p1
 288          p2
 289          b2
 290          result)
 291     (cond
 292      ((< (elib-avl-node-balance br) 0)
 293       (elib-avl-node-set-balance br 0)
 294       nil)
 295
 296      ((= (elib-avl-node-balance br) 0)
 297       (elib-avl-node-set-balance br +1)
 298       t)
 299
 300      (t
 301       ;; Tree has grown => Rebalance
 302       (setq p1 (elib-node-right br))
 303       (if (> (elib-avl-node-balance p1) 0)
 304           ;; Single RR rotation
 305           (progn
 306             (elib-node-set-right br (elib-node-left p1))
 307             (elib-node-set-left p1 br)
 308             (elib-avl-node-set-balance br 0)
 309             (elib-node-set-branch node branch p1))
 310
 311         ;; Double RL rotation
 312         (setq p2 (elib-node-left p1)
 313               b2 (elib-avl-node-balance p2))
 314         (elib-node-set-left p1 (elib-node-right p2))
 315         (elib-node-set-right p2 p1)
 316         (elib-node-set-right br (elib-node-left p2))
 317         (elib-node-set-left p2 br)
 318         (if (> b2 0)
 319             (elib-avl-node-set-balance br -1)
 320           (elib-avl-node-set-balance br 0))
 321         (if (< b2 0)
 322             (elib-avl-node-set-balance p1 +1)
 323           (elib-avl-node-set-balance p1 0))
 324         (elib-node-set-branch node branch p2))
 325       (elib-avl-node-set-balance (elib-node-branch node branch) 0)
 326       nil))
 327     ))
 328
 329
 330 (defun elib-avl-enter-balance2 (node branch)
 331
 332   ;; Return t if the tree has grown.
 333   (let* ((br (elib-node-branch node branch))
 334          p1
 335          p2
 336          b2)
 337     (cond
 338      ((> (elib-avl-node-balance br) 0)
 339       (elib-avl-node-set-balance br 0)
 340       nil)
 341
 342      ((= (elib-avl-node-balance br) 0)
 343       (elib-avl-node-set-balance br -1)
 344       t)
 345
 346      (t
 347       ;; Balance was -1 => Rebalance
 348       (setq p1 (elib-node-left br))
 349       (if (< (elib-avl-node-balance p1) 0)
 350           ;; Single LL rotation
 351           (progn
 352             (elib-node-set-left br (elib-node-right p1))
 353             (elib-node-set-right p1 br)
 354             (elib-avl-node-set-balance br 0)
 355             (elib-node-set-branch node branch p1))
 356
 357         ;; Double LR rotation
 358         (setq p2 (elib-node-right p1)
 359               b2 (elib-avl-node-balance p2))
 360         (elib-node-set-right p1 (elib-node-left p2))
 361         (elib-node-set-left p2 p1)
 362         (elib-node-set-left br (elib-node-right p2))
 363         (elib-node-set-right p2 br)
 364         (if (< b2 0)
 365             (elib-avl-node-set-balance br +1)
 366           (elib-avl-node-set-balance br 0))
 367         (if (> b2 0)
 368             (elib-avl-node-set-balance p1 -1)
 369           (elib-avl-node-set-balance p1 0))
 370         (elib-node-set-branch node branch p2))
 371       (elib-avl-node-set-balance (elib-node-branch node branch) 0)
 372       nil))
 373     ))
 374
 375
 376 (defun elib-avl-do-enter (cmpfun root branch data)
 377
 378   ;; Return t if height of tree ROOT has grown.  INTERNAL USE ONLY.
 379   (let ((br (elib-node-branch root branch)))
 380     (cond
 381      ((null br)
 382       ;; Data not in tree, insert it
 383       (elib-node-set-branch root branch
 384                             (elib-avl-node-create nil nil data 0))
 385       t)
 386
 387      ((funcall cmpfun data (elib-node-data br))
 388       (and (elib-avl-do-enter cmpfun
 389                               br
 390                               0 data)
 391            (elib-avl-enter-balance2 root branch)))
 392
 393      ((funcall cmpfun (elib-node-data br) data)
 394       (and (elib-avl-do-enter cmpfun
 395                               br
 396                               1 data)
 397            (elib-avl-enter-balance1 root branch)))
 398
 399      (t
 400       (elib-node-set-data br data)
 401       nil))))
 402
 403
 404 ;; ----------------------------------------------------------------
 405
 406
 407 (defun elib-avl-mapc (map-function root)
 408   ;; Apply MAP-FUNCTION to all nodes in the tree starting with ROOT.
 409   ;; The function is applied in-order.
 410   ;;
 411   ;; Note: MAP-FUNCTION is applied to the node and not to the data itself.
 412   ;; INTERNAL USE ONLY.
 413
 414   (let ((node root)
 415         (stack (elib-stack-create))
 416         (go-left t))
 417     (elib-stack-push stack nil)
 418     (while node
 419       (if (and go-left
 420                (elib-node-left node))
 421           (progn                                   ; Do the left subtree first.
 422             (elib-stack-push stack node)
 423             (setq node (elib-node-left node)))
 424         (funcall map-function node)                ; Apply the function...
 425         (if (elib-node-right node)                 ; and do the right subtree.
 426             (setq node (elib-node-right node)
 427                   go-left t)
 428           (setq node (elib-stack-pop stack)
 429                 go-left nil))))))
 430
 431
 432 (defun elib-avl-do-copy (root)
 433   ;; Copy the tree with ROOT as root.
 434   ;; Highly recursive. INTERNAL USE ONLY.
 435   (if (null root)
 436       nil
 437     (elib-avl-node-create (elib-avl-do-copy (elib-node-left root))
 438                           (elib-avl-do-copy (elib-node-right root))
 439                           (elib-node-data root)
 440                           (elib-avl-node-balance root))))
 441
 442
 443 \f
 444 ;;; ================================================================
 445 ;;;       The public functions which operate on AVL trees.
 446
 447
 448 (defun avltree-create (compare-function)
 449   "Create an empty avl tree.
 450 COMPARE-FUNCTION is a function which takes two arguments, A and B,
 451 and returns non-nil if A is less than B, and nil otherwise."
 452   (cons 'AVLTREE
 453         (cons (elib-avl-node-create nil nil nil 0)
 454               compare-function)))
 455
 456
 457 (defun avltree-p (obj)
 458   "Return t if OBJ is an avl tree, nil otherwise."
 459   (eq (car-safe obj) 'AVLTREE))
 460
 461
 462 (defun avltree-compare-function (tree)
 463   "Return the comparision function for the avl tree TREE."
 464   (elib-avl-cmpfun tree))
 465
 466
 467 (defun avltree-empty (tree)
 468   "Return t if TREE is emtpy, otherwise return nil."
 469   (null (elib-avl-root tree)))
 470
 471
 472 (defun avltree-enter (tree data)
 473   "In the avl tree TREE insert DATA.
 474 Return DATA."
 475
 476   (elib-avl-do-enter (elib-avl-cmpfun tree)
 477                      (elib-avl-dummyroot tree)
 478                      0
 479                      data)
 480   data)
 481
 482
 483 (defun avltree-delete (tree data)
 484   "From the avl tree TREE, delete DATA.
 485 Return the element in TREE which matched DATA, nil if no element matched."
 486
 487   (elib-avl-do-delete (elib-avl-cmpfun tree)
 488                       (elib-avl-dummyroot tree)
 489                       0
 490                       data))
 491
 492
 493 (defun avltree-member (tree data)
 494   "Return the element in the avl tree TREE which matches DATA.
 495 Matching uses the compare function previously specified in `avltree-create'
 496 when TREE was created.
 497
 498 If there is no such element in the tree, the value is nil."
 499
 500   (let ((node (elib-avl-root tree))
 501         (compare-function (elib-avl-cmpfun tree))
 502         found)
 503     (while (and node
 504                 (not found))
 505       (cond
 506        ((funcall compare-function data (elib-node-data node))
 507         (setq node (elib-node-left node)))
 508        ((funcall compare-function (elib-node-data node) data)
 509         (setq node (elib-node-right node)))
 510        (t
 511         (setq found t))))
 512
 513     (if node
 514         (elib-node-data node)
 515       nil)))
 516
 517
 518
 519 (defun avltree-map (__map-function__ tree)
 520   "Apply MAP-FUNCTION to all elements in the avl tree TREE."
 521   (elib-avl-mapc
 522    (function (lambda (node)
 523                (elib-node-set-data node
 524                                    (funcall __map-function__
 525                                             (elib-node-data node)))))
 526    (elib-avl-root tree)))
 527
 528
 529
 530 (defun avltree-first (tree)
 531   "Return the first element in TREE, or nil if TREE is empty."
 532
 533   (let ((node (elib-avl-root tree)))
 534     (if node
 535         (progn
 536           (while (elib-node-left node)
 537             (setq node (elib-node-left node)))
 538           (elib-node-data node))
 539       nil)))
 540
 541
 542 (defun avltree-last (tree)
 543   "Return the last element in TREE, or nil if TREE is empty."
 544   (let ((node (elib-avl-root tree)))
 545     (if node
 546         (progn
 547           (while (elib-node-right node)
 548             (setq node (elib-node-right node)))
 549           (elib-node-data node))
 550       nil)))
 551
 552
 553 (defun avltree-copy (tree)
 554   "Return a copy of the avl tree TREE."
 555   (let ((new-tree (avltree-create
 556                    (elib-avl-cmpfun tree))))
 557     (elib-node-set-left (elib-avl-dummyroot new-tree)
 558                         (elib-avl-do-copy (elib-avl-root tree)))
 559     new-tree))
 560
 561
 562 (defun avltree-flatten (tree)
 563   "Return a sorted list containing all elements of TREE."
 564   (nreverse
 565    (let ((treelist nil))
 566      (elib-avl-mapc (function (lambda (node)
 567                                 (setq treelist (cons (elib-node-data node)
 568                                                      treelist))))
 569                     (elib-avl-root tree))
 570      treelist)))
 571
 572
 573 (defun avltree-size (tree)
 574   "Return the number of elements in TREE."
 575   (let ((treesize 0))
 576     (elib-avl-mapc (function (lambda (data)
 577                                (setq treesize (1+ treesize))
 578                                data))
 579                    (elib-avl-root tree))
 580     treesize))
 581
 582
 583 (defun avltree-clear (tree)
 584   "Clear the avl tree TREE."
 585   (elib-node-set-left (elib-avl-dummyroot tree) nil))
 586
 587 ;;; avltree.el ends here