Changeset 36243 in project


Ignore:
Timestamp:
08/13/18 02:36:52 (2 months ago)
Author:
kon
Message:

fix hypot test, add types, rm make-log/base, add log/base

Location:
release/5/mathh
Files:
6 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/5/mathh/tags/4.1.0/mathh.egg

    r36002 r36243  
    33
    44((synopsis "ISO C math functions and constants")
    5  (version "4.0.0")
     5 (version "4.1.0")
    66 (category math)
    77 (author "[[kon lovett]] and [[john cowan]]")
  • release/5/mathh/tags/4.1.0/mathh.scm

    r36003 r36243  
    100100  hypot
    101101  log10 log2 log1p
    102   log-with-base make-log/base
     102  log-with-base log/base
    103103  modf frexp
    104104  ldexp scalbn
     
    114114  (chicken flonum)
    115115  (chicken syntax)
     116  (chicken type)
    116117  (chicken foreign))
    117118
     
    124125(define-syntax define-unimplemented
    125126  (syntax-rules ()
    126     ((_ ?name)
     127    ((define-unimplemented ?name)
    127128     (define (?name . _) (%unimplemented-error ?name) ) ) ) )
    128129
    129130(define-syntax lambda-unimplemented
    130131  (syntax-rules ()
    131     ((_ ?name)
     132    ((lambda-unimplemented ?name)
    132133     (lambda _ (%unimplemented-error ?name) ) ) ) )
    133134
     
    136137;; Bessel functions of the 1st kind
    137138
     139(: bessel-j0 (float --> float))
     140;
    138141(define bessel-j0
    139142  (cond-expand
     
    141144    (else     (foreign-lambda double "j0" double) ) ) )
    142145
     146(: bessel-j1 (float --> float))
     147;
    143148(define bessel-j1
    144149  (cond-expand
     
    146151    (else     (foreign-lambda double "j1" double) ) ) )
    147152
     153(: bessel-jn (fixnum float --> float))
     154;
    148155(define bessel-jn
    149156  (cond-expand
     
    153160;; Bessel functions of the 2nd kind
    154161
     162(: bessel-y0 (float --> float))
     163;
    155164(define bessel-y0
    156165  (cond-expand
     
    158167    (else     (foreign-lambda double "y0" double) ) ) )
    159168
     169(: bessel-y1 (float --> float))
     170;
    160171(define bessel-y1
    161172  (cond-expand
     
    163174    (else     (foreign-lambda double "y1" double) ) ) )
    164175
     176(: bessel-yn (fixnum float --> float))
     177;
    165178(define bessel-yn
    166179  (cond-expand
     
    170183;; Error functions
    171184
     185(: erf (float --> float))
     186;
    172187(define erf (foreign-lambda double "erf" double))
     188
     189(: erfc (float --> float))
     190;
    173191(define erfc (foreign-lambda double "erfc" double))
    174192
    175193;; Hyperbolic functions
    176194
     195(: cosh (float --> float))
     196;
    177197(define cosh (foreign-lambda double "cosh" double))
     198
     199(: sinh (float --> float))
     200;
    178201(define sinh (foreign-lambda double "sinh" double))
     202
     203(: tanh (float --> float))
     204;
    179205(define tanh (foreign-lambda double "tanh" double))
    180206
    181207;; Inverse Hyperbolic functions
    182208
     209(: acosh (float --> float))
     210;
    183211(define acosh
    184212  (cond-expand
     
    186214    (else     (foreign-lambda double "acosh" double)) ) )
    187215
     216(: asinh (float --> float))
     217;
    188218(define asinh
    189219  (cond-expand
     
    191221    (else     (foreign-lambda double "asinh" double)) ) )
    192222
     223(: atanh (float --> float))
     224;
    193225(define atanh
    194226  (cond-expand
     
    198230;; Euclidean distance function
    199231
     232(: hypot (float float --> float))
     233;
    200234(define hypot (foreign-lambda double "hypot" double double) )
    201235
    202236;; Gamma function
    203237
     238(: gamma (float --> float))
     239;
    204240(define gamma
    205241  (cond-expand
     
    213249;; Ln Abs Gamma function
    214250
     251(: lgamma (float --> float))
     252;
    215253(define lgamma
    216254  (cond-expand
     
    220258;; Base-10 logarithm
    221259
     260(: log10 (float --> float))
     261;
    222262(define log10 (foreign-lambda double "log10" double))
    223263
    224264;; Base-2 logarithm
    225265
     266(: log2 (float --> float))
     267;
    226268(define log2 (foreign-lambda double "log2" double) )
    227269
    228270;; Natural logarithm of 1+x accurate for very small x
    229271
     272(: log1p (float --> float))
     273;
    230274(define log1p (foreign-lambda double "log1p" double) )
    231275
    232276;; Compute x * 2**n
    233277
     278(: ldexp (float integer --> float))
     279;
    234280(define ldexp (foreign-lambda double "ldexp" double integer))
    235281
    236282;; Efficiently compute x * 2**n
    237283
     284(: scalbn (float integer --> float))
     285;
    238286(define scalbn (foreign-lambda double "scalbn" double integer) )
    239287
    240288;; Log function for base n
    241289
     290(: *log-with-base (fixnum --> (procedure (float) float)))
     291;
     292(define (*log-with-base b)
     293  (let ((lnb (log b)))
     294    (lambda (n)
     295      ((foreign-lambda* double ((double x) (double lnb))
     296        "C_return( log( x ) / lnb );") n lnb)) ) )
     297
     298(: log-with-base (fixnum --> (procedure (float) float)))
     299;
    242300(define (log-with-base b)
    243         (cond
    244           ((= 2 b)
    245             log2 )
    246     ((= 10 b)
    247       log10 )
    248     (else
    249       (let ((lnb (log b)))
    250         (lambda (n)
    251           ((foreign-lambda* double ((double x) (double lnb))
    252             "C_return( log( x ) / lnb );") n lnb)) ) ) ) )
    253 
    254 (define make-log/base log-with-base)
     301        (case b
     302          ((2)  log2 )
     303    ((10) log10 )
     304    (else (*log-with-base b) ) ) )
     305
     306(define log/base log-with-base)
    255307
    256308;; Flonum remainder
    257309
     310(: fpmod (float float --> float))
     311;
    258312(define fpmod (foreign-lambda double "fmod" double double))
    259313
    260314;; Return integer & fraction (as multiple values) of a flonum
    261315
     316(: modf (float --> float float))
     317;
    262318(define modf (foreign-primitive ((double x)) "
    263319  double ipart;
     
    272328;; Return mantissa & exponent (as multiple values) of a flonum
    273329
     330(: frexp (float --> float fixnum))
     331;
    274332(define frexp (foreign-primitive ((double x)) "
    275333  int exp;
     
    284342;; Returns arg1 with same sign as arg2
    285343
     344(: copysign (float float --> float))
     345;
    286346(define copysign
    287347  (cond-expand
     
    291351;; Increments/decrements arg1 in the direction of arg2
    292352
     353(: nextafter (float float --> float))
     354;
    293355(define nextafter
    294356  (cond-expand
     
    298360;; #t when negative, #f otherwise
    299361
     362(: signbit (float --> boolean))
     363;
    300364(define signbit
    301365  (cond-expand
     
    310374;; Cube Root
    311375
     376(: cbrt (float --> float))
     377;
    312378(define cbrt
    313379  (cond-expand
     
    317383;; Returns a symbol denoting the kind of floating-point number.
    318384
     385(: fpclass (float --> symbol))
     386;
    319387(define fpclass
    320388  (cond-expand
     
    393461;; Returns a symbol denoting the kind of floating-point number.
    394462
     463(: fpclassify (float --> symbol))
     464;
    395465(define fpclassify
    396466  (cond-expand
  • release/5/mathh/tags/4.1.0/tests/mathh-test.scm

    r36001 r36243  
    2929        (test 0.0 (tanh 0.0))
    3030
    31         (test 5.0 (hypot -5.0 0))
     31        (test 5.0 (hypot -5.0 0.0))
    3232
    3333        (test 1.0 (tgamma 1.0))
  • release/5/mathh/trunk/mathh.egg

    r36002 r36243  
    33
    44((synopsis "ISO C math functions and constants")
    5  (version "4.0.0")
     5 (version "4.1.0")
    66 (category math)
    77 (author "[[kon lovett]] and [[john cowan]]")
  • release/5/mathh/trunk/mathh.scm

    r36003 r36243  
    100100  hypot
    101101  log10 log2 log1p
    102   log-with-base make-log/base
     102  log-with-base log/base
    103103  modf frexp
    104104  ldexp scalbn
     
    114114  (chicken flonum)
    115115  (chicken syntax)
     116  (chicken type)
    116117  (chicken foreign))
    117118
     
    124125(define-syntax define-unimplemented
    125126  (syntax-rules ()
    126     ((_ ?name)
     127    ((define-unimplemented ?name)
    127128     (define (?name . _) (%unimplemented-error ?name) ) ) ) )
    128129
    129130(define-syntax lambda-unimplemented
    130131  (syntax-rules ()
    131     ((_ ?name)
     132    ((lambda-unimplemented ?name)
    132133     (lambda _ (%unimplemented-error ?name) ) ) ) )
    133134
     
    136137;; Bessel functions of the 1st kind
    137138
     139(: bessel-j0 (float --> float))
     140;
    138141(define bessel-j0
    139142  (cond-expand
     
    141144    (else     (foreign-lambda double "j0" double) ) ) )
    142145
     146(: bessel-j1 (float --> float))
     147;
    143148(define bessel-j1
    144149  (cond-expand
     
    146151    (else     (foreign-lambda double "j1" double) ) ) )
    147152
     153(: bessel-jn (fixnum float --> float))
     154;
    148155(define bessel-jn
    149156  (cond-expand
     
    153160;; Bessel functions of the 2nd kind
    154161
     162(: bessel-y0 (float --> float))
     163;
    155164(define bessel-y0
    156165  (cond-expand
     
    158167    (else     (foreign-lambda double "y0" double) ) ) )
    159168
     169(: bessel-y1 (float --> float))
     170;
    160171(define bessel-y1
    161172  (cond-expand
     
    163174    (else     (foreign-lambda double "y1" double) ) ) )
    164175
     176(: bessel-yn (fixnum float --> float))
     177;
    165178(define bessel-yn
    166179  (cond-expand
     
    170183;; Error functions
    171184
     185(: erf (float --> float))
     186;
    172187(define erf (foreign-lambda double "erf" double))
     188
     189(: erfc (float --> float))
     190;
    173191(define erfc (foreign-lambda double "erfc" double))
    174192
    175193;; Hyperbolic functions
    176194
     195(: cosh (float --> float))
     196;
    177197(define cosh (foreign-lambda double "cosh" double))
     198
     199(: sinh (float --> float))
     200;
    178201(define sinh (foreign-lambda double "sinh" double))
     202
     203(: tanh (float --> float))
     204;
    179205(define tanh (foreign-lambda double "tanh" double))
    180206
    181207;; Inverse Hyperbolic functions
    182208
     209(: acosh (float --> float))
     210;
    183211(define acosh
    184212  (cond-expand
     
    186214    (else     (foreign-lambda double "acosh" double)) ) )
    187215
     216(: asinh (float --> float))
     217;
    188218(define asinh
    189219  (cond-expand
     
    191221    (else     (foreign-lambda double "asinh" double)) ) )
    192222
     223(: atanh (float --> float))
     224;
    193225(define atanh
    194226  (cond-expand
     
    198230;; Euclidean distance function
    199231
     232(: hypot (float float --> float))
     233;
    200234(define hypot (foreign-lambda double "hypot" double double) )
    201235
    202236;; Gamma function
    203237
     238(: gamma (float --> float))
     239;
    204240(define gamma
    205241  (cond-expand
     
    213249;; Ln Abs Gamma function
    214250
     251(: lgamma (float --> float))
     252;
    215253(define lgamma
    216254  (cond-expand
     
    220258;; Base-10 logarithm
    221259
     260(: log10 (float --> float))
     261;
    222262(define log10 (foreign-lambda double "log10" double))
    223263
    224264;; Base-2 logarithm
    225265
     266(: log2 (float --> float))
     267;
    226268(define log2 (foreign-lambda double "log2" double) )
    227269
    228270;; Natural logarithm of 1+x accurate for very small x
    229271
     272(: log1p (float --> float))
     273;
    230274(define log1p (foreign-lambda double "log1p" double) )
    231275
    232276;; Compute x * 2**n
    233277
     278(: ldexp (float integer --> float))
     279;
    234280(define ldexp (foreign-lambda double "ldexp" double integer))
    235281
    236282;; Efficiently compute x * 2**n
    237283
     284(: scalbn (float integer --> float))
     285;
    238286(define scalbn (foreign-lambda double "scalbn" double integer) )
    239287
    240288;; Log function for base n
    241289
     290(: *log-with-base (fixnum --> (procedure (float) float)))
     291;
     292(define (*log-with-base b)
     293  (let ((lnb (log b)))
     294    (lambda (n)
     295      ((foreign-lambda* double ((double x) (double lnb))
     296        "C_return( log( x ) / lnb );") n lnb)) ) )
     297
     298(: log-with-base (fixnum --> (procedure (float) float)))
     299;
    242300(define (log-with-base b)
    243         (cond
    244           ((= 2 b)
    245             log2 )
    246     ((= 10 b)
    247       log10 )
    248     (else
    249       (let ((lnb (log b)))
    250         (lambda (n)
    251           ((foreign-lambda* double ((double x) (double lnb))
    252             "C_return( log( x ) / lnb );") n lnb)) ) ) ) )
    253 
    254 (define make-log/base log-with-base)
     301        (case b
     302          ((2)  log2 )
     303    ((10) log10 )
     304    (else (*log-with-base b) ) ) )
     305
     306(define log/base log-with-base)
    255307
    256308;; Flonum remainder
    257309
     310(: fpmod (float float --> float))
     311;
    258312(define fpmod (foreign-lambda double "fmod" double double))
    259313
    260314;; Return integer & fraction (as multiple values) of a flonum
    261315
     316(: modf (float --> float float))
     317;
    262318(define modf (foreign-primitive ((double x)) "
    263319  double ipart;
     
    272328;; Return mantissa & exponent (as multiple values) of a flonum
    273329
     330(: frexp (float --> float fixnum))
     331;
    274332(define frexp (foreign-primitive ((double x)) "
    275333  int exp;
     
    284342;; Returns arg1 with same sign as arg2
    285343
     344(: copysign (float float --> float))
     345;
    286346(define copysign
    287347  (cond-expand
     
    291351;; Increments/decrements arg1 in the direction of arg2
    292352
     353(: nextafter (float float --> float))
     354;
    293355(define nextafter
    294356  (cond-expand
     
    298360;; #t when negative, #f otherwise
    299361
     362(: signbit (float --> boolean))
     363;
    300364(define signbit
    301365  (cond-expand
     
    310374;; Cube Root
    311375
     376(: cbrt (float --> float))
     377;
    312378(define cbrt
    313379  (cond-expand
     
    317383;; Returns a symbol denoting the kind of floating-point number.
    318384
     385(: fpclass (float --> symbol))
     386;
    319387(define fpclass
    320388  (cond-expand
     
    393461;; Returns a symbol denoting the kind of floating-point number.
    394462
     463(: fpclassify (float --> symbol))
     464;
    395465(define fpclassify
    396466  (cond-expand
  • release/5/mathh/trunk/tests/mathh-test.scm

    r36001 r36243  
    2929        (test 0.0 (tanh 0.0))
    3030
    31         (test 5.0 (hypot -5.0 0))
     31        (test 5.0 (hypot -5.0 0.0))
    3232
    3333        (test 1.0 (tgamma 1.0))
Note: See TracChangeset for help on using the changeset viewer.