Changeset 25915 in project
- Timestamp:
- 02/16/12 09:46:22 (9 years ago)
- Location:
- release/4/spatial-trees/trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/spatial-trees/trunk/kd-tree.scm
r25912 r25915 11 11 kd-tree->list 12 12 kd-tree-map 13 kd-tree-for-each 14 kd-tree-i-for-each 13 15 kd-tree-fold-right 14 16 kd-tree-subtrees 17 kd-tree-point 15 18 list->kd-tree 16 19 kd-tree-nearest-neighbor … … 18 21 kd-tree-k-nearest-neighbors 19 22 kd-tree-remove 23 kd-tree-slice 24 kd-tree-i-slice 20 25 kd-tree-is-valid? 21 26 kd-tree-all-subtrees-are-valid? … … 120 125 (KdNode (list->kd-tree/depth (take sorted-points median-index) (+ 1 depth)) 121 126 (list-ref sorted-points median-index) 127 median-index 122 128 (list->kd-tree/depth (drop sorted-points (+ median-index 1)) (+ 1 depth)) 123 129 axis) … … 156 162 (cases kd-tree t 157 163 (KdEmpty () #f) 158 (KdNode (l p r axis)164 (KdNode (l p i r axis) 159 165 (if (and (tree-empty? l) 160 166 (tree-empty? r)) p … … 181 187 (cases kd-tree t 182 188 (KdEmpty () '()) 183 (KdNode (l p r axis)189 (KdNode (l p i r axis) 184 190 (let ((maybe-pivot (if (<= (dist2 probe p) (* radius radius)) 185 191 (list p) '()))) … … 230 236 (cases kd-tree t 231 237 (KdEmpty () (KdEmpty)) 232 (KdNode (l p r axis)238 (KdNode (l p i r axis) 233 239 (if (equal? p p-kill) 234 240 (list->kd-tree/depth … … 239 245 (if (<= (coord axis p-kill) 240 246 (coord axis p)) 241 (KdNode (remove l p-kill) p r axis)242 (KdNode l p (remove r p-kill) axis))247 (KdNode (remove l p-kill) p i r axis) 248 (KdNode l p i (remove r p-kill) axis)) 243 249 )) 244 250 )) … … 257 263 (cases kd-tree t 258 264 (KdEmpty () #t) 259 (KdNode (l p r axis)265 (KdNode (l p i r axis) 260 266 (let ((x (coord axis p))) 261 267 (and (every (lambda (y) (<= (coord axis y) x )) … … 276 282 (KdNode (left kd-tree?) 277 283 (p point3d?) 284 (i integer?) 278 285 (right kd-tree?) 279 286 (axis integer?)) … … 291 298 (cases kd-tree t 292 299 (KdEmpty () (KdEmpty)) 293 (KdNode (l x r axis)300 (KdNode (l x i r axis) 294 301 (KdNode (kd-tree-map f l) 295 302 (f x) … … 298 305 )) 299 306 307 (define (kd-tree-for-each f t) 308 (cases kd-tree t 309 (KdEmpty () (begin)) 310 (KdNode (l x i r axis) 311 (begin 312 (kd-tree-for-each f l) 313 (f x) 314 (kd-tree-for-each f r) 315 )) 316 )) 317 318 (define (kd-tree-i-for-each f t) 319 (cases kd-tree t 320 (KdEmpty () (begin)) 321 (KdNode (l x i r axis) 322 (begin 323 (kd-tree-i-for-each f l) 324 (f i x) 325 (kd-tree-i-for-each f r) 326 )) 327 )) 328 300 329 (define (kd-tree-fold-right f init t) 301 330 (cases kd-tree t 302 331 (KdEmpty () init) 303 (KdNode (l x r _)332 (KdNode (l x i r _) 304 333 (let* ((init2 (kd-tree-fold-right f init r)) 305 334 (init3 (f x init2))) 306 335 (kd-tree-fold-right f init3 l))) 307 336 )) 337 338 (define=> (make-kd-tree-slice <Point>) 339 (lambda (x-axis x1 x2 t) 340 (let recur ((t t) (pts '())) 341 (cases kd-tree t 342 (KdEmpty () pts) 343 (KdNode (l p i r axis) 344 (if (= axis x-axis) 345 346 (cond ((and (<= x1 (coord axis p)) 347 (<= (coord axis p) x2)) 348 (recur l (cons p (recur r pts)))) 349 350 ((< (coord axis p) x1) 351 (recur r pts)) 352 353 ((< x2 (coord axis p)) 354 (recur l pts))) 355 356 (if (and (<= x1 (coord x-axis p)) 357 (<= (coord x-axis p) x2)) 358 (recur l (cons p (recur r pts))) 359 (recur l (recur r pts))) 360 )) 361 )) 362 )) 363 364 365 (define=> (make-kd-tree-i-slice <Point>) 366 (lambda (x-axis x1 x2 t) 367 (let recur ((t t) (pts '())) 368 (cases kd-tree t 369 (KdEmpty () pts) 370 (KdNode (l p i r axis) 371 (if (= axis x-axis) 372 373 (cond ((and (<= x1 (coord axis p)) 374 (<= (coord axis p) x2)) 375 (recur l (cons (cons i p) (recur r pts)))) 376 377 ((< (coord axis p) x1) 378 (recur r pts)) 379 380 ((< x2 (coord axis p)) 381 (recur l pts))) 382 383 (if (and (<= x1 (coord x-axis p)) 384 (<= (coord x-axis p) x2)) 385 (recur l (cons p (recur r pts))) 386 (recur l (recur r pts))) 387 )) 388 )) 389 )) 390 391 308 392 309 393 … … 315 399 (KdEmpty () 316 400 (list (KdEmpty))) 317 (KdNode (l x r axis)401 (KdNode (l x i r axis) 318 402 (append (kd-tree-subtrees l) 319 403 (list t) … … 321 405 )) 322 406 407 (define (kd-tree-point t) 408 (cases kd-tree t 409 (KdEmpty () #f) 410 (KdNode (l x i r axis) x) 411 )) 412 323 413 (define list->kd-tree/depth 324 414 (make-list->kd-tree/depth Point-point3d)) … … 335 425 (define kd-tree-remove (make-kd-tree-remove Point-point3d)) 336 426 427 (define kd-tree-slice (make-kd-tree-slice Point-point3d)) 428 429 (define kd-tree-i-slice (make-kd-tree-i-slice Point-point3d)) 430 337 431 (define kd-tree-is-valid? (make-kd-tree-is-valid? Point-point3d)) 338 432 -
release/4/spatial-trees/trunk/spatial-trees.setup
r25912 r25915 18 18 '((version 1.0) 19 19 )) 20 21
Note: See TracChangeset
for help on using the changeset viewer.