rtree.el 8.28 KB
Newer Older
1
;;; rtree.el --- functions for manipulating range trees
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
4 5 6 7 8

;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>

;; This file is part of GNU Emacs.

9
;; GNU Emacs is free software: you can redistribute it and/or modify
10
;; it under the terms of the GNU General Public License as published by
11 12
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
13 14 15

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17 18 19
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
20
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81

;;; Commentary:

;; A "range tree" is a binary tree that stores ranges.  They are
;; similar to interval trees, but do not allow overlapping intervals.

;; A range is an ordered list of number intervals, like this:

;; ((10 . 25) 56 78 (98 . 201))

;; Common operations, like lookup, deletion and insertion are O(n) in
;; a range, but an rtree is O(log n) in all these operations.
;; Transformation between a range and an rtree is O(n).

;; The rtrees are quite simple.  The structure of each node is

;; (cons (cons low high) (cons left right))

;; That is, they are three cons cells, where the car of the top cell
;; is the actual range, and the cdr has the left and right child.  The
;; rtrees aren't automatically balanced, but are balanced when
;; created, and can be rebalanced when deemed necessary.

;;; Code:

(eval-when-compile
  (require 'cl))

(defmacro rtree-make-node ()
  `(list (list nil) nil))

(defmacro rtree-set-left (node left)
  `(setcar (cdr ,node) ,left))

(defmacro rtree-set-right (node right)
  `(setcdr (cdr ,node) ,right))

(defmacro rtree-set-range (node range)
  `(setcar ,node ,range))

(defmacro rtree-low (node)
  `(caar ,node))

(defmacro rtree-high (node)
  `(cdar ,node))

(defmacro rtree-set-low (node number)
  `(setcar (car ,node) ,number))

(defmacro rtree-set-high (node number)
  `(setcdr (car ,node) ,number))

(defmacro rtree-left (node)
  `(cadr ,node))

(defmacro rtree-right (node)
  `(cddr ,node))

(defmacro rtree-range (node)
  `(car ,node))

82
(defsubst rtree-normalize-range (range)
83 84 85 86
  (when (numberp range)
    (setq range (cons range range)))
  range)

87 88
(define-obsolete-function-alias 'rtree-normalise-range
  'rtree-normalize-range "25.1")
89

90 91 92 93 94 95 96 97 98 99 100 101
(defun rtree-make (range)
  "Make an rtree from RANGE."
  ;; Normalize the range.
  (unless (listp (cdr-safe range))
    (setq range (list range)))
  (rtree-make-1 (cons nil range) (length range)))

(defun rtree-make-1 (range length)
  (let ((mid (/ length 2))
	(node (rtree-make-node)))
    (when (> mid 0)
      (rtree-set-left node (rtree-make-1 range mid)))
102
    (rtree-set-range node (rtree-normalize-range (cadr range)))
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281
    (setcdr range (cddr range))
    (when (> (- length mid 1) 0)
      (rtree-set-right node (rtree-make-1 range (- length mid 1))))
    node))

(defun rtree-memq (tree number)
  "Return non-nil if NUMBER is present in TREE."
  (while (and tree
	      (not (and (>= number (rtree-low tree))
			(<= number (rtree-high tree)))))
    (setq tree
	  (if (< number (rtree-low tree))
	      (rtree-left tree)
	    (rtree-right tree))))
  tree)

(defun rtree-add (tree number)
  "Add NUMBER to TREE."
  (while tree
    (cond
     ;; It's already present, so we don't have to do anything.
     ((and (>= number (rtree-low tree))
	   (<= number (rtree-high tree)))
      (setq tree nil))
     ((< number (rtree-low tree))
      (cond
       ;; Extend the low range.
       ((= number (1- (rtree-low tree)))
	(rtree-set-low tree number)
	;; Check whether we need to merge this node with the child.
	(when (and (rtree-left tree)
		   (= (rtree-high (rtree-left tree)) (1- number)))
	  ;; Extend the range to the low from the child.
	  (rtree-set-low tree (rtree-low (rtree-left tree)))
	  ;; The child can't have a right child, so just transplant the
	  ;; child's left tree to our left tree.
	  (rtree-set-left tree (rtree-left (rtree-left tree))))
	(setq tree nil))
       ;; Descend further to the left.
       ((rtree-left tree)
	(setq tree (rtree-left tree)))
       ;; Add a new node.
       (t
	(let ((new-node (rtree-make-node)))
	  (rtree-set-low new-node number)
	  (rtree-set-high new-node number)
	  (rtree-set-left tree new-node)
	  (setq tree nil)))))
     (t
      (cond
       ;; Extend the high range.
       ((= number (1+ (rtree-high tree)))
	(rtree-set-high tree number)
	;; Check whether we need to merge this node with the child.
	(when (and (rtree-right tree)
		   (= (rtree-low (rtree-right tree)) (1+ number)))
	  ;; Extend the range to the high from the child.
	  (rtree-set-high tree (rtree-high (rtree-right tree)))
	  ;; The child can't have a left child, so just transplant the
	  ;; child's left right to our right tree.
	  (rtree-set-right tree (rtree-right (rtree-right tree))))
	(setq tree nil))
       ;; Descend further to the right.
       ((rtree-right tree)
	(setq tree (rtree-right tree)))
       ;; Add a new node.
       (t
	(let ((new-node (rtree-make-node)))
	  (rtree-set-low new-node number)
	  (rtree-set-high new-node number)
	  (rtree-set-right tree new-node)
	  (setq tree nil))))))))

(defun rtree-delq (tree number)
  "Remove NUMBER from TREE destructively.  Returns the new tree."
  (let ((result tree)
	prev)
    (while tree
      (cond
       ((< number (rtree-low tree))
	(setq prev tree
	      tree (rtree-left tree)))
       ((> number (rtree-high tree))
	(setq prev tree
	      tree (rtree-right tree)))
       ;; The number is in this node.
       (t
	(cond
	 ;; The only entry; delete the node.
	 ((= (rtree-low tree) (rtree-high tree))
	  (cond
	   ;; Two children.  Replace with successor value.
	   ((and (rtree-left tree) (rtree-right tree))
	    (let ((parent tree)
		  (successor (rtree-right tree)))
	      (while (rtree-left successor)
		(setq parent successor
		      successor (rtree-left successor)))
	      ;; We now have the leftmost child of our right child.
	      (rtree-set-range tree (rtree-range successor))
	      ;; Transplant the child (if any) to the parent.
	      (rtree-set-left parent (rtree-right successor))))
	   (t
	    (let ((rest (or (rtree-left tree)
			    (rtree-right tree))))
	      ;; One or zero children.  Remove the node.
	      (cond
	       ((null prev)
		(setq result rest))
	       ((eq (rtree-left prev) tree)
		(rtree-set-left prev rest))
	       (t
		(rtree-set-right prev rest)))))))
	 ;; The lowest in the range; just adjust.
	 ((= number (rtree-low tree))
	  (rtree-set-low tree (1+ number)))
	 ;; The highest in the range; just adjust.
	 ((= number (rtree-high tree))
	  (rtree-set-high tree (1- number)))
	 ;; We have to split this range.
	 (t
	  (let ((new-node (rtree-make-node)))
	    (rtree-set-low new-node (rtree-low tree))
	    (rtree-set-high new-node (1- number))
	    (rtree-set-low tree (1+ number))
	    (cond
	     ;; Two children; insert the new node as the predecessor
	     ;; node.
	     ((and (rtree-left tree) (rtree-right tree))
	      (let ((predecessor (rtree-left tree)))
		(while (rtree-right predecessor)
		  (setq predecessor (rtree-right predecessor)))
		(rtree-set-right predecessor new-node)))
	     ((rtree-left tree)
	      (rtree-set-right new-node tree)
	      (rtree-set-left new-node (rtree-left tree))
	      (rtree-set-left tree nil)
	      (cond
	       ((null prev)
		(setq result new-node))
	       ((eq (rtree-left prev) tree)
		(rtree-set-left prev new-node))
	       (t
		(rtree-set-right prev new-node))))
	     (t
	      (rtree-set-left tree new-node))))))
	(setq tree nil))))
    result))

(defun rtree-extract (tree)
  "Convert TREE to range form."
  (let (stack result)
    (while (or stack
	       tree)
      (if tree
	  (progn
	    (push tree stack)
	    (setq tree (rtree-right tree)))
	(setq tree (pop stack))
	(push (if (= (rtree-low tree)
		     (rtree-high tree))
		  (rtree-low tree)
		(rtree-range tree))
	      result)
	(setq tree (rtree-left tree))))
    result))

(defun rtree-length (tree)
  "Return the number of numbers stored in TREE."
  (if (null tree)
      0
    (+ (rtree-length (rtree-left tree))
       (1+ (- (rtree-high tree)
	      (rtree-low tree)))
       (rtree-length (rtree-right tree)))))

(provide 'rtree)

;;; rtree.el ends here