tasks a-s

Task/Ray-casting-algorithm/Racket/ray-casting-algorithm-1.rkt

@@ -0,0 +1,75 @@
+#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")

Task/Ray-casting-algorithm/Racket/ray-casting-algorithm-2.rkt

@@ -0,0 +1,17 @@
+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