source: project/release/5/geo-utils/trunk/geopoint-utils.scm @ 35995

Last change on this file since 35995 was 35995, checked in by Kon Lovett, 21 months ago

C5 initial

File size: 2.8 KB
Line 
1;;;; geopoint-utils.scm  -*- Scheme -*-
2;;;; Kon Lovett, Jul '18
3;;;; Kon Lovett, Aug '17
4;;;; Kon Lovett, May '17
5
6(module geopoint-utils
7
8(;export
9  geopoint-in-closed-polygon?
10  intersects?-pnp intersects?-pip)
11
12(import scheme
13  (chicken fixnum)
14  (chicken type)
15  geopoint
16  geopolygon
17  type-checks)
18
19;;;
20
21;WTF
22(define-type geopolygon
23  (or (list-of (struct geopoint)) (vector-of (struct geopoint))))
24
25;;
26
27;https://github.com/substack/point-in-polygon
28;(: geopoint-in-closed-polygon? ((struct geopoint) geopolygon #!optional ((struct geopoint) (struct geopoint) number number --> boolean) --> boolean))
29(: geopoint-in-closed-polygon? ((struct geopoint) geopolygon #!optional procedure --> boolean))
30;
31(define (geopoint-in-closed-polygon? gp gpoly #!optional (intersects? intersects?-pnp))
32        ;test for intersection of ray with every segment of the polygon
33        ;start with the "closing" segment, then every [i-i],[i] segment
34        (let ((gpoly (make-geopolygon gpoly)))
35          (check-geopoint 'geopoint-in-closed-polygon? gp)
36    (let (
37      (len (vector-length (check-geopolygon 'geopoint-in-closed-polygon? gpoly)))
38      (lat (geopoint-latitude gp))
39      (lon (geopoint-longitude gp)) )
40      ;assumes an open-poly is "closed" so a closed-poly must be treated as "open"
41      (let ((len (if (geopolygon-closed? gpoly) (fx- len 1) len)))
42        (let loop ((i 0) (j (fx- len 1)) (poly? #f))
43          (if (fx= i len)
44            poly?
45            (let (
46              (new-poly
47                (if (intersects? (vector-ref gpoly i) (vector-ref gpoly j) lat lon)
48                  (not poly?)
49                  poly?)) )
50            (loop (fx+ i 1) i new-poly) ) ) ) ) ) ) )
51
52;;
53
54;; Ray-casting algorithm (http://www.ecse.rpi.edu/Homepages/wrf/Research/Short_Notes/pnpoly.html)
55;; (https://github.com/substack/point-in-polygon)
56(: intersects?-pnp ((struct geopoint) (struct geopoint) number number --> boolean))
57;
58(define (intersects?-pnp pi pj lat lon)
59  (let (
60    (lati (geopoint-latitude pi))
61    (loni (geopoint-longitude pi))
62    (latj (geopoint-latitude pj))
63    (lonj (geopoint-longitude pj)) )
64    (and
65      (not (eq? (> loni lon) (> lonj lon)))
66      (< lat (+ (/ (* (- latj lati) (- lon loni)) (- lonj loni)) lati))) ) )
67
68;; Ray-casting algorithm (http://en.wikipedia.org/wiki/Point_in_polygon)
69;; (http://alienryderflex.com/polygon/)
70(: intersects?-pip ((struct geopoint) (struct geopoint) number number --> boolean))
71;
72(define (intersects?-pip pi pj lat lon)
73  (let (
74    (lati (geopoint-latitude pi))
75    (loni (geopoint-longitude pi))
76    (latj (geopoint-latitude pj))
77    (lonj (geopoint-longitude pj)) )
78    (and
79      (or (and (< lati lat) (<= lat latj ) ) (and (< latj lat) (<= lat lati)))
80      (or (<= loni lon) (<= lonj lon))
81      (< (+ loni (* (/ (- lat lati) (- latj lati)) (- lonj loni))) lon)) ) )
82
83) ;module geopoint-utils
Note: See TracBrowser for help on using the repository browser.