source: project/release/4/spatial-trees/trunk/tests/run.scm @ 27033

Last change on this file since 27033 was 27033, checked in by Ivan Raikov, 9 years ago

spatial-trees: added get-min and get-max operations to kd-tree

File size: 3.6 KB
Line 
1;; Unit tests for kd-tree
2
3
4(use typeclass kd-tree test srfi-1 random-mtzig)
5
6
7
8(define=> (make-consistency-tests <Point> <KdTree>)
9  (lambda (pts t x k r)
10
11    (define (sort-points pts) 
12      (sort pts (lambda (a b) (negative? (compare-distance x a b)))))
13    (define sorted-points (sort-points pts))
14    (define sliced-points (sort-points (filter (lambda (p) (and (<= 0. (coord 0 p)) (<= (coord 0 p) 0.5))) pts)))
15    (define tree-points (sort-points (kd-tree->list t)))
16    (define tree-points-indices (kd-tree->list* t))
17
18    (define nn (car sorted-points))
19
20    (define knn (if (> (length sorted-points) k)
21                    (take sorted-points k) 
22                    sorted-points))
23
24    (define rnn (let ((r2 (* r r)))
25                  (sort-points
26                   (filter
27                    (lambda (y) (<= (dist2 x y) r2))
28                    sorted-points)
29                  )))
30
31#|
32    (define scale-factors '(1.0 0.5 1.0))
33
34    (define (compare-scaled-distance p a b . reltol)
35      (let ((dist2 (sdist2 scale-factors)))
36        (let ((delta (- (dist2 p a) (dist2 p b))))
37          (if (null? reltol)
38              delta
39              (if (<= delta (car reltol)) 0 delta)))))
40
41    (define (sort-scaled-points pts)
42      (sort pts (lambda (a b) (negative? (compare-scaled-distance x a b)))))
43   
44    (define srnn (let ((r2 (* r r))  (dist2 (sdist2 scale-factors)))
45                   (sort-scaled-points
46                    (filter
47                     (lambda (y) (<= (dist2 x y) r2))
48                     (sort-scaled-points sorted-points))
49                    )))
50|#
51   
52    (test-group
53     "KD tree consistency"
54     
55     (test-assert "monotonically increasing indices"
56           (sorted? tree-points-indices (lambda (x y) (< (car x) (car y)))))
57
58     (test-assert "tree-is-valid?"
59           (kd-tree-is-valid? t))
60
61     (test-assert "tree-all-subtrees-are-valid?"
62           (kd-tree-all-subtrees-are-valid? t))
63
64     (test-assert "tree-size"
65           (= (kd-tree-size t) (length pts)))
66
67     (test "kd-tree->list"
68          sorted-points tree-points)
69
70     (test "nearest-neighbor"
71           nn
72           (kd-tree-nearest-neighbor t x))
73
74     (test "nearest-neighbor*"
75           (list (list-index (lambda (x) (equal? (cadr x) nn)) tree-points-indices) nn)
76           (kd-tree-nearest-neighbor* t x))
77
78     (test "k-nearest-neighbors"
79           knn
80           (sort-points (kd-tree-k-nearest-neighbors t k x)))
81     
82     (test "near-neighbors"
83           rnn
84           (sort-points (kd-tree-near-neighbors t r x)))
85
86#|
87     (test "near-neighbors scaled"
88           srnn
89           (sort-scaled-points (kd-tree-near-neighbors t r x factors: scale-factors)))
90|#
91     (test "slice"
92           sliced-points
93           (sort-points (kd-tree-slice 0 0. 0.5 t)))
94     )))
95
96(define consistency-tests/3d (make-consistency-tests Point3d KdTree3d))
97(define consistency-tests/2d (make-consistency-tests Point2d KdTree2d))
98
99
100(define (test1)
101  (let ((n 10000) (k 40) (r 0.2) (randst (random-mtzig:init)))
102 
103  (let recur ((ntrials 10))
104    (let* ((xs (random-mtzig:f64vector-randn! n randst))
105           (ys (random-mtzig:f64vector-randn! n randst))
106           (zs (random-mtzig:f64vector-randn! n randst))
107           (pts (let precur ((i (- n 1)) (ax '()))
108                  (let ((p (make-point (f64vector-ref xs i)
109                                       (f64vector-ref ys i)
110                                       (f64vector-ref zs i))))
111                    (if (positive? i)
112                        (precur (- i 1) (cons p ax))
113                        (cons p ax)))))
114           (t     (with-instance ((<KdTree> KdTree3d)) (list->kd-tree pts leaf-factor: 20)))
115           (dd    (print "tree constructed!"))
116           (xi    (inexact->exact (modulo (random-mtzig:random! randst) n)))
117           (x     (list-ref pts xi))
118           (xx    (with-instance ((<Point> Point3d)) 
119                                 (make-point (+ 0.1 (coord 0 x)) 
120                                             (- (coord 1 x) 0.1) 
121                                             (+ 0.1 (coord 2 x)))))
122           )
123
124      (consistency-tests/3d pts t xx k r)
125;;      (consistency-tests/2d pts t xx k r)
126
127      (if (positive? ntrials)
128          (recur (- ntrials 1)))
129      ))
130  ))
131
132
133
134(test1)
135
Note: See TracBrowser for help on using the repository browser.