/usr/share/common-lisp/source/spatial-trees/spatial-tree-test.lisp is in cl-spatial-trees 0.2-6.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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.~%"))
|