Changeset 27836 in project
 Timestamp:
 11/16/12 07:00:15 (8 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

release/4/kdtree/trunk/kdtree.scm
r27829 r27836 64 64 kdtreemaxindex 65 65 kdtreesize 66 kdtreeindices67 66 ) 68 67 … … 316 315 (cases kdtree t 317 316 (KdLeaf (ii pp vv axis) ii) 318 (KdNode (l x i v r axis ci) (cis:singleton i))317 (KdNode (l x i v r axis ci) ci) 319 318 )) 320 319 … … 340 339 (KdNode (l x i v r axis ci) (cis:getmax ci)))) 341 340 342 343 (define (kdtreeindices t)344 (cases kdtree t345 (KdLeaf (ii pp vv axis) ii)346 (KdNode (l x i v r axis ci)347 (cis:union (cis:singleton i)348 (cis:union (kdtreeindices l)349 (kdtreeindices r))))350 ))351 341 352 342 … … 683 673 )) 684 674 knearestneighbors))) 685 675 676 677 (define (kdeltindex x) (let ((xp (car x))) (if (number? xp) xp (car xp)))) 678 (define (kdeltvalue x) (and (pair? (car x)) (cadar x))) 679 (define (kdeltpoint x) (cadr x)) 686 680 687 681 ;; removes the point p from t. 688 682 (define=> (makekdtreeremove <Point>) 689 (lambda (list>kdtree list>kdtree*) 690 (letrec ((treeremove 691 (lambda (t pkill) 683 (letrec ( 684 ;; a variant of list>kdtree specialized for 685 ;; kdtreeremove. Specifically, it preserves the 686 ;; original point indices. This variant of 687 ;; list>kdtree assumes that the input list of points 688 ;; has the form ( (INDEX POINT VALUE) ... ) 689 690 (split 691 (lambda (points depth) 692 693 ; (fprintf (currenterrorport) "kdtreeremove: split: points = ~A~%" points) 694 695 (let* ((axis (modulo depth (dimension (kdeltpoint (car points))))) 696 (cmpfn (lambda (p0 p1) (comparecoord axis (kdeltpoint p0) (kdeltpoint p1)))) 697 (sorted (sort points cmpfn)) 698 (medianindex (quotient (length sorted) 2)) 699 ) 700 701 (letvalues (((lte gte) (splitat sorted medianindex))) 702 703 (let ((median (kdeltpoint (car gte)))) 704 705 (letvalues (((lt xeq) (span (lambda (x) (< (coord axis (kdeltpoint x)) (coord axis median))) lte))) 706 707 (if (null? xeq) 708 (values (car gte) lt (cdr gte)) 709 (let ((splitindex (length lt))) 710 (values (car xeq) lt (append (cdr xeq) gte)))) 711 )) 712 )) 713 )) 714 715 (list>kdtree/depth 716 (lambda (points depth #!key (leaffactor 50)) 717 718 ; (fprintf (currenterrorport) "kdtreeremove: points = ~A~%" points) 719 720 (cond 721 722 ((null? points) (KdLeaf cis:empty '() '() depth)) 723 724 ((<= (length points) leaffactor) 725 726 (let* ( 727 (ps (map kdeltpoint points)) 728 (ii (fold (lambda (x ax) (cis:add x ax)) cis:empty (map kdeltindex points))) 729 (vs (let ((vs (map kdeltvalue points))) (and (every identity vs) vs))) 730 ) 731 732 (KdLeaf ii ps vs (modulo depth (dimension (car ps)))) 733 ) 734 ) 735 736 ((null? (cdr points)) 737 738 (let* ((ps (map kdeltpoint points)) 739 (ii (fold (lambda (x ax) (cis:add x ax)) cis:empty (map kdeltindex points))) 740 (vs (map kdeltvalue points))) 741 742 (KdLeaf ii ps vs (modulo depth (dimension (car ps)))) 743 ) 744 ) 745 746 (else 747 (letvalues (((median lt gte) 748 (split points depth))) 749 750 (let* ((depth1 (+ 1 depth)) 751 (i (kdeltindex median)) 752 (p (kdeltpoint median)) 753 (v (kdeltvalue median)) 754 (axis (modulo depth (dimension p))) 755 (l (list>kdtree/depth lt depth1 leaffactor: leaffactor)) 756 (r (list>kdtree/depth gte depth1 leaffactor: leaffactor)) 757 ) 758 759 (KdNode l p i v r axis 760 (cis:add i (cis:union (kdtreenodeindices l) (kdtreenodeindices r)))) 761 )) 762 )) 763 )) 764 765 (treeremove 766 (lambda (t pkill #!key (leaffactor 10)) 692 767 693 768 … … 746 821 (KdNode (l p i v r axis ci) 747 822 748 ; (fprintf (currenterrorport) "kdtreeremove (KdNode): p = ~A~%" p) 749 ; (fprintf (currenterrorport) "kdtreeremove (KdNode): pkill = ~A~%" pkill) 750 ; (fprintf (currenterrorport) "kdtreeremove (KdNode): equal? p pkill = ~A~%" (equal? p pkill)) 751 ; (fprintf (currenterrorport) "kdtreeremove (KdNode): coord axis p = ~A~%" (coord axis p)) 752 ; (fprintf (currenterrorport) "kdtreeremove (KdNode): coord axis pkill = ~A~%" (coord axis pkill)) 753 754 (if (equal? p pkill) 755 756 (let ((offset (if (kdtreeempty? l) (+ i 1) (kdtreeminindex l)))) 757 (if v 758 (let ((pts1 (append (kdtree>list* l) (kdtree>list* r)))) 759 (list>kdtree* 0 (length pts1) pts1 axis offset: offset)) 760 (let ((pts1 (append (kdtree>list l) (kdtree>list r)))) 761 (list>kdtree 0 (length pts1) pts1 axis offset: offset)) 762 )) 763 764 765 (if (< (coord axis pkill) (coord axis p)) 823 (cond ((equal? p pkill) 824 (let ((pts1 (append (kdtree>list* l) (kdtree>list* r)))) 825 (list>kdtree/depth pts1 axis leaffactor: leaffactor))) 826 827 (else 828 829 (if (< (coord axis pkill) (coord axis p)) 766 830 767 831 (let* ((l1 (treeremove l pkill)) 768 (l1is (and l1 (kdtree indices l1))))769 770 (and l1771 (KdNode l1 p i v r axis 772 (cis:add i (cis:union l1is (kdtreeindices r)))))832 (l1is (and l1 (kdtreenodeindices l1))) 833 (ris (kdtreenodeindices r)) 834 (ci1 (cis:add i (cis:union l1is ris)))) 835 836 (and l1 (KdNode l1 p i v r axis ci1)) 773 837 ) 774 838 775 839 (let* ((r1 (treeremove r pkill)) 776 (r1is (and r1 (kdtreeindices r1)))) 777 778 (and r1 779 (KdNode l p i v r1 axis 780 (cis:add i (cis:union (kdtreeindices l) r1is)))) 781 )) 840 (r1is (and r1 (kdtreenodeindices r1))) 841 (lis (kdtreenodeindices l)) 842 (ci1 (cis:add i (cis:union r1is lis)))) 843 844 (and r1 (KdNode l p i v r1 axis ci1)) 845 846 ))) 782 847 783 848 )) 784 849 )) 785 850 )) 786 treeremove)) )851 treeremove)) 787 852 788 853 … … 893 958 (makelist>kdtree/depth pointclass)) 894 959 (kdtreeremove 895 ((makekdtreeremove pointclass) 896 (list>kdtree/depth identity #f) 897 (list>kdtree/depth cadr (lambda (i v) (cadar v))))) 960 (makekdtreeremove pointclass) ) 898 961 (kdtreenearestneighbor 899 962 (makekdtreenearestneighbor pointclass)))
Note: See TracChangeset
for help on using the changeset viewer.