Changeset 27050 in project
 Timestamp:
 07/12/12 02:33:49 (9 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

release/4/kdtree/trunk/kdtree.scm
r27040 r27050 21 21 kdtreepoints 22 22 kdtreeindices 23 kdtreemin 24 kdtreemax 23 kdtreeminindex 24 kdtreemaxindex 25 25 kdtreesize 26 26 ) … … 171 171 (KdNode (left kdtree?) 172 172 (p point?) 173 (i (lambda (v) (or (integer? v) (and (pair? v) (integer? (car v)))))) 173 (i positiveorzerointeger?) 174 (v (lambda (v) (or (not v) v))) 174 175 (right kdtree?) 175 176 (axis positiveorzerointeger?) … … 195 196 (define (kdtree>list* t) 196 197 (kdtreefoldright* 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 (kdtreemap f l) 208 208 (f x) 209 i 209 i v 210 210 (kdtreemap f r) 211 211 axis ci)) … … 215 215 (cases kdtree t 216 216 (KdLeaf (ii pp vv axis) (foreach f pp)) 217 (KdNode (l x i r axis ci)217 (KdNode (l x i v r axis ci) 218 218 (begin 219 219 (kdtreeforeach f l) … … 227 227 (cases kdtree t 228 228 (KdLeaf (ii pp vv axis) (foreach 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 (kdtreeforeach* f l) 232 (f i x)232 (f i v x) 233 233 (kdtreeforeach* f r) 234 234 )) … … 240 240 (KdLeaf (ii pp vv axis) 241 241 (foldright f init pp)) 242 (KdNode (l p i r axis ci)242 (KdNode (l p i v r axis ci) 243 243 (let* ((init2 (kdtreefoldright f init r)) 244 244 (init3 (f p init2))) … … 253 253 (foldright f init (zip (reverse (cis:elements ii)) vv) pp) 254 254 (foldright 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 (kdtreefoldright* f init r)) 257 (init3 (f i x init2)))257 (init3 (f i v x init2))) 258 258 (kdtreefoldright* f init3 l))) 259 259 )) … … 268 268 (cases kdtree 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 (kdtreesubtrees l) 272 272 (list t) … … 278 278 (cases kdtree 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 (kdtreeindices t) 285 284 (cases kdtree 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 (kdtreevalues t) 290 (cases kdtree 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 (kdtreemin t)300 (define (kdtreeminindex t) 296 301 (cases kdtree t 297 302 (KdLeaf (ii pp vv axis) (cis:getmin ii)) 298 303 (KdNode (l x i r axis ci) (cis:getmin ci)))) 299 304 300 (define (kdtreemax t) 301 302 (cases kdtree t 303 (KdLeaf (ii pp vv axis) 304 (cis:getmax ii)) 305 (KdNode (l x i r axis ci) 306 (cis:getmax ci)))) 305 (define (kdtreemaxindex t) 306 (cases kdtree t 307 (KdLeaf (ii pp vv axis) (cis:getmax ii)) 308 (KdNode (l x i r axis ci) (cis:getmax ci)))) 307 309 308 310 … … 367 369 (KdNode (list>kdtree/depth m (+ m medianindex) lt depth1 368 370 leaffactor: leaffactor) 369 p v371 p i v 370 372 (list>kdtree/depth (+ m medianindex 1) n gte depth1 371 373 leaffactor: leaffactor) … … 376 378 list>kdtree/depth 377 379 ))) 378 379 #380 (include "axialvectors.scm")381 382 ;; construct a kdtree from f64vectors with point coordinates383 ;; the points argument must be a list of f64vector for each axis:384 ;;385 ;; ( F64VECTORX F64VECTORY F64VECTORZ ... )386 ;;387 388 (define=> (makef64vector>kdtree/depth <Point>)389 390 (lambda (dimensions makepoint makevalue)391 392 (letrec (393 394 (f64vector>kdtree/depth395 396 (lambda (m n axialvectors depth #!key (leaffactor 10) (offset 0))397 398 (cond399 ((> m n) (KdLeaf cis:empty '() '() depth))400 401 ((<= ( n m) leaffactor)402 (let ((k ( n m)))403 404 (if (zero? k)405 406 (let ((elt (axialvectorsref axialvectors m))407 (axis (modulo depth dimensions)))408 (let* ((ii (cis:shift offset (cis:singleton m)))409 (es (cis:elements ii))410 (ps (list (makepoint elt)))411 (vs (and makevalue (map (lambda (i v) (makevalue i v)) es ps))))412 413 (KdLeaf ii ps vs axis)))414 415 (let* ((sl (axialvectorsslice axialvectors m n))416 (axis (modulo depth dimensions))417 (elt< (lambda (p0 p1)418 (comparecoord axis (makepoint p0) (makepoint p1)))))419 420 (axialvectorsquicksort! sl elt<)421 422 (let* ((ii (cis:shift offset (cis:interval m n)))423 (es (reverse (cis:elements ii)))424 (ps (map (compose makepoint (lambda (i) (axialvectorsref sl ( i m)))) es))425 (vs (and makevalue (map (lambda (i v) (makevalue i v)) es ps)))426 )427 428 (KdLeaf ii ps vs axis)429 )))430 ))431 432 ((= m n)433 434 (let* ((e (axialvectorsref axialvectors m))435 (ps (list (makepoint e)) )436 (vs (list (and makevalue (makevalue 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 (comparecoord axis (makepoint p0) (makepoint p1)))))449 450 (axialvectorsquicksort! axialvectors elt< m (+ 1 n))451 452 (let* ((depth1 (+ 1 depth))453 (medianindex (+ m (quotient ( n m) 2)))454 (median (axialvectorsref axialvectors medianindex))455 (p (makepoint median))456 (i (+ offset medianindex))457 (v (or (and makevalue (list i (makevalue i median))) i)))458 459 (KdNode (f64vector>kdtree/depth460 m ( medianindex 1) axialvectors depth1461 leaffactor: leaffactor)462 p v463 (f64vector>kdtree/depth464 (+ medianindex 1) n axialvectors depth1465 leaffactor: leaffactor)466 axis (+ 1 ( n m))))467 ))468 )))469 )470 f64vector>kdtree/depth471 )))472 #473 380 474 381 ;; Returns the nearest neighbor of p in tree t. … … 503 410 (minimumby pp (lambda (a b) (negative? (comparedistance 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 (treeempty? l) 507 414 (treeempty? 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 (treeempty? 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 ((maybepivot 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 ((maybepivot 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 (currenterrorport) "kdtreeremove: p = ~A~%" p) … … 766 673 (cis:singleton i)) 767 674 ((kdtreeempty? ll) 768 (kdtreemin rr))675 (kdtreeminindex rr)) 769 676 (else 770 (kdtreemin ll))))677 (kdtreeminindex ll)))) 771 678 (max1 (cond ((and (kdtreeempty? ll) 772 679 (kdtreeempty? rr)) 773 680 (cis:empty)) 774 681 ((kdtreeempty? rr) 775 (kdtreemax ll))682 (kdtreemaxindex ll)) 776 683 (else 777 (kdtreemax rr))))684 (kdtreemaxindex 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 ((kdtreeempty? ll) 796 (kdtreemin rr))703 (kdtreeminindex rr)) 797 704 (else 798 (kdtreemin ll))))705 (kdtreeminindex ll)))) 799 706 (max1 (cond ((and (kdtreeempty? ll) 800 707 (kdtreeempty? rr)) 801 708 (cis:empty)) 802 709 ((kdtreeempty? rr) 803 (kdtreemax ll))710 (kdtreemaxindex ll)) 804 711 (else 805 (kdtreemax rr))))712 (kdtreemaxindex 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 xaxis) 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 xaxis) 893 800
Note: See TracChangeset
for help on using the changeset viewer.