Changeset 27050 in project
- Timestamp:
- 07/12/12 02:33:49 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/kd-tree/trunk/kd-tree.scm
r27040 r27050 21 21 kd-tree-points 22 22 kd-tree-indices 23 kd-tree-min 24 kd-tree-max 23 kd-tree-min-index 24 kd-tree-max-index 25 25 kd-tree-size 26 26 ) … … 171 171 (KdNode (left kd-tree?) 172 172 (p point?) 173 (i (lambda (v) (or (integer? v) (and (pair? v) (integer? (car v)))))) 173 (i positive-or-zero-integer?) 174 (v (lambda (v) (or (not v) v))) 174 175 (right kd-tree?) 175 176 (axis positive-or-zero-integer?) … … 195 196 (define (kd-tree->list* t) 196 197 (kd-tree-fold-right* 197 (lambda (i x ax) 198 (cons (list i x) ax)) 198 (lambda (i v x ax) (cons (if v (list i v x) (list i x)) ax)) 199 199 '() t)) 200 200 … … 204 204 (KdLeaf (ii pp vv axis) 205 205 (KdLeaf ii (map f pp) vv axis)) 206 (KdNode (l x i r axis ci)206 (KdNode (l x i v r axis ci) 207 207 (KdNode (kd-tree-map f l) 208 208 (f x) 209 i 209 i v 210 210 (kd-tree-map f r) 211 211 axis ci)) … … 215 215 (cases kd-tree t 216 216 (KdLeaf (ii pp vv axis) (for-each f pp)) 217 (KdNode (l x i r axis ci)217 (KdNode (l x i v r axis ci) 218 218 (begin 219 219 (kd-tree-for-each f l) … … 227 227 (cases kd-tree t 228 228 (KdLeaf (ii pp vv axis) (for-each f (reverse (cis:elements ii)) vv pp)) 229 (KdNode (l x i r axis ci)229 (KdNode (l x i v r axis ci) 230 230 (begin 231 231 (kd-tree-for-each* f l) 232 (f i x)232 (f i v x) 233 233 (kd-tree-for-each* f r) 234 234 )) … … 240 240 (KdLeaf (ii pp vv axis) 241 241 (fold-right f init pp)) 242 (KdNode (l p i r axis ci)242 (KdNode (l p i v r axis ci) 243 243 (let* ((init2 (kd-tree-fold-right f init r)) 244 244 (init3 (f p init2))) … … 253 253 (fold-right f init (zip (reverse (cis:elements ii)) vv) pp) 254 254 (fold-right f init (reverse (cis:elements ii)) pp))) 255 (KdNode (l x i r axis ci)255 (KdNode (l x i v r axis ci) 256 256 (let* ((init2 (kd-tree-fold-right* f init r)) 257 (init3 (f i x init2)))257 (init3 (f i v x init2))) 258 258 (kd-tree-fold-right* f init3 l))) 259 259 )) … … 268 268 (cases kd-tree t 269 269 (KdLeaf (ii pp vv axis) (list t)) 270 (KdNode (l x i r axis ci)270 (KdNode (l x i v r axis ci) 271 271 (append (kd-tree-subtrees l) 272 272 (list t) … … 278 278 (cases kd-tree t 279 279 (KdLeaf (ii pp vv axis) pp) 280 (KdNode (l x i r axis ci) (list x))280 (KdNode (l x i v r axis ci) (list x)) 281 281 )) 282 283 282 284 283 (define (kd-tree-indices t) 285 284 (cases kd-tree t 286 285 (KdLeaf (ii pp vv axis) (cis:elements ii)) 287 (KdNode (l x i r axis ci) (list i)) 286 (KdNode (l x i v r axis ci) (list i)) 287 )) 288 289 (define (kd-tree-values t) 290 (cases kd-tree t 291 (KdLeaf (ii pp vv axis) vv) 292 (KdNode (l x i v r axis ci) (list v)) 288 293 )) 289 294 … … 293 298 (KdNode (l x i r axis ci) (cis:cardinal ci)))) 294 299 295 (define (kd-tree-min t)300 (define (kd-tree-min-index t) 296 301 (cases kd-tree t 297 302 (KdLeaf (ii pp vv axis) (cis:get-min ii)) 298 303 (KdNode (l x i r axis ci) (cis:get-min ci)))) 299 304 300 (define (kd-tree-max t) 301 302 (cases kd-tree t 303 (KdLeaf (ii pp vv axis) 304 (cis:get-max ii)) 305 (KdNode (l x i r axis ci) 306 (cis:get-max ci)))) 305 (define (kd-tree-max-index t) 306 (cases kd-tree t 307 (KdLeaf (ii pp vv axis) (cis:get-max ii)) 308 (KdNode (l x i r axis ci) (cis:get-max ci)))) 307 309 308 310 … … 367 369 (KdNode (list->kd-tree/depth m (+ m median-index) lt depth1 368 370 leaf-factor: leaf-factor) 369 p v371 p i v 370 372 (list->kd-tree/depth (+ m median-index 1) n gte depth1 371 373 leaf-factor: leaf-factor) … … 376 378 list->kd-tree/depth 377 379 ))) 378 379 #|380 (include "axial-vectors.scm")381 382 ;; construct a kd-tree from f64vectors with point coordinates383 ;; the points argument must be a list of f64vector for each axis:384 ;;385 ;; ( F64VECTOR-X F64VECTOR-Y F64VECTOR-Z ... )386 ;;387 388 (define=> (make-f64vector->kd-tree/depth <Point>)389 390 (lambda (dimensions make-point make-value)391 392 (letrec (393 394 (f64vector->kd-tree/depth395 396 (lambda (m n axial-vectors depth #!key (leaf-factor 10) (offset 0))397 398 (cond399 ((> m n) (KdLeaf cis:empty '() '() depth))400 401 ((<= (- n m) leaf-factor)402 (let ((k (- n m)))403 404 (if (zero? k)405 406 (let ((elt (axial-vectors-ref axial-vectors m))407 (axis (modulo depth dimensions)))408 (let* ((ii (cis:shift offset (cis:singleton m)))409 (es (cis:elements ii))410 (ps (list (make-point elt)))411 (vs (and make-value (map (lambda (i v) (make-value i v)) es ps))))412 413 (KdLeaf ii ps vs axis)))414 415 (let* ((sl (axial-vectors-slice axial-vectors m n))416 (axis (modulo depth dimensions))417 (elt< (lambda (p0 p1)418 (compare-coord axis (make-point p0) (make-point p1)))))419 420 (axial-vectors-quick-sort! sl elt<)421 422 (let* ((ii (cis:shift offset (cis:interval m n)))423 (es (reverse (cis:elements ii)))424 (ps (map (compose make-point (lambda (i) (axial-vectors-ref sl (- i m)))) es))425 (vs (and make-value (map (lambda (i v) (make-value i v)) es ps)))426 )427 428 (KdLeaf ii ps vs axis)429 )))430 ))431 432 ((= m n)433 434 (let* ((e (axial-vectors-ref axial-vectors m))435 (ps (list (make-point e)) )436 (vs (list (and make-value (make-value m e)) m))437 )438 439 (KdLeaf (cis:shift offset (cis:singleton m))440 ps441 vs442 (modulo depth (dimension (car ps))))443 ))444 445 (else446 (let* ((axis (modulo depth dimensions))447 (elt< (lambda (p0 p1)448 (compare-coord axis (make-point p0) (make-point p1)))))449 450 (axial-vectors-quick-sort! axial-vectors elt< m (+ 1 n))451 452 (let* ((depth1 (+ 1 depth))453 (median-index (+ m (quotient (- n m) 2)))454 (median (axial-vectors-ref axial-vectors median-index))455 (p (make-point median))456 (i (+ offset median-index))457 (v (or (and make-value (list i (make-value i median))) i)))458 459 (KdNode (f64vector->kd-tree/depth460 m (- median-index 1) axial-vectors depth1461 leaf-factor: leaf-factor)462 p v463 (f64vector->kd-tree/depth464 (+ median-index 1) n axial-vectors depth1465 leaf-factor: leaf-factor)466 axis (+ 1 (- n m))))467 ))468 )))469 )470 f64vector->kd-tree/depth471 )))472 |#473 380 474 381 ;; Returns the nearest neighbor of p in tree t. … … 503 410 (minimum-by pp (lambda (a b) (negative? (compare-distance probe a b))))) 504 411 505 (KdNode (l p i r axis ci)412 (KdNode (l p i v r axis ci) 506 413 (if (and (tree-empty? l) 507 414 (tree-empty? r)) p … … 560 467 (and v (reverse v)))) 561 468 562 (KdNode (l p i r axis ci)469 (KdNode (l p i v r axis ci) 563 470 564 471 (if (and (tree-empty? l) … … 590 497 (filter (lambda (p) (<= (fdist probe p) r2)) pp))) 591 498 592 (KdNode (l p i r axis ci)499 (KdNode (l p i v r axis ci) 593 500 (let ((maybe-pivot 594 501 (if (<= (fdist probe p) (* radius radius)) (list p) '()))) … … 637 544 638 545 639 (KdNode (l p i r axis ci)546 (KdNode (l p i v r axis ci) 640 547 (let ((maybe-pivot 641 548 (if (<= (fdist probe p) (* radius radius)) … … 740 647 )) 741 648 742 (KdNode (l p i r axis ci)649 (KdNode (l p i v r axis ci) 743 650 744 651 ;(fprintf (current-error-port) "kd-tree-remove: p = ~A~%" p) … … 766 673 (cis:singleton i)) 767 674 ((kd-tree-empty? ll) 768 (kd-tree-min rr))675 (kd-tree-min-index rr)) 769 676 (else 770 (kd-tree-min ll))))677 (kd-tree-min-index ll)))) 771 678 (max1 (cond ((and (kd-tree-empty? ll) 772 679 (kd-tree-empty? rr)) 773 680 (cis:empty)) 774 681 ((kd-tree-empty? rr) 775 (kd-tree-max ll))682 (kd-tree-max-index ll)) 776 683 (else 777 (kd-tree-max rr))))684 (kd-tree-max-index rr)))) 778 685 ) 779 686 780 (KdNode ll p i rr axis687 (KdNode ll p i v rr axis 781 688 (cis:add (if (integer? i) i (car i)) 782 689 (cis:interval min1 max1))) … … 794 701 (cis:singleton i)) 795 702 ((kd-tree-empty? ll) 796 (kd-tree-min rr))703 (kd-tree-min-index rr)) 797 704 (else 798 (kd-tree-min ll))))705 (kd-tree-min-index ll)))) 799 706 (max1 (cond ((and (kd-tree-empty? ll) 800 707 (kd-tree-empty? rr)) 801 708 (cis:empty)) 802 709 ((kd-tree-empty? rr) 803 (kd-tree-max ll))710 (kd-tree-max-index ll)) 804 711 (else 805 (kd-tree-max rr))))712 (kd-tree-max-index rr)))) 806 713 ) 807 (KdNode ll p i rr axis714 (KdNode ll p i v rr axis 808 715 (cis:add (if (integer? i) i (car i)) 809 716 (cis:interval min1 max1))) … … 826 733 (KdLeaf (ii pp vv axis) #t) 827 734 828 (KdNode (l p i r axis ci)735 (KdNode (l p i v r axis ci) 829 736 (let ((x (coord axis p))) 830 737 (and (every (lambda (y) (<= (coord axis y) x )) … … 855 762 856 763 857 (KdNode (l p i r axis ci)764 (KdNode (l p i v r axis ci) 858 765 (if (= axis x-axis) 859 766 … … 889 796 pts)) 890 797 891 (KdNode (l p i r axis ci)798 (KdNode (l p i v r axis ci) 892 799 (if (= axis x-axis) 893 800
Note: See TracChangeset
for help on using the changeset viewer.