source: project/release/4/geo-utils/tags/0.3.0/tests/run.scm @ 34507

Last change on this file since 34507 was 34507, checked in by kon, 14 months ago

rel 0.3.0

File size: 2.7 KB
Line 
1;;;; test-geo-utils.scm
2;;;; Kon Lovett, May '17
3;;;; Kon Lovett, Sep '17
4
5(use test)
6
7(use fp-utils)
8
9;;;
10
11(use geo-utils)
12
13(define lat1 33.54187)
14(define lon1 -117.78392)
15
16(define lat2 33.54444)
17(define lon2 -117.78521)
18
19;33.54444 -117.78124 33.54692 -117.78438
20
21(let ((d (great-circle-distance lat1 lon1 lat2 lon2))
22      (a (great-circle-azimuth lat1 lon1 lat2 lon2))
23      (dea (approximate-ellipsoid-distance lat1 lon1 lat2 lon2))
24      (ds (spherical-surface-distance lat1 lon1 lat2 lon2)) )
25  (print "great-circle-distance: " d)
26  (print "   spherical-distance: " ds)
27  (print "   ellipsoid-distance: " dea)
28  (print "              azimuth: "  a)
29  (receive (lat lon) (great-circle-position lat1 lon1 d a)
30    (print "        geopoint test: " lat ", " lon)
31    (print "        geopoint base: " lat2 ", " lon2)
32    (test-assert (fp~= lat2 lat 0.009))
33    (test-assert (fp~= lon2 lon 0.009)) ) )
34
35;;;
36
37(use geo-dms)
38
39(test "W 10° 20' 30\"" (dms->string -10 20 30 #f #t " "))
40(test "E 10° 20' 30\"" (dms->string 10 20 30 #f #t " "))
41(test "S 10° 20' 30\"" (dms->string -10 20 30 #t #t " "))
42(test "N 10° 20' 30\"" (dms->string 10 20 30 #t #t " "))
43
44(test -10.3416666666667 (string-dms->degree "W 10° 20' 30\"" #f))
45(test -10.3416666666667 (string-dms->degree "10° 20' 30\" W" #f))
46(test -10.3416666666667 (string-dms->degree "W10° 20'30\"" #t))
47
48;;;
49
50(use geopoint)
51
52(test-assert (geopoint? (make-geopoint lat1 lon1)))
53(let ((gp1 (make-geopoint lat1 lon1))
54      (gp2 (make-geopoint lat2 lon2)) )
55  (test lat1 (geopoint-latitude gp1))
56  (test lon1 (geopoint-longitude gp1))
57
58  (test-assert (not (geopoint-left? gp1 gp2)))
59  (test-assert (geopoint-right? gp1 gp2))
60  (test-assert (geopoint-above? gp1 gp2))
61  (test-assert (not (geopoint-below? gp1 gp2)))
62)
63
64;;;
65
66(use geobox)
67(use geopolygon)
68(use geopoint-utils)
69
70(let ((gp1 (make-geopoint lat1 lon2))
71      (gp2 (make-geopoint lat2 lon1)) )
72  (test-assert (geobox? (make-geobox gp1 gp2)))
73  (let ((gb1 (make-geobox gp1 gp2)))
74    (test gp1 (geobox-minimum gb1))
75    (test gp2 (geobox-maximum gb1))
76
77    (test-assert (geopolygon? (geopolygon gp2 gp1)))
78    (let ((gpoly1 (geopolygon gp2 gp1)))
79      (test-assert (geobox= gb1 (geopolygon-bounding-box gpoly1)))
80    )
81  )
82)
83
84(let ((geoPoly1
85        (make-geopolygon
86          (make-geopoint 37.8731 -122.3201)
87          (make-geopoint 37.8827 -122.2705)
88          (make-geopoint 37.8817 -122.2535)
89          (make-geopoint 37.8617 -122.2413)
90          (make-geopoint 37.8429 -122.2431)
91          (make-geopoint 37.8350 -122.3175))) )
92
93  (test-assert (geopoint-in-closed-polygon? (make-geopoint 37.8429 -122.2431) geoPoly1))
94  (test-assert (not (geopoint-in-closed-polygon? (make-geopoint -37.8429 122.2431) geoPoly1)))
95)
96
97;;;
98
99(test-exit)
100
Note: See TracBrowser for help on using the repository browser.