Changeset 39387 in project
- Timestamp:
- 11/25/20 20:46:00 (7 weeks ago)
- Location:
- release/5/fp-utils/trunk
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
release/5/fp-utils/trunk/fp-inlines.scm
r38251 r39387 18 18 fplog2 fplog10 19 19 fpdegree->radian fpradian->degree 20 fpprecision-factor )20 fpprecision-factor fpprecision-epsilon) 21 21 22 22 (import scheme) … … 38 38 39 39 (: fpzero? (float --> boolean)) 40 ; 40 (: fppositive? (float --> boolean)) 41 (: fpnatural? (float --> boolean)) 42 (: fpnegative? (float --> boolean)) 43 (: fpnon-positive? (float --> boolean)) 44 (: fpeven? (float --> boolean)) 45 (: fpodd? (float --> boolean)) 46 (: fpclosed-right? (float float float --> boolean)) 47 (: fpclosed? (float float float --> boolean)) 48 (: fpclosed-left? (float float float --> boolean)) 49 (: fpadd1 (float --> float)) 50 (: fpsub1 (float --> float)) 51 (: fplog2 (float --> float)) 52 (: fplog10 (float --> float)) 53 (: fpdegree->radian (float --> float)) 54 (: fpradian->degree (float --> float)) 55 (: fpprecision-factor ((or float fixnum) #!optional float --> float)) 56 (: fpprecision-epsilon ((or float fixnum) #!optional float --> float)) 57 (: fp% (float float --> float)) 58 59 ;; 60 41 61 (define (fpzero? n) (or (fp= 0.0 n) (fp= -0.0 n))) 42 62 43 (: fppositive? (float --> boolean))44 ;45 63 (define (fppositive? n) (fp< 0.0 n)) 46 64 47 (: fpnatural? (float --> boolean))48 ;49 65 (define (fpnatural? n) (fp<= 0.0 n)) 50 66 51 (: fpnegative? (float --> boolean))52 ;53 67 (define (fpnegative? n) (fp> 0.0 n)) 54 68 55 (: fpnon-positive? (float --> boolean))56 ;57 69 (define (fpnon-positive? n) (fp>= 0.0 n)) 58 70 59 71 ;; 60 72 61 (: fpeven? (float --> boolean))62 ;63 73 (define (fpeven? n) (fpinteger? (fp/ n 2.0))) 64 74 65 (: fpodd? (float --> boolean))66 ;67 75 (define (fpodd? n) (not (fpeven? n))) 68 76 69 77 ;; 70 78 71 (: fpclosed-right? (float float float --> boolean))72 ;73 79 (define (fpclosed-right? l x h) (and (fp< l x) (fp<= x h))) 74 80 75 (: fpclosed? (float float float --> boolean))76 ;77 81 (define (fpclosed? l x h) (and (fp<= l x) (fp<= x h))) 78 82 79 (: fpclosed-left? (float float float --> boolean))80 ;81 83 (define (fpclosed-left? l x h) (and (fp<= l x) (fp< x h))) 82 84 … … 87 89 ;; 88 90 89 (: fpadd1 (float --> float))90 ;91 91 (define (fpadd1 n) (fp+ n 1.0)) 92 92 93 (: fpsub1 (float --> float))94 ;95 93 (define (fpsub1 n) (fp- n 1.0)) 96 94 … … 107 105 ;; 108 106 109 (: fplog2 (float --> float))110 ;111 107 (define (fplog2 x) (fp/ (fplog x) 0.6931471805599453094172321214581765680755)) 112 108 113 (: fplog10 (float --> float))114 ;115 109 (define (fplog10 x) (fp/ (fplog x) 2.3025850929940456840179914546843642076011)) 116 110 117 111 ;; 118 112 119 (: fpdegree->radian (float --> float))120 ;121 113 (define (fpdegree->radian deg) (fp* deg 0.0174532925199432957692369076848861271344)) 122 114 123 (: fpradian->degree (float --> float))124 ;125 115 (define (fpradian->degree rad) (fp/ rad 0.0174532925199432957692369076848861271344)) 126 116 127 117 ;; 128 118 129 (: fpprecision-factor ((or float fixnum) #!optional float --> float))130 ;131 119 (define (fpprecision-factor p #!optional (base 10.0)) (fpexpt base (exact->inexact p))) 132 120 133 #| 121 (define (fpprecision-epsilon p #!optional (base 10.0)) 122 (fp/ 1.0 (fpprecision-factor (fpadd1 (exact->inexact p)) base)) ) 123 134 124 ;; 135 125 136 (: fp% (float float --> float)) 137 ; 138 (define (fp% n p) (fp/ (fp* 100.0 n) p)) 139 |# 126 (define (fp% n p) (fp/ (fp* 100.0 n) (exact->inexact p))) 140 127 141 128 ) ;fp-inlines -
release/5/fp-utils/trunk/fp-utils.egg
r39383 r39387 3 3 4 4 ((synopsis "fp utilities") 5 (version "4.0. 2")5 (version "4.0.3") 6 6 (category math) 7 7 (author "[[kon lovett]]") -
release/5/fp-utils/trunk/fp-utils.scm
r38251 r39387 39 39 ;;; 40 40 41 ;;42 43 41 (: fpsum ((list-of float) --> float)) 44 ; 42 (: C_fmod (float float --> float)) 43 (: C_remainder (float float --> float)) 44 (: fpmodulo (float float --> float)) 45 (: fpquotient (float float --> float)) 46 (: fpremainder (float float --> float)) 47 (: fptruncate-with-precision (float #!optional float --> float)) 48 (: fpround-with-precision (float #!optional float --> float)) 49 (: fpceiling-with-precision (float #!optional float --> float)) 50 (: fpfloor-with-precision (float #!optional float --> float)) 51 (: fpdistance (float float float float --> float)) 52 (: fpdistance* (float float float float --> float)) 53 (: fpquo-and-rem (float float --> float float)) 54 (: fpmax-and-min (float #!rest float --> float float)) 55 (: fprandom (#!optional (or float fixnum) (or float fixnum) -> float)) 56 (: fp~= (float float #!optional float --> boolean)) 57 (: fp~<= (float float #!optional float --> boolean)) 58 (: fp~>= (float float #!optional float --> boolean)) 59 60 ;; 61 45 62 (define (fpsummation ls) 46 63 (if (null? ls) … … 57 74 ;;; 58 75 59 (: C_fmod (float float --> float))60 ;61 76 (define C_fmod (foreign-lambda double "fmod" double double)) 62 77 63 (: C_remainder (float float --> float))64 ;65 78 (define C_remainder (foreign-lambda double "remainder" double double)) 66 79 67 80 ;; 68 81 69 (: fpmodulo (float float --> float))70 ;71 82 (define (fpmodulo x y) (fptruncate (C_fmod x y))) 72 83 73 (: fpquotient (float float --> float))74 ;75 84 (define (fpquotient x y) (fptruncate (fp/ x y))) 76 85 77 (: fpremainder (float float --> float))78 ;79 86 (define (fpremainder x y) (fptruncate (C_remainder x y))) 80 87 … … 88 95 ((make-unary-with-precision ?op) 89 96 (lambda (n #!optional (p PRECISION-DEFAULT)) 90 (if (fpzero? p)97 (if (fpzero? (exact->inexact p)) 91 98 (?op n) 92 99 (let ((pf (fpprecision-factor p))) … … 95 102 ;; 96 103 97 (: fptruncate-with-precision (float #!optional float --> float))98 ;99 104 (define fptruncate-with-precision (make-unary-with-precision fptruncate)) 100 105 101 (: fpround-with-precision (float #!optional float --> float))102 ;103 106 (define fpround-with-precision (make-unary-with-precision fpround)) 104 107 105 (: fpceiling-with-precision (float #!optional float --> float))106 ;107 108 (define fpceiling-with-precision (make-unary-with-precision fpceiling)) 108 109 109 (: fpfloor-with-precision (float #!optional float --> float))110 ;111 110 (define fpfloor-with-precision (make-unary-with-precision fpfloor)) 112 111 113 112 ;; 114 113 115 (: fpdistance (float float float float --> float))116 ;117 114 (define (fpdistance x1 y1 x2 y2) (fpsqrt (fpdistance* x1 y1 x2 y2))) 118 115 119 (: fpdistance* (float float float float --> float))120 ;121 116 (define (fpdistance* x1 y1 x2 y2) (fp+ (fpsqr (fp- x1 x2)) (fpsqr (fp- y1 y2)))) 122 117 123 118 ;; 124 119 125 (: fpquo-and-rem (float float --> float float))126 ;127 120 (define (fpquo-and-rem fpn fpd) (values (fpquotient fpn fpd) (fpremainder fpn fpd))) 128 121 129 122 ;; 130 123 131 (: fpmax-and-min (float #!rest float --> float float))132 ;133 124 (define (fpmax-and-min fp . fps) 134 125 (let loop ((fps fps) (mx fp) (mn fp)) … … 140 131 ;; 141 132 142 (: fprandom (#!optional (or float fixnum) (or float fixnum) -> float))143 ;144 133 (define-inline (*fpinv x) (if (fpzero? x) 0.0 (fp/ 1.0 x))) 145 134 (define-inline (*fpinvfx x) (inexact->exact (*fpinv x))) … … 163 152 ;; 164 153 165 (: fp~= (float float #!optional float --> boolean))166 ;167 154 (define (fp~= x y #!optional (eps flonum-epsilon)) 168 155 ;NOTE minimum/maximum-flonum is smallest/largest positive normal flonum … … 182 169 (fp< (fpabs (fp/ d y)) eps) ) ) ) ) ) 183 170 184 (: fp~<= (float float #!optional float --> boolean))185 ;186 171 (define (fp~<= x y #!optional (eps flonum-epsilon)) (or (fp< x y) (fp~= x y eps))) 187 172 188 (: fp~>= (float float #!optional float --> boolean))189 ;190 173 (define (fp~>= x y #!optional (eps flonum-epsilon)) (or (fp> x y) (fp~= x y eps))) 191 174 192 175 #| 193 ;;194 195 (: fp% (float number --> float))196 ;197 (define (fp% n p)198 (fp* (fp* (exact->inexact p) 0.01) n) )199 200 176 ;; 201 177
Note: See TracChangeset
for help on using the changeset viewer.