source: project/release/5/geo-utils/trunk/tests/geo-utils-test.scm @ 36728

Last change on this file since 36728 was 36728, checked in by kon, 9 months ago

add cr

File size: 4.4 KB
Line 
1;;;; geo-utils-test.scm  -*- Scheme -*-
2;;;; Kon Lovett, Jul '18
3;;;; Kon Lovett, May '17
4
5(import test)
6
7(test-begin "Geo Utils")
8
9;;;
10
11(import (chicken flonum))
12
13;;; FP Utils
14
15;;
16
17(: fp~= (float float #!optional float --> boolean))
18;
19(define (fp~= x y #!optional (eps flonum-epsilon))
20  (let (
21    (diff (fp- x y)) )
22    (or
23      ;(fpzero? diff) ;really, how often is this true?
24      (fp<= (fpabs diff) eps) ) ) )
25
26;;;
27
28(import geo-utils)
29
30(define lat1 33.54187)
31(define lon1 -117.78392)
32
33(define lat2 33.54444)
34(define lon2 -117.78521)
35
36;33.54444 -117.78124 33.54692 -117.78438
37
38(test-group "geo-utils"
39  (let (
40    (dis (great-circle-distance lat1 lon1 lat2 lon2) )
41    (azi (great-circle-azimuth lat1 lon1 lat2 lon2) )
42    (dea (approximate-ellipsoid-distance lat1 lon1 lat2 lon2) )
43    (sds (spherical-surface-distance lat1 lon1 lat2 lon2) ) )
44    ;
45    (print "great-circle-distance: " dis)
46    (print "   spherical-distance: " sds)
47    (print "   ellipsoid-distance: " dea)
48    (print "              azimuth: " azi)
49    (receive (lat lon) (great-circle-position lat1 lon1 dis azi)
50      (print "        geopoint test: " lat ", " lon)
51      (print "        geopoint base: " lat2 ", " lon2)
52      (test-assert (fp~= lat2 lat 0.009))
53      (test-assert (fp~= lon2 lon 0.009)) ) )
54)
55
56;;
57
58(import geo-dms)
59
60(test-group "geo-dms"
61  (test "W 10° 20' 30\"" (dms->string -10 20 30 #f #t " "))
62  (test "E 10° 20' 30\"" (dms->string 10 20 30 #f #t " "))
63  (test "S 10° 20' 30\"" (dms->string -10 20 30 #t #t " "))
64  (test "N 10° 20' 30\"" (dms->string 10 20 30 #t #t " "))
65
66  (test -10.3416666666667 (string-dms->degree "W 10° 20' 30\"" #f))
67  (test -10.3416666666667 (string-dms->degree "10° 20' 30\" W" #f))
68  (test -10.3416666666667 (string-dms->degree "W10° 20'30\"" #t))
69
70  (test 'N (degree->compass-rose 10.3416666666667))
71  (test 'E (degree->compass-rose 100.3416666666667))
72)
73
74;;
75
76(import geopoint)
77
78(test-group "geopoint"
79  (test-assert (geopoint? (make-geopoint lat1 lon1)))
80  (let (
81    (gp1 (make-geopoint lat1 lon1) )
82    (gp2 (make-geopoint lat2 lon2) ) )
83    ;
84    (test lat1 (geopoint-latitude gp1))
85    (test lon1 (geopoint-longitude gp1))
86    ;
87    (test-assert (not (geopoint-left? gp1 gp2)))
88    (test-assert (geopoint-right? gp1 gp2))
89    (test-assert (geopoint-above? gp1 gp2))
90    (test-assert (not (geopoint-below? gp1 gp2))) )
91)
92
93;;
94
95(import geopolygon)
96(import geopoint-utils)
97
98(test-group "geopolygon"
99  (let (
100    (gpy1
101      (make-geopolygon
102        (make-geopoint 37.8731 -122.3201)
103        (make-geopoint 37.8827 -122.2705)
104        (make-geopoint 37.8817 -122.2535)
105        (make-geopoint 37.8617 -122.2413)
106        (make-geopoint 37.8429 -122.2431)
107        (make-geopoint 37.8350 -122.3175)) ) )
108    ;
109    (test-assert (geopolygon? gpy1))
110    (test-assert (geopoint-in-closed-polygon? (make-geopoint 37.8429 -122.2431) gpy1))
111    (test-assert (not (geopoint-in-closed-polygon? (make-geopoint -37.8429 122.2431) gpy1))) )
112)
113
114;;
115
116(import geobox)
117
118(test-group "geobox"
119  (let (
120    (gp1 (make-geopoint lat1 lon2) )
121    (gp2 (make-geopoint lat2 lon1) ) )
122    ;
123    (test-assert (geobox? (make-geobox gp1 gp2)))
124    (let (
125      (gb1 (make-geobox gp1 gp2) ) )
126      ;
127      (test gp1 (geobox-minimum gb1))
128      (test gp2 (geobox-maximum gb1))
129      ;
130      (let ((gpy1 (geopolygon gp2 gp1)))
131        (test-assert (geopolygon? gpy1))
132        (test-assert (geobox= gb1 (geopolygon-bounding-box gpy1))) ) ) )
133)
134
135;;
136
137(import (prefix geo-globe globe:) geo-earth)
138
139(test-group "geo-globe"
140  (let (
141    (dis (great-circle-distance lat1 lon1 lat2 lon2) )
142    (azi (great-circle-azimuth lat1 lon1 lat2 lon2) )
143    ;
144    (earth (make-earth) )
145    (gp1 (make-geopoint lat1 lon1) )
146    (gp2 (make-geopoint lat2 lon2) ) )
147    ;
148    (test dis (globe:great-circle-distance earth gp1 gp2))
149    (test azi (globe:great-circle-azimuth gp1 gp2))
150    (test
151      (approximate-ellipsoid-distance lat1 lon1 lat2 lon2)
152      (globe:approximate-ellipsoid-distance earth gp1 gp2))
153    (test
154      (spherical-surface-distance lat1 lon1 lat2 lon2)
155      (globe:spherical-surface-distance earth gp1 gp2))
156    (let-values (((ulat ulon) (great-circle-position lat1 lon1 dis azi)))
157      (let ((pos (globe:great-circle-position earth gp1 dis azi)))
158        (test "great-circle-position latitude" ulat (geopoint-latitude pos))
159        (test "great-circle-position longitude" ulon (geopoint-longitude pos)) ) ) )
160)
161
162;;;
163
164(test-end "Geo Utils")
165
166(test-exit)
Note: See TracBrowser for help on using the repository browser.