51 lines
2.2 KiB
Scheme
51 lines
2.2 KiB
Scheme
|
;;; PNPOLY - Test if a point is contained in a 2D polygon.
|
||
|
|
|
||
|
|
(library (r6rs-benchmarks pnpoly)
|
||
|
|
(export main)
|
||
|
|
(import (r6rs) (r6rs arithmetic flonums) (r6rs-benchmarks))
|
||
|
|
|
||
|
|
(define (pt-in-poly2 xp yp x y)
|
||
|
|
(let loop ((c #f) (i (- (vector-length xp) 1)) (j 0))
|
||
|
|
(if (< i 0)
|
||
|
|
c
|
||
|
|
(if (or (and (or (fl>? (vector-ref yp i) y)
|
||
|
|
(fl>=? y (vector-ref yp j)))
|
||
|
|
(or (fl>? (vector-ref yp j) y)
|
||
|
|
(fl>=? y (vector-ref yp i))))
|
||
|
|
(fl>=? x
|
||
|
|
(fl+ (vector-ref xp i)
|
||
|
|
(fl/ (fl*
|
||
|
|
(fl- (vector-ref xp j)
|
||
|
|
(vector-ref xp i))
|
||
|
|
(fl- y (vector-ref yp i)))
|
||
|
|
(fl- (vector-ref yp j)
|
||
|
|
(vector-ref yp i))))))
|
||
|
|
(loop c (- i 1) i)
|
||
|
|
(loop (not c) (- i 1) i)))))
|
||
|
|
|
||
|
|
(define (run)
|
||
|
|
(let ((count 0)
|
||
|
|
(xp (vector 0. 1. 1. 0. 0. 1. -.5 -1. -1. -2. -2.5 -2. -1.5 -.5 1. 1. 0. -.5 -1. -.5))
|
||
|
|
(yp (vector 0. 0. 1. 1. 2. 3. 2. 3. 0. -.5 -1. -1.5 -2. -2. -1.5 -1. -.5 -1. -1. -.5)))
|
||
|
|
(if (pt-in-poly2 xp yp .5 .5) (set! count (+ count 1)))
|
||
|
|
(if (pt-in-poly2 xp yp .5 1.5) (set! count (+ count 1)))
|
||
|
|
(if (pt-in-poly2 xp yp -.5 1.5) (set! count (+ count 1)))
|
||
|
|
(if (pt-in-poly2 xp yp .75 2.25) (set! count (+ count 1)))
|
||
|
|
(if (pt-in-poly2 xp yp 0. 2.01) (set! count (+ count 1)))
|
||
|
|
(if (pt-in-poly2 xp yp -.5 2.5) (set! count (+ count 1)))
|
||
|
|
(if (pt-in-poly2 xp yp -1. -.5) (set! count (+ count 1)))
|
||
|
|
(if (pt-in-poly2 xp yp -1.5 .5) (set! count (+ count 1)))
|
||
|
|
(if (pt-in-poly2 xp yp -2.25 -1.) (set! count (+ count 1)))
|
||
|
|
(if (pt-in-poly2 xp yp .5 -.25) (set! count (+ count 1)))
|
||
|
|
(if (pt-in-poly2 xp yp .5 -1.25) (set! count (+ count 1)))
|
||
|
|
(if (pt-in-poly2 xp yp -.5 -2.5) (set! count (+ count 1)))
|
||
|
|
count))
|
||
|
|
|
||
|
|
(define (main . args)
|
||
|
|
(run-benchmark
|
||
|
|
"pnpoly"
|
||
|
|
pnpoly-iters
|
||
|
|
(lambda (result)
|
||
|
|
(and (number? result) (= result 6)))
|
||
|
|
(lambda () (lambda () (run))))))
|