Commit | Line | Data |
---|---|---|
ed797193 | 1 | ;;; rtree.el --- functions for manipulating range trees |
a33a2868 | 2 | |
73b0cd50 | 3 | ;; Copyright (C) 2010-2011 Free Software Foundation, Inc. |
ed797193 G |
4 | |
5 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | |
6 | ||
7 | ;; This file is part of GNU Emacs. | |
8 | ||
a33a2868 | 9 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
ed797193 | 10 | ;; it under the terms of the GNU General Public License as published by |
a33a2868 GM |
11 | ;; the Free Software Foundation, either version 3 of the License, or |
12 | ;; (at your option) any later version. | |
ed797193 G |
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 | |
a33a2868 | 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
ed797193 G |
17 | ;; GNU General Public License for more details. |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
a33a2868 | 20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
ed797193 G |
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 |