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

Last change on this file since 35995 was 35995, checked in by Kon Lovett, 2 years ago

C5 initial

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