lisp/emacs-lisp/avl-tree.el

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