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

   1 ;;;; $Id: bintree.el,v 1.1.1.1 1998-10-07 11:10:57 jareth Exp $
   2 ;;; This file implements binary trees.
   3
   4 ;; Copyright (C) 1991-1995 Free Software Foundation
   5
   6 ;; Author: Inge Wallin <inge@lysator.liu.se>
   7 ;; Maintainer: elib-maintainers@lysator.liu.se
   8 ;; Created: 21 May 1991
   9 ;; Keywords: extensions, lisp
  10
  11 ;;;; This file is part of the GNU Emacs lisp library, Elib.
  12 ;;;;
  13 ;;;; GNU Elib is free software; you can redistribute it and/or modify
  14 ;;;; it under the terms of the GNU General Public License as published by
  15 ;;;; the Free Software Foundation; either version 2, or (at your option)
  16 ;;;; any later version.
  17 ;;;;
  18 ;;;; GNU Elib is distributed in the hope that it will be useful,
  19 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;;;; GNU General Public License for more details.
  22 ;;;;
  23 ;;;; You should have received a copy of the GNU General Public License
  24 ;;;; along with GNU Elib; see the file COPYING.  If not, write to
  25 ;;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;;;; Boston, MA 02111-1307, USA
  27 ;;;;
  28 ;;;; Author:  Inge Wallin
  29 ;;;;
  30
  31 ;;; Commentary:
  32
  33 ;;;
  34 ;;; A binary tree consists of two cons cells, the first one holding
  35 ;;; the tag 'BINTREE in the car cell and the second one having
  36 ;;; the tree in the car and the compare function in the cdr cell. The
  37 ;;; tree has a dummy node as its root with the real tree in the left
  38 ;;; pointer.  The compare function must take two arguments of the type
  39 ;;; which is to be stored in the tree and must return non-nil if
  40 ;;; the first argument is "less than" the second argument and nil
  41 ;;; otherwise.
  42 ;;;
  43 ;;; For example, use
  44 ;;;    (bintree-create '<)
  45 ;;; if the tree is going to store integers.
  46 ;;;
  47 ;;;
  48 ;;; This package uses the macros in the file elib-node.el and
  49 ;;; a stack from stack.el.
  50 ;;;
  51
  52 ;;; Code:
  53
  54 (require 'elib-node)
  55 (require 'stack-m)
  56
  57 (provide 'bintree)
  58
  59
  60 ;;; ================================================================
  61 ;;;      Internal functions for use in the binary tree package
  62
  63
  64 (defmacro elib-bintree-root (tree)
  65
  66   ;; Return the root node for a binary tree.  INTERNAL USE ONLY.
  67   (` (elib-node-left (car (cdr (, tree))))))
  68
  69
  70 (defmacro elib-bintree-dummyroot (tree)
  71
  72   ;; Return the dummy node of a binary tree.  INTERNAL USE ONLY.
  73   (` (car (cdr (, tree)))))
  74
  75
  76 (defmacro elib-bintree-cmpfun (tree)
  77
  78   ;; Return the compare function of binary tree TREE.  INTERNAL USE ONLY."
  79   (` (cdr (cdr (, tree)))))
  80
  81
  82
  83 (defun elib-bintree-mapc (map-function root)
  84
  85   ;; Apply MAP-FUNCTION to all nodes in the tree starting with ROOT.
  86   ;; The function is applied in-order.
  87   ;;
  88   ;; Note: MAP-FUNCTION is applied to the node and not to the data itself.
  89   ;;
  90   ;; INTERNAL USE ONLY."
  91
  92   (let ((node root)
  93         (stack (elib-stack-create))
  94         (go-left t))
  95     (elib-stack-push stack nil)
  96     (while node
  97       (if (and go-left
  98                (elib-node-left node))
  99           (progn                                   ; Do the left subtree first.
 100             (elib-stack-push stack node)
 101             (setq node (elib-node-left node)))
 102         (funcall map-function node)                ; Apply the function...
 103         (if (elib-node-right node)                 ; and do the right subtree.
 104             (setq node (elib-node-right node)
 105                   go-left t)
 106           (setq node (elib-stack-pop stack)
 107                 go-left nil))))))
 108
 109
 110 (defun elib-bintree-do-copy (root)
 111
 112   ;; Copy the tree with ROOT as root.  Highly recursive. INTERNAL USE ONLY.
 113   (if (null root)
 114       nil
 115     (elib-node-create (elib-bintree-do-copy (elib-node-left root))
 116                       (elib-bintree-do-copy (elib-node-right root))
 117                       (elib-node-data root))))
 118
 119
 120 ;;; ================================================================
 121 ;;;       The public functions which operate on binary trees.
 122
 123
 124 (defun bintree-create (compare-function)
 125   "Create an empty binary tree using COMPARE-FUNCTION as the compare function.
 126 COMPARE-FUNCTION is a function which takes two arguments, A and B, and
 127 returns non-nil if A is less than B, and nil otherwise."
 128
 129   (cons 'BINTREE
 130         (cons (elib-node-create nil nil nil)
 131               compare-function)))
 132
 133
 134
 135 (defun bintree-p (obj)
 136   "return t if OBJ is a binary tree, nil otherwise."
 137   (eq (car-safe obj) 'BINTREE))
 138
 139
 140
 141 (defun bintree-compare-function (tree)
 142   "Return the comparision function for the binary tree TREE."
 143   (elib-bintree-cmpfun tree))
 144
 145
 146
 147 (defun bintree-empty (tree)
 148   "Return t if the binary tree TREE is empty, otherwise return nil."
 149   (null (elib-bintree-root tree)))
 150
 151
 152
 153 (defun bintree-enter (tree data)
 154   "In the binary tree TREE, insert DATA."
 155
 156   (let ((cmpfun (elib-bintree-cmpfun tree))
 157         (node (elib-bintree-dummyroot tree))
 158         (new-node (elib-node-create nil nil data)))
 159     (if (null (elib-node-left node))
 160         (elib-node-set-left node new-node)
 161       (setq node (elib-node-left node))
 162       (while node
 163         (cond
 164          ((funcall cmpfun data (elib-node-data node))
 165           (if (elib-node-left node)
 166               (setq node (elib-node-left node))
 167             (elib-node-set-left node new-node)
 168             (setq node nil)))
 169
 170          ((funcall cmpfun (elib-node-data node) data)
 171           (if (elib-node-right node)
 172               (setq node (elib-node-right node))
 173             (elib-node-set-right node new-node)
 174             (setq node nil)))
 175
 176          (t
 177           (elib-node-set-data node data)
 178           (setq node nil)))))))
 179
 180
 181
 182 (defun bintree-delete (tree data)
 183   "From the binary tree TREE, delete DATA.
 184 Return the element in TREE which matched DATA, or nil if no element matched."
 185
 186   (let* ((cmpfun (elib-bintree-cmpfun tree))
 187          (upper-node (elib-bintree-dummyroot tree)) ; Start with the dummy node
 188          (branch 0)                                ; Left branch
 189          (branch-node (elib-node-left upper-node))
 190          node-data
 191          right-node)                               ; Only used while deleting,
 192                                                    ; not while searching
 193     (if (null branch-node)
 194         nil
 195       (while upper-node
 196         (setq node-data (elib-node-data branch-node))
 197         (cond
 198          ((funcall cmpfun data node-data)          ; data<node-data => go left
 199           (setq upper-node branch-node
 200                 branch-node (elib-node-left upper-node)
 201                 branch 0))
 202
 203          ((funcall cmpfun node-data data)          ; data>node-data => go right
 204           (setq upper-node branch-node
 205                 branch-node (elib-node-right upper-node)
 206                 branch 1))
 207
 208          (t                                        ; This is the node we want
 209                                                    ; to delete.
 210           (cond
 211            ((null (elib-node-left branch-node))    ; Empty left node?
 212             (elib-node-set-branch upper-node branch
 213                                   (elib-node-right branch-node)))
 214
 215            ((null (elib-node-right branch-node))   ; Empty right node?
 216             (elib-node-set-branch upper-node branch
 217                                   (elib-node-left branch-node)))
 218
 219            (t                                      ; Both branches occupied.
 220
 221             ;; At this point `branch-node' points at the node we want
 222             ;; to delete.  Both the right and the left branches are
 223             ;; non-nil, so we will take the data of the rightmost node
 224             ;; of the left subtree and put into `branch-node'.
 225             (setq right-node branch-node
 226                   branch 0)
 227             (while (elib-node-right (elib-node-branch right-node branch))
 228               (setq right-node (elib-node-branch right-node branch)
 229                     branch 1))
 230             (elib-node-set-data branch-node
 231                                 (elib-node-data (elib-node-branch right-node
 232                                                                   branch)))
 233             (elib-node-set-branch right-node branch
 234                                   (elib-node-left
 235                                    (elib-node-branch right-node branch)))))
 236           (setq upper-node nil)))))))
 237
 238
 239
 240 (defun bintree-member (tree data)
 241   "Return the element in the binary tree TREE which matches DATA.
 242 Matching uses the compare function previously specified in `bintree-create'
 243 when TREE was created.
 244
 245 If there is no such element in the tree, the value is nil."
 246
 247   (let ((node (elib-bintree-root tree))
 248         (compare-function (elib-bintree-cmpfun tree))
 249         found)
 250     (while (and node
 251                 (not found))
 252       (cond
 253        ((funcall compare-function data (elib-node-data node))
 254         (setq node (elib-node-left node)))
 255        ((funcall compare-function (elib-node-data node) data)
 256         (setq node (elib-node-right node)))
 257        (t
 258         (setq found t))))
 259
 260     (if node
 261         (elib-node-data node)
 262       nil)))
 263
 264
 265
 266 (defun bintree-map (__map-function__ tree)
 267   "Apply MAP-FUNCTION to all elements in the binary tree TREE."
 268
 269   (elib-bintree-mapc
 270    (function (lambda (node)
 271                (elib-node-set-data node
 272                                    (funcall __map-function__
 273                                             (elib-node-data node)))))
 274    (elib-bintree-root tree)))
 275
 276
 277
 278 (defun bintree-first (tree)
 279   "Return the first element in the binary tree TREE, or nil if TREE is empty."
 280
 281   (let ((node (elib-bintree-root tree)))
 282     (if node
 283         (progn
 284           (while (elib-node-left node)
 285             (setq node (elib-node-left node)))
 286           (elib-node-data node))
 287       nil)))
 288
 289
 290
 291 (defun bintree-last (tree)
 292   "Return the last element in the binary tree TREE, or nil if TREE is empty."
 293
 294   (let ((node (elib-bintree-root tree)))
 295     (if node
 296         (progn
 297           (while (elib-node-right node)
 298             (setq node (elib-node-right node)))
 299           (elib-node-data node))
 300       nil)))
 301
 302
 303
 304 (defun bintree-copy (tree)
 305   "Return a copy of the binary tree TREE.
 306
 307 Note: This function is recursive and might result in an
 308       `max eval depth exceeded' error."
 309
 310   (let ((new-tree (bintree-create
 311                    (elib-bintree-cmpfun tree))))
 312     (elib-node-set-left (elib-bintree-dummyroot new-tree)
 313                         (elib-bintree-do-copy (elib-bintree-root tree)))
 314     new-tree))
 315
 316
 317
 318 ;;
 319 ;; Not the fastest way to do this.
 320 ;;
 321 (defun bintree-flatten (tree)
 322   "Return a sorted list containing all elements of the binary tree TREE."
 323
 324   (nreverse
 325    (let ((treelist nil))
 326      (elib-bintree-mapc (function (lambda (node)
 327                                     (setq treelist (cons (elib-node-data node)
 328                                                          treelist))))
 329                         (elib-bintree-root tree))
 330      treelist)))
 331
 332
 333
 334 ;;
 335 ;; Not the fastest way to do this:
 336 ;;
 337 (defun bintree-size (tree)
 338   "Return the number of elements in the binary tree TREE."
 339
 340   (let ((treesize 0))
 341     (elib-bintree-mapc (function (lambda (data)
 342                                    (setq treesize (1+ treesize))))
 343                        (elib-bintree-root tree))
 344     treesize))
 345
 346
 347
 348 (defun bintree-clear (tree)
 349   "Clear the binary tree TREE."
 350
 351   (elib-node-set-left (elib-bintree-dummyroot tree) nil))
 352
 353 ;;; bintree.el ends here