cgit.sxemacs.org Git - gnus/blob - lisp/rtree.el

   1 ;;; rtree.el --- functions for manipulating range trees
   2 ;; Copyright (C) 2010 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   5
   6 ;; This file is part of GNU Emacs.
   7
   8 ;; GNU Emacs is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 3, or (at your option)
  11 ;; any later version.
  12
  13 ;; GNU Emacs is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  20 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  21 ;; Boston, MA 02110-1301, USA.
  22
  23 ;;; Commentary:
  24
  25 ;; A "range tree" is a binary tree that stores ranges.  They are
  26 ;; similar to interval trees, but do not allow overlapping intervals.
  27
  28 ;; A range is an ordered list of number intervals, like this:
  29
  30 ;; ((10 . 25) 56 78 (98 . 201))
  31
  32 ;; Common operations, like lookup, deletion and insertion are O(n) in
  33 ;; a range, but an rtree is O(log n) in all these operations.
  34 ;; Transformation between a range and an rtree is O(n).
  35
  36 ;; The rtrees are quite simple.  The structure of each node is
  37
  38 ;; (cons (cons low high) (cons left right))
  39
  40 ;; That is, they are three cons cells, where the car of the top cell
  41 ;; is the actual range, and the cdr has the left and right child.  The
  42 ;; rtrees aren't automatically balanced, but are balanced when
  43 ;; created, and can be rebalanced when deemed necessary.
  44
  45 ;;; Code:
  46
  47 (eval-when-compile
  48   (require 'cl))
  49
  50 (defmacro rtree-make-node ()
  51   `(list (list nil) nil))
  52
  53 (defmacro rtree-set-left (node left)
  54   `(setcar (cdr ,node) ,left))
  55
  56 (defmacro rtree-set-right (node right)
  57   `(setcdr (cdr ,node) ,right))
  58
  59 (defmacro rtree-set-range (node range)
  60   `(setcar ,node ,range))
  61
  62 (defmacro rtree-low (node)
  63   `(caar ,node))
  64
  65 (defmacro rtree-high (node)
  66   `(cdar ,node))
  67
  68 (defmacro rtree-set-low (node number)
  69   `(setcar (car ,node) ,number))
  70
  71 (defmacro rtree-set-high (node number)
  72   `(setcdr (car ,node) ,number))
  73
  74 (defmacro rtree-left (node)
  75   `(cadr ,node))
  76
  77 (defmacro rtree-right (node)
  78   `(cddr ,node))
  79
  80 (defmacro rtree-range (node)
  81   `(car ,node))
  82
  83 (defsubst rtree-normalise-range (range)
  84   (when (numberp range)
  85     (setq range (cons range range)))
  86   range)
  87
  88 (defun rtree-make (range)
  89   "Make an rtree from RANGE."
  90   ;; Normalize the range.
  91   (unless (listp (cdr-safe range))
  92     (setq range (list range)))
  93   (rtree-make-1 (cons nil range) (length range)))
  94
  95 (defun rtree-make-1 (range length)
  96   (let ((mid (/ length 2))
  97         (node (rtree-make-node)))
  98     (when (> mid 0)
  99       (rtree-set-left node (rtree-make-1 range mid)))
 100     (rtree-set-range node (rtree-normalise-range (cadr range)))
 101     (setcdr range (cddr range))
 102     (when (> (- length mid 1) 0)
 103       (rtree-set-right node (rtree-make-1 range (- length mid 1))))
 104     node))
 105
 106 (defun rtree-memq (tree number)
 107   "Return non-nil if NUMBER is present in TREE."
 108   (while (and tree
 109               (not (and (>= number (rtree-low tree))
 110                         (<= number (rtree-high tree)))))
 111     (setq tree
 112           (if (< number (rtree-low tree))
 113               (rtree-left tree)
 114             (rtree-right tree))))
 115   tree)
 116
 117 (defun rtree-add (tree number)
 118   "Add NUMBER to TREE."
 119   (while tree
 120     (cond
 121      ;; It's already present, so we don't have to do anything.
 122      ((and (>= number (rtree-low tree))
 123            (<= number (rtree-high tree)))
 124       (setq tree nil))
 125      ;; Extend the low range.
 126      ((= number (1- (rtree-low tree)))
 127       (rtree-set-low tree number)
 128       ;; Check whether we need to merge this node with the child.
 129       (when (and (rtree-left tree)
 130                  (= (rtree-high (rtree-left tree)) (1- number)))
 131         ;; Extend the range to the low from the child.
 132         (rtree-set-low tree (rtree-low (rtree-left tree)))
 133         ;; The child can't have a right child, so just transplant the
 134         ;; child's left tree to our left tree.
 135         (rtree-set-left tree (rtree-left (rtree-left tree))))
 136       (setq tree nil))
 137      ;; Extend the high range.
 138      ((= number (1+ (rtree-high tree)))
 139       (rtree-set-high tree number)
 140       ;; Check whether we need to merge this node with the child.
 141       (when (and (rtree-right tree)
 142                  (= (rtree-low (rtree-right tree)) (1+ number)))
 143         ;; Extend the range to the high from the child.
 144         (rtree-set-high tree (rtree-high (rtree-right tree)))
 145         ;; The child can't have a left child, so just transplant the
 146         ;; child's left right to our right tree.
 147         (rtree-set-right tree (rtree-right (rtree-right tree))))
 148       (setq tree nil))
 149      ((< number (rtree-low tree))
 150       (if (rtree-left tree)
 151           (setq tree (rtree-left tree))
 152         (let ((new-node (rtree-make-node)))
 153           (rtree-set-low new-node number)
 154           (rtree-set-high new-node number)
 155           (rtree-set-left tree new-node)
 156           (setq tree nil))))
 157      (t
 158       (if (rtree-right tree)
 159           (setq tree (rtree-right tree))
 160         (let ((new-node (rtree-make-node)))
 161           (rtree-set-low new-node number)
 162           (rtree-set-high new-node number)
 163           (rtree-set-right tree new-node)
 164           (setq tree nil)))))))
 165
 166 (defun rtree-extract (tree)
 167   "Convert TREE to range form."
 168   (let (stack result)
 169     (while (or stack
 170                tree)
 171       (if tree
 172           (progn
 173             (push tree stack)
 174             (setq tree (rtree-right tree)))
 175         (setq tree (pop stack))
 176         (push (if (= (rtree-low tree)
 177                      (rtree-high tree))
 178                   (rtree-low tree)
 179                 (rtree-range tree))
 180               result)
 181         (setq tree (rtree-left tree))))
 182     result))
 183
 184 (provide 'rtree)
 185
 186 ;;; rtree.el ends here