emacs/lisp/emacs-lisp/avl-tree.el

;;;; $Id: elib-node.el,v 0.8 1995/12/11 00:11:19 ceder Exp $
;;;; Nodes used in binary trees and doubly linked lists.

;; Copyright (C) 1991-1995 Free Software Foundation

;; Author: Per Cederqvist <ceder@lysator.liu.se>
;;	Inge Wallin <inge@lysator.liu.se>
;; Maintainer: elib-maintainers@lysator.liu.se
;; Created: 20 May 1991
;; Keywords: extensions, lisp

;;;; This file is part of the GNU Emacs lisp library, Elib.
;;;;
;;;; GNU Elib 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 2, or (at your option)
;;;; any later version.
;;;;
;;;; GNU Elib 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 Elib; see the file COPYING.  If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;;; Boston, MA 02111-1307, USA
;;;;
;;;; Author: Inge Wallin
;;;;

;;; Commentary:

;;; A node is implemented as an array with three elements, using
;;; (elt node 0) as the left pointer
;;; (elt node 1) as the right pointer
;;; (elt node 2) as the data
;;;
;;; Some types of trees, e.g. AVL trees, need bigger nodes, but
;;; as long as the first three parts are the left pointer, the
;;; right pointer and the data field, these macros can be used.
;;;

;;; Code:

;;; Begin HACKS to make avl-tree.el standalone.
;;;
;;; 0/ Don't do this.
;;; (provide 'elib-node)
;;;
;;; End HACKS to make avl-tree.el standalone.


(defmacro elib-node-create (left right data)

  ;; Create a tree node from LEFT, RIGHT and DATA.
  (` (vector (, left) (, right) (, data))))


(defmacro elib-node-left (node)

  ;; Return the left pointer of NODE.
  (` (aref (, node) 0)))


(defmacro elib-node-right (node)

  ;; Return the right pointer of NODE.
  (` (aref (, node) 1)))


(defmacro elib-node-data (node)

  ;; Return the data of NODE.
  (` (aref (, node) 2)))


(defmacro elib-node-set-left (node newleft)

  ;; Set the left pointer of NODE to NEWLEFT.
  (` (aset (, node) 0 (, newleft))))


(defmacro elib-node-set-right (node newright)

  ;; Set the right pointer of NODE to NEWRIGHT.
  (` (aset (, node) 1 (, newright))))


(defmacro elib-node-set-data (node newdata)
  ;; Set the data of NODE to NEWDATA.
  (` (aset (, node) 2 (, newdata))))



(defmacro elib-node-branch (node branch)

  ;; 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."
  (` (aref (, node) (, branch))))


(defmacro elib-node-set-branch (node branch newval)

  ;; Set value of a branch of a node.
  ;;
  ;; NODE is the node, and BRANCH is the branch.
  ;; 0 for left pointer, 1 for the right pointer and 2 for the data.
  ;; NEWVAL is new value of the branch."
  (` (aset (, node) (, branch) (, newval))))

;;; elib-node.el ends here.
;;;; $Id: avltree.el,v 0.8 1995/12/11 00:10:54 ceder Exp $
;;;; This file implements balanced binary trees, AVL-trees.

;; Copyright (C) 1991-1995 Free Software Foundation

;; Author: Inge Wallin <inge@lysator.liu.se>
;;	Thomas Bellman <bellman@lysator.liu.se>
;; Maintainer: elib-maintainers@lysator.liu.se
;; Created: 10 May 1991
;; Keywords: extensions, lisp

;;;; This file is part of the GNU Emacs lisp library, Elib.
;;;;
;;;; GNU Elib 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 2, or (at your option)
;;;; any later version.
;;;;
;;;; GNU Elib 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 Elib; see the file COPYING.  If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;;; Boston, MA 02111-1307, USA
;;;;
;;;; Initial author:	 Thomas Bellman
;;;;			 Lysator Computer Club
;;;;		 	 Linkoping University
;;;;		 	 Sweden
;;;;
;;;; Bugfixes and completion: Inge Wallin
;;;;


;;; Commentary:
;;;
;;; An AVL tree is a nearly-perfect balanced binary tree.  A tree
;;; consists of two cons cells, the first one holding the tag
;;; 'AVLTREE in the car cell, and the second one having the tree
;;; in the car and the compare function in the cdr cell.  The tree has
;;; a dummy node as its root with the real tree in the left pointer.
;;;
;;; Each node of the tree consists of one data element, one left
;;; sub-tree and one right sub-tree.  Each node also has a balance
;;; count, which is the difference in depth of the left and right
;;; sub-trees.
;;;

;;; Code:

;;; Begin HACKS to make avl-tree.el standalone.
;;;
;;; 1/ See above for inlined elib-node.el.
;;; (require 'elib-node)
;;;
;;; 2/ This requirement has been replaced w/ new code.
;;; (require 'stack-m)
;;;
;;; 3/ New code:
(eval-when-compile (require 'cl))
(defun elib-stack-create () (list))
(defmacro elib-stack-push (stack object) `(push ,object ,stack))
(defmacro elib-stack-pop (stack) `(pop ,stack))
;;;
;;; 4/ Provide `avl-tree' instead of `avltree'.
(provide 'avl-tree)
;;;
;;; End HACKS to make avl-tree.el standalone.


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

;;
;; The rest of the functions needed here can be found in
;; elib-node.el.
;;


(defmacro elib-avl-node-create (left right data balance)

  ;; Create and return an avl-tree node.
  (` (vector (, left) (, right) (, data) (, balance))))


(defmacro elib-avl-node-balance (node)

  ;; Return the balance field of a node.
  (` (aref (, node) 3)))


(defmacro elib-avl-node-set-balance (node newbal)

  ;; Set the balance field of a node.
  (` (aset (, node) 3 (, newbal))))


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

;;;
;;; The functions and macros in this section all start with `elib-avl-'.
;;;


(defmacro elib-avl-root (tree)

  ;; Return the root node for an avl-tree.  INTERNAL USE ONLY.
  (` (elib-node-left (car (cdr (, tree))))))


(defmacro elib-avl-dummyroot (tree)

  ;; Return the dummy node of an avl-tree.  INTERNAL USE ONLY.

  (` (car (cdr (, tree)))))


(defmacro elib-avl-cmpfun (tree)

  ;; Return the compare function of AVL tree TREE.  INTERNAL USE ONLY.
  (` (cdr (cdr (, tree)))))


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


(defun elib-avl-del-balance1 (node branch)

  ;; Rebalance a tree and return t if the height of the tree has shrunk.
  (let* ((br (elib-node-branch node branch))
	 p1
	 b1
	 p2
	 b2
	 result)
    (cond
     ((< (elib-avl-node-balance br) 0)
      (elib-avl-node-set-balance br 0)
      t)

     ((= (elib-avl-node-balance br) 0)
      (elib-avl-node-set-balance br +1)
      nil)

     (t					; Rebalance
      (setq p1 (elib-node-right br)
	    b1 (elib-avl-node-balance p1))
      (if (>= b1 0)
	  ;; Single RR rotation
	  (progn
	    (elib-node-set-right br (elib-node-left p1))
	    (elib-node-set-left p1 br)
	    (if (= 0 b1)
		(progn
		  (elib-avl-node-set-balance br +1)
		  (elib-avl-node-set-balance p1 -1)
		  (setq result nil))
	      (elib-avl-node-set-balance br 0)
	      (elib-avl-node-set-balance p1 0)
	      (setq result t))
	    (elib-node-set-branch node branch p1)
	    result)

	;; Double RL rotation
	(setq p2 (elib-node-left p1)
	      b2 (elib-avl-node-balance p2))
	(elib-node-set-left p1 (elib-node-right p2))
	(elib-node-set-right p2 p1)
	(elib-node-set-right br (elib-node-left p2))
	(elib-node-set-left p2 br)
	(if (> b2 0)
	    (elib-avl-node-set-balance br -1)
	  (elib-avl-node-set-balance br 0))
	(if (< b2 0)
	    (elib-avl-node-set-balance p1 +1)
	  (elib-avl-node-set-balance p1 0))
	(elib-node-set-branch node branch p2)
	(elib-avl-node-set-balance p2 0)
	t)
      ))
    ))


(defun elib-avl-del-balance2 (node branch)

  (let* ((br (elib-node-branch node branch))
	 p1
	 b1
	 p2
	 b2
	 result)
    (cond
     ((> (elib-avl-node-balance br) 0)
      (elib-avl-node-set-balance br 0)
      t)

     ((= (elib-avl-node-balance br) 0)
      (elib-avl-node-set-balance br -1)
      nil)

     (t					; Rebalance
      (setq p1 (elib-node-left br)
	    b1 (elib-avl-node-balance p1))
      (if (<= b1 0)
	  ;; Single LL rotation
	  (progn
	    (elib-node-set-left br (elib-node-right p1))
	    (elib-node-set-right p1 br)
	    (if (= 0 b1)
		(progn
		  (elib-avl-node-set-balance br -1)
		  (elib-avl-node-set-balance p1 +1)
		  (setq result nil))
	      (elib-avl-node-set-balance br 0)
	      (elib-avl-node-set-balance p1 0)
	      (setq result t))
	    (elib-node-set-branch node branch p1)
	    result)

	;; Double LR rotation
	(setq p2 (elib-node-right p1)
	      b2 (elib-avl-node-balance p2))
	(elib-node-set-right p1 (elib-node-left p2))
	(elib-node-set-left p2 p1)
	(elib-node-set-left br (elib-node-right p2))
	(elib-node-set-right p2 br)
	(if (< b2 0)
	    (elib-avl-node-set-balance br +1)
	  (elib-avl-node-set-balance br 0))
	(if (> b2 0)
	    (elib-avl-node-set-balance p1 -1)
	  (elib-avl-node-set-balance p1 0))
	(elib-node-set-branch node branch p2)
	(elib-avl-node-set-balance p2 0)
	t)
      ))
    ))


(defun elib-avl-do-del-internal (node branch q)

  (let* ((br (elib-node-branch node branch)))
      (if (elib-node-right br)
	  (if (elib-avl-do-del-internal br +1 q)
	      (elib-avl-del-balance2 node branch))
	(elib-node-set-data q (elib-node-data br))
	(elib-node-set-branch node branch
			      (elib-node-left br))
	t)))



(defun elib-avl-do-delete (cmpfun root branch data)

  ;; Return t if the height of the tree has shrunk.
  (let* ((br (elib-node-branch root branch)))
    (cond
     ((null br)
      nil)

     ((funcall cmpfun data (elib-node-data br))
      (if (elib-avl-do-delete cmpfun br 0 data)
	  (elib-avl-del-balance1 root branch)))

     ((funcall cmpfun (elib-node-data br) data)
      (if (elib-avl-do-delete cmpfun br 1 data)
	  (elib-avl-del-balance2 root branch)))

     (t
      ;; Found it.  Let's delete it.
      (cond
       ((null (elib-node-right br))
	(elib-node-set-branch root branch (elib-node-left br))
	t)

       ((null (elib-node-left br))
	(elib-node-set-branch root branch (elib-node-right br))
	t)

       (t
	(if (elib-avl-do-del-internal br 0 br)
	    (elib-avl-del-balance1 root branch)))))
     )))


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



(defun elib-avl-enter-balance1 (node branch)

  ;; Rebalance a tree and return t if the height of the tree has grown.
  (let* ((br (elib-node-branch node branch))
	 p1
	 p2
	 b2
	 result)
    (cond
     ((< (elib-avl-node-balance br) 0)
      (elib-avl-node-set-balance br 0)
      nil)

     ((= (elib-avl-node-balance br) 0)
      (elib-avl-node-set-balance br +1)
      t)

     (t
      ;; Tree has grown => Rebalance
      (setq p1 (elib-node-right br))
      (if (> (elib-avl-node-balance p1) 0)
	  ;; Single RR rotation
	  (progn
	    (elib-node-set-right br (elib-node-left p1))
	    (elib-node-set-left p1 br)
	    (elib-avl-node-set-balance br 0)
	    (elib-node-set-branch node branch p1))

	;; Double RL rotation
	(setq p2 (elib-node-left p1)
	      b2 (elib-avl-node-balance p2))
	(elib-node-set-left p1 (elib-node-right p2))
	(elib-node-set-right p2 p1)
	(elib-node-set-right br (elib-node-left p2))
	(elib-node-set-left p2 br)
	(if (> b2 0)
	    (elib-avl-node-set-balance br -1)
	  (elib-avl-node-set-balance br 0))
	(if (< b2 0)
	    (elib-avl-node-set-balance p1 +1)
	  (elib-avl-node-set-balance p1 0))
	(elib-node-set-branch node branch p2))
      (elib-avl-node-set-balance (elib-node-branch node branch) 0)
      nil))
    ))


(defun elib-avl-enter-balance2 (node branch)

  ;; Return t if the tree has grown.
  (let* ((br (elib-node-branch node branch))
	 p1
	 p2
	 b2)
    (cond
     ((> (elib-avl-node-balance br) 0)
      (elib-avl-node-set-balance br 0)
      nil)

     ((= (elib-avl-node-balance br) 0)
      (elib-avl-node-set-balance br -1)
      t)

     (t
      ;; Balance was -1 => Rebalance
      (setq p1 (elib-node-left br))
      (if (< (elib-avl-node-balance p1) 0)
	  ;; Single LL rotation
	  (progn
	    (elib-node-set-left br (elib-node-right p1))
	    (elib-node-set-right p1 br)
	    (elib-avl-node-set-balance br 0)
	    (elib-node-set-branch node branch p1))

	;; Double LR rotation
	(setq p2 (elib-node-right p1)
	      b2 (elib-avl-node-balance p2))
	(elib-node-set-right p1 (elib-node-left p2))
	(elib-node-set-left p2 p1)
	(elib-node-set-left br (elib-node-right p2))
	(elib-node-set-right p2 br)
	(if (< b2 0)
	    (elib-avl-node-set-balance br +1)
	  (elib-avl-node-set-balance br 0))
	(if (> b2 0)
	    (elib-avl-node-set-balance p1 -1)
	  (elib-avl-node-set-balance p1 0))
	(elib-node-set-branch node branch p2))
      (elib-avl-node-set-balance (elib-node-branch node branch) 0)
      nil))
    ))


(defun elib-avl-do-enter (cmpfun root branch data)

  ;; Return t if height of tree ROOT has grown.  INTERNAL USE ONLY.
  (let ((br (elib-node-branch root branch)))
    (cond
     ((null br)
      ;; Data not in tree, insert it
      (elib-node-set-branch root branch
			    (elib-avl-node-create nil nil data 0))
      t)

     ((funcall cmpfun data (elib-node-data br))
      (and (elib-avl-do-enter cmpfun
			      br
			      0 data)
	   (elib-avl-enter-balance2 root branch)))

     ((funcall cmpfun (elib-node-data br) data)
      (and (elib-avl-do-enter cmpfun
			      br
			      1 data)
	   (elib-avl-enter-balance1 root branch)))

     (t
      (elib-node-set-data br data)
      nil))))


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


(defun elib-avl-mapc (map-function root)
  ;; Apply MAP-FUNCTION to all nodes in the tree starting with ROOT.
  ;; The function is applied in-order.
  ;;
  ;; Note: MAP-FUNCTION is applied to the node and not to the data itself.
  ;; INTERNAL USE ONLY.

  (let ((node root)
	(stack (elib-stack-create))
	(go-left t))
    (elib-stack-push stack nil)
    (while node
      (if (and go-left
	       (elib-node-left node))
	  (progn				   ; Do the left subtree first.
	    (elib-stack-push stack node)
	    (setq node (elib-node-left node)))
	(funcall map-function node)		   ; Apply the function...
	(if (elib-node-right node)		   ; and do the right subtree.
	    (setq node (elib-node-right node)
		  go-left t)
	  (setq node (elib-stack-pop stack)
		go-left nil))))))


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


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


(defun avltree-create (compare-function)
  "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."
  (cons 'AVLTREE
	(cons (elib-avl-node-create nil nil nil 0)
	      compare-function)))


(defun avltree-p (obj)
  "Return t if OBJ is an avl tree, nil otherwise."
  (eq (car-safe obj) 'AVLTREE))


(defun avltree-compare-function (tree)
  "Return the comparision function for the avl tree TREE."
  (elib-avl-cmpfun tree))


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


(defun avltree-enter (tree data)
  "In the avl tree TREE insert DATA.
Return DATA."

  (elib-avl-do-enter (elib-avl-cmpfun tree)
		     (elib-avl-dummyroot tree)
		     0
		     data)
  data)


(defun avltree-delete (tree data)
  "From the avl tree TREE, delete DATA.
Return the element in TREE which matched DATA, nil if no element matched."

  (elib-avl-do-delete (elib-avl-cmpfun tree)
		      (elib-avl-dummyroot tree)
		      0
		      data))


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

If there is no such element in the tree, the value is nil."

  (let ((node (elib-avl-root tree))
	(compare-function (elib-avl-cmpfun tree))
	found)
    (while (and node
		(not found))
      (cond
       ((funcall compare-function data (elib-node-data node))
	(setq node (elib-node-left node)))
       ((funcall compare-function (elib-node-data node) data)
	(setq node (elib-node-right node)))
       (t
	(setq found t))))

    (if node
	(elib-node-data node)
      nil)))



(defun avltree-map (__map-function__ tree)
  "Apply MAP-FUNCTION to all elements in the avl tree TREE."
  (elib-avl-mapc
   (function (lambda (node)
	       (elib-node-set-data node
				   (funcall __map-function__
					    (elib-node-data node)))))
   (elib-avl-root tree)))



(defun avltree-first (tree)
  "Return the first element in TREE, or nil if TREE is empty."

  (let ((node (elib-avl-root tree)))
    (if node
	(progn
	  (while (elib-node-left node)
	    (setq node (elib-node-left node)))
	  (elib-node-data node))
      nil)))


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


(defun avltree-copy (tree)
  "Return a copy of the avl tree TREE."
  (let ((new-tree (avltree-create
		   (elib-avl-cmpfun tree))))
    (elib-node-set-left (elib-avl-dummyroot new-tree)
			(elib-avl-do-copy (elib-avl-root tree)))
    new-tree))


(defun avltree-flatten (tree)
  "Return a sorted list containing all elements of TREE."
  (nreverse
   (let ((treelist nil))
     (elib-avl-mapc (function (lambda (node)
				(setq treelist (cons (elib-node-data node)
						     treelist))))
		    (elib-avl-root tree))
     treelist)))


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


(defun avltree-clear (tree)
  "Clear the avl tree TREE."
  (elib-node-set-left (elib-avl-dummyroot tree) nil))

;;; avltree.el ends here