Changeset 38018 in project


Ignore:
Timestamp:
12/14/19 05:28:30 (4 months ago)
Author:
Kon Lovett
Message:

rm fx/fp & use types

Location:
release/5/geo-utils/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/5/geo-utils/trunk/geo-dms.scm

    r36728 r38018  
    2424  (chicken base)
    2525  (chicken irregex)
     26  (chicken type)
    2627  (chicken fixnum)
    2728  (chicken flonum)
    28   (chicken type)
    2929  (only mathh modf)
    3030  ;moremacros
     
    131131;
    132132(define (dms->string d m s #!optional lat? leading-dir? (pad ""))
    133   (if (and (fx= d 0) (fx= m 0) (fx= s 0))
     133  (if (and (= d 0) (= m 0) (= s 0))
    134134    ;so 0
    135135    (dms0 pad)
    136136    ;construct DMS N/S/E/W
    137137    (let* (
    138       (neg? (fx< d 0))
     138      (neg? (< d 0))
    139139      (d (if neg? (fxneg d) d))
    140140      (str (dms->string* d m s pad))
     
    191191(define (dms->degree d m s)
    192192  (let* (
    193     (neg? (fx< d 0))
     193    (neg? (< d 0))
    194194    (d (if neg? (fxneg d) d))
    195195    (deg
    196       (fp+
     196      (+
    197197        (exact->inexact d)
    198         (fp+
    199           (fp/ (exact->inexact m) 60.0)
    200           (fp/ (exact->inexact s) 3600.0)))) )
     198        (+
     199          (/ (exact->inexact m) 60.0)
     200          (/ (exact->inexact s) 3600.0)))) )
    201201    (if neg? (fpneg deg) deg) ) )
    202202
     
    207207  (let* (
    208208    (deg (exact->inexact deg))
    209     (neg? (fp< deg 0.0)) )
     209    (neg? (< deg 0.0)) )
    210210    ;
    211211    (let*-values (
    212       ((sint sflt) (modf (fpabs deg)))
    213       ((dint dflt) (modf (fp* sflt 60.0)))
    214       ((mint mflt) (modf (fp* dflt 60.0))) )
     212      ((sint sflt) (modf (abs deg)))
     213      ((dint dflt) (modf (* sflt 60.0)))
     214      ((mint mflt) (modf (* dflt 60.0))) )
    215215      ;
    216216      (let (
    217217        (ideg (inexact->exact dint))
    218         (isec (inexact->exact (fpround (fp+ sint (fp* mflt 60.0)))))
     218        (isec (inexact->exact (round (+ sint (* mflt 60.0)))))
    219219        (imin (inexact->exact mint)) )
    220220        ;
     
    260260  ;
    261261  (define (compass-rose-slice deg)
    262     (inexact->exact (fpfloor (fp/ (fp+ (exact->inexact deg) +rose-slice/2+) +rose-slice+))) )
     262    (inexact->exact (floor (/ (+ (exact->inexact deg) +rose-slice/2+) +rose-slice+))) )
    263263  ;
    264264  (set! set-compass-rose! (lambda (vec)
    265265    (set! +rose+ (check-vector 'set-compass-rose! vec))
    266266    (set! +rose-count+ (vector-length +rose+))
    267     (set! +rose-slice+ (fp/ 360.0 (exact->inexact +rose-count+)))
    268     (set! +rose-slice/2+ (fp/ +rose-slice+ 2.0)) ) )
     267    (set! +rose-slice+ (/ 360.0 (exact->inexact +rose-count+)))
     268    (set! +rose-slice/2+ (/ +rose-slice+ 2.0)) ) )
    269269  ;
    270270  (set! degree->compass-rose (lambda (deg)
  • release/5/geo-utils/trunk/geo-utils.scm

    r36188 r38018  
    2020(import scheme
    2121  (chicken base)
    22   (chicken fixnum)
     22  (chicken type)
    2323  (chicken flonum)
    24   (chicken type)
    25   ;fp-utils
     24  ;g-utils
    2625  geopoint)
    2726
     
    3029;;
    3130
    32 (: fpsqr (float --> float))
    33 ;
    34 (define-inline (fpsqr n)
    35   (fp* n n) )
     31(: sqr (float --> float))
     32;
     33(define (sqr n) (* n n))
    3634
    3735;;
     
    3937(define-constant DEGREE 0.0174532925199432957692369076848861271344) ;pi/180
    4038
    41 (: fpdegree->radian (float --> float))
    42 ;
    43 (define-inline (fpdegree->radian deg)
    44   (fp* deg DEGREE) )
    45 
    46 (: fpradian->degree (float --> float))
    47 ;
    48 (define-inline (fpradian->degree rad)
    49   (fp/ rad DEGREE) )
    50 
    51 ;;
    52 
    53 (: fpprecision-factor ((or float fixnum) #!optional float --> float))
    54 ;
    55 (define-inline (fpprecision-factor p #!optional (base 10.0))
    56   (fpexpt base (exact->inexact p)) )
     39(: degree->radian (float --> float))
     40;
     41(define (degree->radian deg)
     42  (* deg DEGREE) )
     43
     44(: radian->degree (float --> float))
     45;
     46(define (radian->degree rad)
     47  (/ rad DEGREE) )
     48
     49;;
     50
     51(: precision-factor ((or float fixnum) #!optional float --> float))
     52;
     53(define (precision-factor p #!optional (base 10.0))
     54  (expt base (exact->inexact p)) )
    5755
    5856;;;
     
    8280  ;haversine formula : https://en.wikipedia.org/wiki/Haversine_formula
    8381  (let (
    84     (dlat (fpdegree->radian (fpabs (fp- lat2 lat1))))
    85     (dlon (fpdegree->radian (fpabs (fp- lon2 lon1))))
    86     (lat1 (fpdegree->radian lat1))
    87     (lat2 (fpdegree->radian lat2)) )
     82    (dlat (degree->radian (abs (- lat2 lat1))))
     83    (dlon (degree->radian (abs (- lon2 lon1))))
     84    (lat1 (degree->radian lat1))
     85    (lat2 (degree->radian lat2)) )
    8886    (let* (
    8987      (a
    90         (fp+
    91           (fpsqr (fpsin (fp/ dlon 2.0)))
    92           (fp*
    93             (fp* (fpcos lat1) (fpcos lat2))
    94             (fpsqr (fpsin (fp/ dlat 2.0))))))
     88        (+
     89          (sqr (sin (/ dlon 2.0)))
     90          (*
     91            (* (cos lat1) (cos lat2))
     92            (sqr (sin (/ dlat 2.0))))))
    9593      (c
    96         (fp* 2.0 (fpasin (fpmin 1.0 (fpsqrt a))))) )
    97       (fp* c R) ) ) )
     94        (* 2.0 (asin (min 1.0 (sqrt a))))) )
     95      (* c R) ) ) )
    9896
    9997;;
     
    103101(define (great-circle-distance lat1 lon1 lat2 lon2 #!optional (R EARTH-RADIUS-KILOMETERS))
    104102  (let (
    105     (lat1 (fpdegree->radian lat1))
    106     (lon1 (fpdegree->radian lon1))
    107     (lat2 (fpdegree->radian lat2))
    108     (lon2 (fpdegree->radian lon2)) )
     103    (lat1 (degree->radian lat1))
     104    (lon1 (degree->radian lon1))
     105    (lat2 (degree->radian lat2))
     106    (lon2 (degree->radian lon2)) )
    109107    (great-circle-distance-radians lat1 lon1 lat2 lon2 R) ) )
    110108
     
    115113  (let (
    116114    (d
    117       (fp+
    118         (fp* (fpsin lat1) (fpsin lat2))
    119         (fp*
    120           (fp* (fpcos lat1) (fpcos lat2))
    121           (fpcos (fp- lon1 lon2)))) ) )
    122     (fp* (fpacos d) R) ) )
     115      (+
     116        (* (sin lat1) (sin lat2))
     117        (*
     118          (* (cos lat1) (cos lat2))
     119          (cos (- lon1 lon2)))) ) )
     120    (* (acos d) R) ) )
    123121
    124122#| ;???
    125123  (atan2
    126     (fp/
    127       (sqrt ((sqr (cos lat2)) + (sqr ((cos lat1) • ((sin lon2) - (sin lon1)) • (cos (fpabs (lon2 - lon1)))))
     124    (/
     125      (sqrt ((sqr (cos lat2)) + (sqr ((cos lat1) • ((sin lon2) - (sin lon1)) • (cos (abs (lon2 - lon1)))))
    128126|#
    129127
     
    145143          (F EARTH-FLATTENING))
    146144  (let (
    147     (lat1 (fpdegree->radian lat1) )
    148     (lon1 (fpdegree->radian lon1))
    149     (lat2 (fpdegree->radian lat2))
    150     (lon2 (fpdegree->radian lon2)) )
     145    (lat1 (degree->radian lat1) )
     146    (lon1 (degree->radian lon1))
     147    (lat2 (degree->radian lat2))
     148    (lon2 (degree->radian lon2)) )
    151149    (let (
    152       (f (fp/ (fp+ lat1 lat2) 2.0))
    153       (g (fp/ (fp- lat1 lat2) 2.0))
    154       (l (fp/ (fp- lon1 lon2) 2.0)) )
     150      (f (/ (+ lat1 lat2) 2.0))
     151      (g (/ (- lat1 lat2) 2.0))
     152      (l (/ (- lon1 lon2) 2.0)) )
    155153      (let (
    156         (sing (fpsin g))
    157         (cosl (fpcos l))
    158         (cosf (fpcos f))
    159         (sinl (fpsin l))
    160         (sinf (fpsin f))
    161         (cosg (fpcos g)) )
     154        (sing (sin g))
     155        (cosl (cos l))
     156        (cosf (cos f))
     157        (sinl (sin l))
     158        (sinf (sin f))
     159        (cosg (cos g)) )
    162160        (let (
    163           (sing2 (fpsqr sing))
    164           (cosf2 (fpsqr cosf))
    165           (cosg2 (fpsqr cosg))
    166           (sinf2 (fpsqr sinf)) )
     161          (sing2 (sqr sing))
     162          (cosf2 (sqr cosf))
     163          (cosg2 (sqr cosg))
     164          (sinf2 (sqr sinf)) )
    167165          (let* (
    168166            (s
    169               (fp+
    170                 (fp* sing2 (fpsqr cosl))
    171                 (fp* cosf2 (fpsqr sinl))))
     167              (+
     168                (* sing2 (sqr cosl))
     169                (* cosf2 (sqr sinl))))
    172170            (c
    173               (fp+
    174                 (fp* cosg2 (fpsqr cosl))
    175                 (fp* sinf2 (fpsqr sinl))))
     171              (+
     172                (* cosg2 (sqr cosl))
     173                (* sinf2 (sqr sinl))))
    176174            (w
    177               (fpatan2 (fpsqrt s) (fpsqrt c)))
     175              (fpatan2 (sqrt s) (sqrt c)))
    178176            (r
    179               (fpsqrt (fp/ (fp* s c) w)))
     177              (sqrt (/ (* s c) w)))
    180178            (h1
    181               (fp/ (fp* 3.0 (fp- r 1.0)) (fp* 2.0 c)))
     179              (/ (* 3.0 (- r 1.0)) (* 2.0 c)))
    182180            (h2
    183               (fp/ (fp* 3.0 (fp+ r 1.0)) (fp* 2.0 s)))
     181              (/ (* 3.0 (+ r 1.0)) (* 2.0 s)))
    184182            (d
    185               (fp* 2.0 (fp* w R))) )
    186             (fp*
     183              (* 2.0 (* w R))) )
     184            (*
    187185              d
    188               (fp+
     186              (+
    189187                1.0
    190                 (fp-
    191                   (fp*
    192                     (fp* h1 F)
    193                     (fp* sinf2 cosg2))
    194                   (fp*
    195                     (fp* h2 F)
    196                     (fp* cosf2 sing2))))) ) ) ) ) ) )
     188                (-
     189                  (*
     190                    (* h1 F)
     191                    (* sinf2 cosg2))
     192                  (*
     193                    (* h2 F)
     194                    (* cosf2 sing2))))) ) ) ) ) ) )
    197195
    198196;;
     
    203201  ;
    204202  (define precfact
    205     (fp* 360.0 (fpprecision-factor prec)) )
     203    (* 360.0 (precision-factor prec)) )
    206204  ;
    207205  (define (clamp n)
    208     (inexact->exact (fpround (fp* n precfact))) )
     206    (inexact->exact (round (* n precfact))) )
    209207  ;
    210208  (let (
     
    214212    (ilon2 (clamp lon2)) )
    215213    (cond
    216       ((fx= ilon1 ilon2)
     214      ((= ilon1 ilon2)
    217215        ; going up?
    218         (if (fx> ilat1 ilat2)
     216        (if (> ilat1 ilat2)
    219217          180.0
    220218          ; going down or nowhere
     
    222220      (else
    223221        (let (
    224           (lat1 (fpdegree->radian lat1))
    225           (lon1 (fpdegree->radian lon1))
    226           (lat2 (fpdegree->radian lat2))
    227           (lon2 (fpdegree->radian lon2)) )
     222          (lat1 (degree->radian lat1))
     223          (lon1 (degree->radian lon1))
     224          (lat2 (degree->radian lat2))
     225          (lon2 (degree->radian lon2)) )
    228226          (let* (
    229227            (c
    230228              (great-circle-distance-radians lat1 lon1 lat2 lon2))
    231229            (a
    232               (fpasin
    233                 (fp/
    234                   (fp* (fpcos lat2) (fpsin (fp- lon2 lon1)))
    235                   (fpsin c))))
     230              (asin
     231                (/
     232                  (* (cos lat2) (sin (- lon2 lon1)))
     233                  (sin c))))
    236234            (r
    237               (fpradian->degree a)) )
     235              (radian->degree a)) )
    238236            (cond
    239               ((fx> ilat2 ilat1)
     237              ((> ilat2 ilat1)
    240238                (cond
    241239                  #; ;see else
    242                   ((fx> ilon2 ilon1)
     240                  ((> ilon2 ilon1)
    243241                    r )
    244                   ((fx< ilon2 ilon1)
    245                     (fp+ r 360.0) )
     242                  ((< ilon2 ilon1)
     243                    (+ r 360.0) )
    246244                  (else
    247245                    r ) ) )
    248               ((fx< ilat2 ilat1)
     246              ((< ilat2 ilat1)
    249247                (cond
    250                   ((fx< ilon2 ilon1)
    251                     (fp- 180.0 r) )
    252                   ((fx> ilon2 ilon1)
    253                     (fp- 180.0 r) )
     248                  ((< ilon2 ilon1)
     249                    (- 180.0 r) )
     250                  ((> ilon2 ilon1)
     251                    (- 180.0 r) )
    254252                  (else
    255253                    r ) ) )
     
    263261(define (great-circle-position lat lon dis azi #!optional (R EARTH-RADIUS-KILOMETERS))
    264262  (let (
    265     (dlat (fpdegree->radian (fp- 90.0 lat)))
    266     (lat (fpdegree->radian lat))
    267     (lon (fpdegree->radian lon))
    268     (azi (fpdegree->radian azi)) )
     263    (dlat (degree->radian (- 90.0 lat)))
     264    (lat (degree->radian lat))
     265    (lon (degree->radian lon))
     266    (azi (degree->radian azi)) )
    269267    (let* (
    270268      (b
    271         (fp/ dis R))
     269        (/ dis R))
    272270      (sinb
    273         (fpsin b))
     271        (sin b))
    274272      (a
    275         (fpacos
    276           (fp+
    277             (fp* (fpcos b) (fpcos dlat))
    278             (fp* sinb (fp* (fpsin dlat) (fpcos azi))))))
     273        (acos
     274          (+
     275            (* (cos b) (cos dlat))
     276            (* sinb (* (sin dlat) (cos azi))))))
    279277      (b
    280         (fpasin (fp/ (fp* sinb (fpsin azi)) (fpsin a)))) )
     278        (asin (/ (* sinb (sin azi)) (sin a)))) )
    281279      ;
    282       (values (fp- 90.0 (fpradian->degree a)) (fpradian->degree (fp+ b lon))) ) ) )
     280      (values (- 90.0 (radian->degree a)) (radian->degree (+ b lon))) ) ) )
    283281
    284282) ;geo-utils
  • release/5/geo-utils/trunk/geopolygon.scm

    r36188 r38018  
    1515(import scheme
    1616  (chicken base)
    17   (chicken fixnum)
    1817  (chicken type)
    1918  vector-lib
     
    7675    ;
    7776          (and
    78             (fx<= 2 len)
    79             (geopoint= (vector-ref gpoly 0) (vector-ref gpoly (fx- len 1))) ) ) )
     77            (<= 2 len)
     78            (geopoint= (vector-ref gpoly 0) (vector-ref gpoly (- len 1))) ) ) )
    8079
    8180; explicitly open means [0] != [n-1]
     
    9594    (let loop ((i 0) (minLat 90.0) (maxLat -90.0) (minLon 180.0) (maxLon -180.0))
    9695      ;traced polygon?
    97       (if (fx= i len)
     96      (if (= i len)
    9897        ;then report
    9998        (make-geobox minLat minLon maxLat maxLon)
     
    103102          (lat (geopoint-latitude pnt))
    104103          (lon (geopoint-longitude pnt)) )
    105           (loop (fx+ i 1) (min lat minLat) (max lat maxLat) (min lon minLon) (max lon maxLon)) ) ) ) ) )
     104          (loop (+ i 1) (min lat minLat) (max lat maxLat) (min lon minLon) (max lon maxLon)) ) ) ) ) )
    106105
    107106) ;geopolygon
Note: See TracChangeset for help on using the changeset viewer.