steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

math.functions: clean up some more to trim back load-time dependencies; alter tests to avoid inexact float constants where possible and hex-ify inexact constants otherwise

db4
Joe Groff 2011-09-22 16:04:49 -07:00
parent 96c710a7b7
commit 954bf89c40
2 changed files with 34 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
basis/math/functions/functions-tests.factor
View File

@ -1,4 +1,4 @@
USING: kernel math math.constants math.functions math.libm
USING: kernel literals math math.constants math.functions math.libm
math.order math.ranges math.private sequences tools.test ;
IN: math.functions.tests
@ -45,27 +45,32 @@ IN: math.functions.tests
[ -0.5 1 ] [ -1 frexp ] unit-test
[ 0.5 2 ] [ 2 frexp ] unit-test
[ -0.5 2 ] [ -2 frexp ] unit-test
[ 0.64 -6 ] [ 0.01 frexp ] unit-test
[ -0.64 -6 ] [ -0.01 frexp ] unit-test
[ 0.75 2 ] [ 3 frexp ] unit-test
[ -0.75 2 ] [ -3 frexp ] unit-test
[ 0.75 0 ] [ 0.75 frexp ] unit-test
[ -0.75 0 ] [ -0.75 frexp ] unit-test
[ 1/0. 0 ] [ 1/0. frexp ] unit-test
[ -1/0. 0 ] [ -1/0. frexp ] unit-test
[ 0.6588418960767314 8530 t ] [ 1000 factorial [ frexp ] [ bignum? ] bi ] unit-test
[ -0.6588418960767314 8530 t ] [ 1000 factorial neg [ frexp ] [ bignum? ] bi ] unit-test
[ 1/0. ] [ 1/0. frexp drop ] unit-test
[ -1/0. ] [ -1/0. frexp drop ] unit-test
[ t ] [ 0/0. frexp drop fp-nan? ] unit-test
[ 0.75 10,002 t ] [ 3 10,000 2^ * [ frexp ] [ bignum? ] bi ] unit-test
[ -0.75 10,002 t ] [ -3 10,000 2^ * [ frexp ] [ bignum? ] bi ] unit-test
[ 0.0 ] [ 1 log ] unit-test
[ 0.0 ] [ 1.0 log ] unit-test
[ 1.0 ] [ e log ] unit-test
[ 5912.128178488163 t ] [ 1000 factorial [ log ] [ bignum? ] bi ] unit-test
[ C{ 5912.128178488163 3.141592653589793 } t ] [ 1000 factorial neg [ log ] [ bignum? ] bi ] unit-test
CONSTANT: log-factorial-1000 HEX: 1.71820d04e2eb6p12
CONSTANT: log10-factorial-1000 HEX: 1.40f3593ed6f8ep11
[ $ log-factorial-1000 t ] [ 1000 factorial [ log ] [ bignum? ] bi ] unit-test
[ C{ $ log-factorial-1000 $ pi } t ] [ 1000 factorial neg [ log ] [ bignum? ] bi ] unit-test
[ 0.0 ] [ 1.0 log10 ] unit-test
[ 1.0 ] [ 10.0 log10 ] unit-test
[ 2.0 ] [ 100.0 log10 ] unit-test
[ 3.0 ] [ 1000.0 log10 ] unit-test
[ 4.0 ] [ 10000.0 log10 ] unit-test
[ 2567.604644222133 t ] [ 1000 factorial [ log10 ] [ bignum? ] bi ] unit-test
[ $ log10-factorial-1000 t ] [ 1000 factorial [ log10 ] [ bignum? ] bi ] unit-test
[ t ] [ 1 exp e 1.e-10 ~ ] unit-test
[ f ] [ 1 exp 0/0. 1.e-10 ~ ] unit-test

34
basis/math/functions/functions.factor
View File

@ -1,8 +1,7 @@
! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: math kernel math.constants math.private math.bits
math.libm combinators fry math.order sequences
combinators.short-circuit macros literals ;
math.libm combinators fry math.order sequences ;
IN: math.functions
: >fraction ( a/b -- a b )
@ -159,7 +158,7 @@ M: real absq sq ; inline
GENERIC: frexp ( x -- y exp )
M: float frexp
dup { [ fp-special? ] [ zero? ] } 1|| [ 0 ] [
dup fp-special? [ dup zero? ] unless* [ 0 ] [
double>bits
[ HEX: 800f,ffff,ffff,ffff bitand 0.5 double>bits bitor bits>double ]
[ -52 shift HEX: 7ff bitand 1022 - ] bi
@ -183,21 +182,26 @@ M: complex log >polar [ flog ] dip rect> ; inline
<PRIVATE
CONSTANT: most-negative-finite-float $[ -1/0. next-float >integer ]
CONSTANT: most-positive-finite-float $[ 1/0. prev-float >integer ]
: most-negative-finite-float ( -- x )
HEX: -1.ffff,ffff,ffff,fp1023 >integer ; inline
: most-positive-finite-float ( -- x )
HEX: 1.ffff,ffff,ffff,fp1023 >integer ; inline
CONSTANT: log-2 HEX: 1.62e42fefa39efp-1
CONSTANT: log10-2 HEX: 1.34413509f79ffp-2
MACRO: bignum-log ( quot: ( x -- y ) -- quot )
dup dup '[
dup
most-negative-finite-float
most-positive-finite-float
between?
[ >float @ ] [ frexp [ @ ] [ 2 @ * ] bi* + ] if
] ;
: (representable-as-float?) ( x -- ? )
most-negative-finite-float
most-positive-finite-float between? ; inline
: (bignum-log) ( n log-quot: ( x -- y ) log-2 -- log )
[ dup ] dip '[
dup (representable-as-float?)
[ >float @ ] [ frexp [ @ ] [ _ * ] bi* + ] if
] call ; inline
PRIVATE>
M: bignum log [ log ] bignum-log ;
M: bignum log [ log ] log-2 (bignum-log) ;
GENERIC: log1+ ( x -- y )
@ -213,7 +217,7 @@ M: real log10 >float flog10 ; inline
M: complex log10 log 10 log / ; inline
M: bignum log10 [ log10 ] bignum-log ;
M: bignum log10 [ log10 ] log10-2 (bignum-log) ;
GENERIC: cos ( x -- y ) foldable