File: spatial-tree-test.lisp

package info (click to toggle)
cl-spatial-trees 0.2-4
  • links: PTS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 148 kB
  • ctags: 117
  • sloc: lisp: 1,197; makefile: 30
file content (89 lines) | stat: -rw-r--r-- 3,696 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
;;; Somewhat rudimentary tests of external functionality

(in-package "SPATIAL-TREES-IMPL")

(defvar *kinds* '(:r :greene :r* :x))

(defun make-random-rectangle (&optional (x-bias 0.0) (y-bias 0.0))
  (let* ((lx (+ (random 1.0) x-bias))
         (ly (+ (random 1.0) y-bias))
         (hx (+ (random 1.0) lx))
         (hy (+ (random 1.0) ly)))
    (make-rectangle :lows (list lx ly) :highs (list hx hy))))

(dolist (kind *kinds*)
  (format *trace-output* "~&Random search for kind ~S..." kind)
  (finish-output *trace-output*)
  (let* ((list (loop repeat 1000 collect (make-random-rectangle)))
         (tree (make-spatial-tree kind :rectfun #'identity)))
    (dolist (r list)
      (insert r tree))
    (let* ((r (make-random-rectangle))
           (result (search r tree))
           (expected (remove-if-not (lambda (x) (intersectp x r)) list)))
      (unless (null (set-difference result
                                    expected
                                    :key (lambda (x)
                                           (list (lows x) (highs x)))
                                    :test #'equal))
        (error "aargh: ~S and ~S differ" result expected))))
  (format *trace-output* " passed.~%"))

(dolist (kind *kinds*)
  (format *trace-output* "~&Trisected search for kind ~S..." kind)
  (finish-output *trace-output*)
  (let* ((n 1000)
         (list (loop repeat n collect (make-random-rectangle)
                     collect (make-random-rectangle -2.0 -2.0)
                     collect (make-random-rectangle 2.0 2.0)))
         (tree (make-spatial-tree kind :rectfun #'identity)))
    (dolist (r list)
      (insert r tree))
    (let ((r (make-rectangle :lows '(0.0 0.0) :highs '(1.0 1.0))))
      ;; FIXME: find a way to test the relative speed of the following
      ;; (sbcl-specifically if necessary).
      (search r tree)
      (remove-if-not (lambda (x) (intersectp x r)) list)
      (assert (= (length (search r tree)) n))))
  (format *trace-output* " passed.~%"))

(dolist (kind *kinds*)
  (format *trace-output* "~&Arbitrary object search for kind ~S..." kind)
  (finish-output *trace-output*)
  (let* ((n 100)
         (list (loop repeat n
                     for r = (make-random-rectangle)
                     collect (cons (lows r) (highs r))))
         (rectfun (lambda (x) (make-rectangle :lows (car x) :highs (cdr x))))
         (tree (make-spatial-tree kind :rectfun rectfun)))
    (dolist (r list)
      (insert r tree))
    (let* ((r (make-random-rectangle))
           (result (search r tree))
           (expected (remove-if-not
                      (lambda (x) (intersectp (funcall rectfun x) r))
                      list)))
      (unless (null (set-difference result expected
                                    :key (lambda (x)
                                           (let ((r (funcall rectfun x)))
                                             (list (lows r) (highs r))))
                                    :test #'equal))
        (error "aargh: ~S and ~S differ" result expected))))
  (format *trace-output* " passed.~%"))

(dolist (kind *kinds*)
  (format *trace-output* "~&Deletion test for kind ~S..." kind)
  (finish-output *trace-output*)
  (let* ((n 100)
         (list (loop repeat n collect (make-random-rectangle)))
         (tree (make-spatial-tree kind :rectfun #'identity)))
    (dolist (r list)
      (insert r tree))
    (dolist (r (cdr list))
      (delete r tree))
    (let* ((results (search (car list) tree))
           (length (length results)))
      (unless (= (length results) 1)
        (error "aargh: wrong amount of stuff (~D entries) in ~S"
               length tree))))
  (format *trace-output* " passed.~%"))