Ray-casting algorithm: Difference between revisions
Content added Content deleted
m (Small grammar change.) |
(added racket implementation) |
||
Line 670: | Line 670: | ||
test-point |
test-point |
||
(point-in-polygon test-point polygon)))))</lang> |
(point-in-polygon test-point polygon)))))</lang> |
||
=={{header|Racket}}== |
|||
Straightforward implementation of pseudocode |
|||
<lang lisp> |
|||
#lang racket |
|||
(module pip racket |
|||
(require racket/contract) |
|||
(provide point) |
|||
(provide seg) |
|||
(provide (contract-out [point-in-polygon? (-> |
|||
point? |
|||
list? |
|||
boolean?)])) |
|||
(struct point (x y) #:transparent) |
|||
(struct seg (Ax Ay Bx By)) |
|||
(define ε 0.000001) |
|||
(define (neq? x y) (not (eq? x y))) |
|||
(define (ray-cross-seg? r s) |
|||
(let* ([Ax (seg-Ax s)] [Ay (seg-Ay s)] |
|||
[Bx (seg-Bx s)] [By (seg-By s)] |
|||
[Px (point-x r)] [Pyo (point-y r)] |
|||
[Py (+ Pyo (if (or (eq? Pyo Ay) |
|||
(eq? Pyo By)) |
|||
ε 0))]) |
|||
(cond [(or (< Py Ay) (> Py By)) #f] |
|||
[(> Px (max Ax Bx)) #f] |
|||
[(< Px (min Ax Bx)) #t] |
|||
[else |
|||
(let ([red (if (neq? Ax Px) |
|||
(/ (- By Ay) (- Bx Ax)) |
|||
+inf.0)] |
|||
[blue (if (neq? Ax Px) |
|||
(/ (- Py Ax) (- Px Ax)) |
|||
+inf.0)]) |
|||
(if (>= blue red) #t #f))]))) |
|||
(define (point-in-polygon? point polygon) |
|||
(odd? |
|||
(for/fold ([c 0]) ([seg polygon]) |
|||
(+ c (if (ray-cross-seg? point seg) 1 0)))))) |
|||
(require 'pip) |
|||
(define test-point-list |
|||
(list |
|||
(point 5.0 5.0) |
|||
(point 5.0 8.0) |
|||
(point -10.0 5.0) |
|||
(point 0.0 5.0) |
|||
(point 10.0 5.0) |
|||
(point 8.0 5.0) |
|||
(point 10.0 10.0))) |
|||
(define square |
|||
(list (seg 0.0 0.0 10.0 0.0) |
|||
(seg 10.0 0.0 10.0 10.0) |
|||
(seg 10.0 10.0 0.0 10.0) |
|||
(seg 0.0 0.0 0.0 10.0))) |
|||
(define exagon |
|||
(list (seg 3.0 0.0 7.0 0.0) |
|||
(seg 7.0 0.0 10.0 5.0) |
|||
(seg 10.0 5.0 7.0 10.0) |
|||
(seg 7.0 10.0 3.0 10.0) |
|||
(seg 0.0 5.0 3.0 10.0) |
|||
(seg 3.0 0.0 0.0 5.0))) |
|||
(define (test-figure fig name) |
|||
(printf "\ntesting ~a: \n" name) |
|||
(for ([p test-point-list]) |
|||
(printf "testing ~v: ~a\n" p (point-in-polygon? p fig)))) |
|||
(test-figure square "square") |
|||
(test-figure exagon "exagon") |
|||
</lang> |
|||
Output: |
|||
<lang lisp> |
|||
testing square: |
|||
testing (point 5.0 5.0): #t |
|||
testing (point 5.0 8.0): #t |
|||
testing (point -10.0 5.0): #f |
|||
testing (point 0.0 5.0): #f |
|||
testing (point 10.0 5.0): #t |
|||
testing (point 8.0 5.0): #t |
|||
testing (point 10.0 10.0): #f |
|||
testing exagon: |
|||
testing (point 5.0 5.0): #t |
|||
testing (point 5.0 8.0): #t |
|||
testing (point -10.0 5.0): #f |
|||
testing (point 0.0 5.0): #f |
|||
testing (point 10.0 5.0): #t |
|||
testing (point 8.0 5.0): #t |
|||
testing (point 10.0 10.0): #f |
|||
</lang> |
|||
=={{header|Factor}}== |
=={{header|Factor}}== |