| 1 | ;;; rtree.el --- functions for manipulating range trees |
| 2 | |
| 3 | ;; Copyright (C) 2010-2011 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
| 6 | |
| 7 | ;; This file is part of GNU Emacs. |
| 8 | |
| 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 | ;; the Free Software Foundation, either version 3 of the License, or |
| 12 | ;; (at your option) any later version. |
| 13 | |
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 17 | ;; GNU General Public License for more details. |
| 18 | |
| 19 | ;; You should have received a copy of the GNU General Public License |
| 20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 21 | |
| 22 | ;;; Commentary: |
| 23 | |
| 24 | ;; A "range tree" is a binary tree that stores ranges. They are |
| 25 | ;; similar to interval trees, but do not allow overlapping intervals. |
| 26 | |
| 27 | ;; A range is an ordered list of number intervals, like this: |
| 28 | |
| 29 | ;; ((10 . 25) 56 78 (98 . 201)) |
| 30 | |
| 31 | ;; Common operations, like lookup, deletion and insertion are O(n) in |
| 32 | ;; a range, but an rtree is O(log n) in all these operations. |
| 33 | ;; Transformation between a range and an rtree is O(n). |
| 34 | |
| 35 | ;; The rtrees are quite simple. The structure of each node is |
| 36 | |
| 37 | ;; (cons (cons low high) (cons left right)) |
| 38 | |
| 39 | ;; That is, they are three cons cells, where the car of the top cell |
| 40 | ;; is the actual range, and the cdr has the left and right child. The |
| 41 | ;; rtrees aren't automatically balanced, but are balanced when |
| 42 | ;; created, and can be rebalanced when deemed necessary. |
| 43 | |
| 44 | ;;; Code: |
| 45 | |
| 46 | (eval-when-compile |
| 47 | (require 'cl)) |
| 48 | |
| 49 | (defmacro rtree-make-node () |
| 50 | `(list (list nil) nil)) |
| 51 | |
| 52 | (defmacro rtree-set-left (node left) |
| 53 | `(setcar (cdr ,node) ,left)) |
| 54 | |
| 55 | (defmacro rtree-set-right (node right) |
| 56 | `(setcdr (cdr ,node) ,right)) |
| 57 | |
| 58 | (defmacro rtree-set-range (node range) |
| 59 | `(setcar ,node ,range)) |
| 60 | |
| 61 | (defmacro rtree-low (node) |
| 62 | `(caar ,node)) |
| 63 | |
| 64 | (defmacro rtree-high (node) |
| 65 | `(cdar ,node)) |
| 66 | |
| 67 | (defmacro rtree-set-low (node number) |
| 68 | `(setcar (car ,node) ,number)) |
| 69 | |
| 70 | (defmacro rtree-set-high (node number) |
| 71 | `(setcdr (car ,node) ,number)) |
| 72 | |
| 73 | (defmacro rtree-left (node) |
| 74 | `(cadr ,node)) |
| 75 | |
| 76 | (defmacro rtree-right (node) |
| 77 | `(cddr ,node)) |
| 78 | |
| 79 | (defmacro rtree-range (node) |
| 80 | `(car ,node)) |
| 81 | |
| 82 | (defsubst rtree-normalise-range (range) |
| 83 | (when (numberp range) |
| 84 | (setq range (cons range range))) |
| 85 | range) |
| 86 | |
| 87 | (defun rtree-make (range) |
| 88 | "Make an rtree from RANGE." |
| 89 | ;; Normalize the range. |
| 90 | (unless (listp (cdr-safe range)) |
| 91 | (setq range (list range))) |
| 92 | (rtree-make-1 (cons nil range) (length range))) |
| 93 | |
| 94 | (defun rtree-make-1 (range length) |
| 95 | (let ((mid (/ length 2)) |
| 96 | (node (rtree-make-node))) |
| 97 | (when (> mid 0) |
| 98 | (rtree-set-left node (rtree-make-1 range mid))) |
| 99 | (rtree-set-range node (rtree-normalise-range (cadr range))) |
| 100 | (setcdr range (cddr range)) |
| 101 | (when (> (- length mid 1) 0) |
| 102 | (rtree-set-right node (rtree-make-1 range (- length mid 1)))) |
| 103 | node)) |
| 104 | |
| 105 | (defun rtree-memq (tree number) |
| 106 | "Return non-nil if NUMBER is present in TREE." |
| 107 | (while (and tree |
| 108 | (not (and (>= number (rtree-low tree)) |
| 109 | (<= number (rtree-high tree))))) |
| 110 | (setq tree |
| 111 | (if (< number (rtree-low tree)) |
| 112 | (rtree-left tree) |
| 113 | (rtree-right tree)))) |
| 114 | tree) |
| 115 | |
| 116 | (defun rtree-add (tree number) |
| 117 | "Add NUMBER to TREE." |
| 118 | (while tree |
| 119 | (cond |
| 120 | ;; It's already present, so we don't have to do anything. |
| 121 | ((and (>= number (rtree-low tree)) |
| 122 | (<= number (rtree-high tree))) |
| 123 | (setq tree nil)) |
| 124 | ((< number (rtree-low tree)) |
| 125 | (cond |
| 126 | ;; Extend the low range. |
| 127 | ((= number (1- (rtree-low tree))) |
| 128 | (rtree-set-low tree number) |
| 129 | ;; Check whether we need to merge this node with the child. |
| 130 | (when (and (rtree-left tree) |
| 131 | (= (rtree-high (rtree-left tree)) (1- number))) |
| 132 | ;; Extend the range to the low from the child. |
| 133 | (rtree-set-low tree (rtree-low (rtree-left tree))) |
| 134 | ;; The child can't have a right child, so just transplant the |
| 135 | ;; child's left tree to our left tree. |
| 136 | (rtree-set-left tree (rtree-left (rtree-left tree)))) |
| 137 | (setq tree nil)) |
| 138 | ;; Descend further to the left. |
| 139 | ((rtree-left tree) |
| 140 | (setq tree (rtree-left tree))) |
| 141 | ;; Add a new node. |
| 142 | (t |
| 143 | (let ((new-node (rtree-make-node))) |
| 144 | (rtree-set-low new-node number) |
| 145 | (rtree-set-high new-node number) |
| 146 | (rtree-set-left tree new-node) |
| 147 | (setq tree nil))))) |
| 148 | (t |
| 149 | (cond |
| 150 | ;; Extend the high range. |
| 151 | ((= number (1+ (rtree-high tree))) |
| 152 | (rtree-set-high tree number) |
| 153 | ;; Check whether we need to merge this node with the child. |
| 154 | (when (and (rtree-right tree) |
| 155 | (= (rtree-low (rtree-right tree)) (1+ number))) |
| 156 | ;; Extend the range to the high from the child. |
| 157 | (rtree-set-high tree (rtree-high (rtree-right tree))) |
| 158 | ;; The child can't have a left child, so just transplant the |
| 159 | ;; child's left right to our right tree. |
| 160 | (rtree-set-right tree (rtree-right (rtree-right tree)))) |
| 161 | (setq tree nil)) |
| 162 | ;; Descend further to the right. |
| 163 | ((rtree-right tree) |
| 164 | (setq tree (rtree-right tree))) |
| 165 | ;; Add a new node. |
| 166 | (t |
| 167 | (let ((new-node (rtree-make-node))) |
| 168 | (rtree-set-low new-node number) |
| 169 | (rtree-set-high new-node number) |
| 170 | (rtree-set-right tree new-node) |
| 171 | (setq tree nil)))))))) |
| 172 | |
| 173 | (defun rtree-delq (tree number) |
| 174 | "Remove NUMBER from TREE destructively. Returns the new tree." |
| 175 | (let ((result tree) |
| 176 | prev) |
| 177 | (while tree |
| 178 | (cond |
| 179 | ((< number (rtree-low tree)) |
| 180 | (setq prev tree |
| 181 | tree (rtree-left tree))) |
| 182 | ((> number (rtree-high tree)) |
| 183 | (setq prev tree |
| 184 | tree (rtree-right tree))) |
| 185 | ;; The number is in this node. |
| 186 | (t |
| 187 | (cond |
| 188 | ;; The only entry; delete the node. |
| 189 | ((= (rtree-low tree) (rtree-high tree)) |
| 190 | (cond |
| 191 | ;; Two children. Replace with successor value. |
| 192 | ((and (rtree-left tree) (rtree-right tree)) |
| 193 | (let ((parent tree) |
| 194 | (successor (rtree-right tree))) |
| 195 | (while (rtree-left successor) |
| 196 | (setq parent successor |
| 197 | successor (rtree-left successor))) |
| 198 | ;; We now have the leftmost child of our right child. |
| 199 | (rtree-set-range tree (rtree-range successor)) |
| 200 | ;; Transplant the child (if any) to the parent. |
| 201 | (rtree-set-left parent (rtree-right successor)))) |
| 202 | (t |
| 203 | (let ((rest (or (rtree-left tree) |
| 204 | (rtree-right tree)))) |
| 205 | ;; One or zero children. Remove the node. |
| 206 | (cond |
| 207 | ((null prev) |
| 208 | (setq result rest)) |
| 209 | ((eq (rtree-left prev) tree) |
| 210 | (rtree-set-left prev rest)) |
| 211 | (t |
| 212 | (rtree-set-right prev rest))))))) |
| 213 | ;; The lowest in the range; just adjust. |
| 214 | ((= number (rtree-low tree)) |
| 215 | (rtree-set-low tree (1+ number))) |
| 216 | ;; The highest in the range; just adjust. |
| 217 | ((= number (rtree-high tree)) |
| 218 | (rtree-set-high tree (1- number))) |
| 219 | ;; We have to split this range. |
| 220 | (t |
| 221 | (let ((new-node (rtree-make-node))) |
| 222 | (rtree-set-low new-node (rtree-low tree)) |
| 223 | (rtree-set-high new-node (1- number)) |
| 224 | (rtree-set-low tree (1+ number)) |
| 225 | (cond |
| 226 | ;; Two children; insert the new node as the predecessor |
| 227 | ;; node. |
| 228 | ((and (rtree-left tree) (rtree-right tree)) |
| 229 | (let ((predecessor (rtree-left tree))) |
| 230 | (while (rtree-right predecessor) |
| 231 | (setq predecessor (rtree-right predecessor))) |
| 232 | (rtree-set-right predecessor new-node))) |
| 233 | ((rtree-left tree) |
| 234 | (rtree-set-right new-node tree) |
| 235 | (rtree-set-left new-node (rtree-left tree)) |
| 236 | (rtree-set-left tree nil) |
| 237 | (cond |
| 238 | ((null prev) |
| 239 | (setq result new-node)) |
| 240 | ((eq (rtree-left prev) tree) |
| 241 | (rtree-set-left prev new-node)) |
| 242 | (t |
| 243 | (rtree-set-right prev new-node)))) |
| 244 | (t |
| 245 | (rtree-set-left tree new-node)))))) |
| 246 | (setq tree nil)))) |
| 247 | result)) |
| 248 | |
| 249 | (defun rtree-extract (tree) |
| 250 | "Convert TREE to range form." |
| 251 | (let (stack result) |
| 252 | (while (or stack |
| 253 | tree) |
| 254 | (if tree |
| 255 | (progn |
| 256 | (push tree stack) |
| 257 | (setq tree (rtree-right tree))) |
| 258 | (setq tree (pop stack)) |
| 259 | (push (if (= (rtree-low tree) |
| 260 | (rtree-high tree)) |
| 261 | (rtree-low tree) |
| 262 | (rtree-range tree)) |
| 263 | result) |
| 264 | (setq tree (rtree-left tree)))) |
| 265 | result)) |
| 266 | |
| 267 | (defun rtree-length (tree) |
| 268 | "Return the number of numbers stored in TREE." |
| 269 | (if (null tree) |
| 270 | 0 |
| 271 | (+ (rtree-length (rtree-left tree)) |
| 272 | (1+ (- (rtree-high tree) |
| 273 | (rtree-low tree))) |
| 274 | (rtree-length (rtree-right tree))))) |
| 275 | |
| 276 | (provide 'rtree) |
| 277 | |
| 278 | ;;; rtree.el ends here |