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-left (node)
  69   `(cadr ,node))
  70
  71 (defmacro rtree-right (node)
  72   `(cddr ,node))
  73
  74 (defmacro rtree-range (node)
  75   `(car ,node))
  76
  77 (defsubst rtree-normalise-range (range)
  78   (when (numberp range)
  79     (setq range (cons range range)))
  80   range)
  81
  82 (defun rtree-make (range)
  83   "Make an rtree from RANGE."
  84   ;; Normalize the range.
  85   (unless (listp (cdr-safe range))
  86     (setq range (list range)))
  87   (rtree-make-1 (cons nil range) (length range)))
  88
  89 (defun rtree-make-1 (range length)
  90   (let ((mid (/ length 2))
  91         (node (rtree-make-node)))
  92     (when (> mid 0)
  93       (rtree-set-left node (rtree-make-1 range mid)))
  94     (rtree-set-range node (rtree-normalise-range (cadr range)))
  95     (setcdr range (cddr range))
  96     (when (> (- length mid 1) 0)
  97       (rtree-set-right node (rtree-make-1 range (- length mid 1))))
  98     node))
  99
 100 (defun rtree-memq (tree number)
 101   (cond
 102    ((and (>= number (rtree-low tree))
 103          (<= number (rtree-high tree)))
 104     t)
 105    ((< number (rtree-low tree))
 106     (and (rtree-left tree)
 107          (rtree-memq (rtree-left tree) number)))
 108    (t
 109     (and (rtree-right tree)
 110          (rtree-memq (rtree-right tree) number)))))
 111
 112 (defun rtree-extract (tree)
 113   "Convert TREE to range form."
 114   (let ((stack (list tree))
 115         result)
 116     (while stack
 117       (setq tree (pop stack))
 118       (while (rtree-right tree)
 119         (push tree stack)
 120         (let ((a (rtree-right tree)))
 121           (rtree-set-right tree nil)
 122           (setq tree a)))
 123       (push (if (= (rtree-low tree)
 124                    (rtree-high tree))
 125                 (rtree-low tree)
 126               (rtree-range tree))
 127             result)
 128       (when (rtree-left tree)
 129         (push (rtree-left tree) stack)))
 130     result))
 131
 132 (provide 'rtree)
 133
 134 ;;; rtree.el ends here