source: project/release/4/geo-utils/trunk/geopoint-utils.scm @ 34506

Last change on this file since 34506 was 34506, checked in by kon, 6 months ago

add types, ? for preds

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