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

math.floating-point: adding double>ratio.

db4
John Benediktsson 2010-09-06 18:42:26 -07:00
parent c4fa0c2507
commit dcc5ea89c7
2 changed files with 28 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
extra/math/floating-point/floating-point-tests.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test math.floating-point kernel
math.constants fry sequences math ;
math.constants fry sequences math random ;
IN: math.floating-point.tests
[ t ] [ pi >double< >double pi = ] unit-test
@ -13,3 +13,19 @@ IN: math.floating-point.tests
[ f ] [ 10. infinity? ] unit-test
[ f ] [ -10. infinity? ] unit-test
[ f ] [ 0. infinity? ] unit-test
[ 0 ] [ 0.0 double>ratio ] unit-test
[ 1 ] [ 1.0 double>ratio ] unit-test
[ 1/2 ] [ 0.5 double>ratio ] unit-test
[ 3/4 ] [ 0.75 double>ratio ] unit-test
[ 12+1/2 ] [ 12.5 double>ratio ] unit-test
[ -12-1/2 ] [ -12.5 double>ratio ] unit-test
[ 3+39854788871587/281474976710656 ] [ pi double>ratio ] unit-test
: roundtrip ( n -- )
[ '[ _ ] ] keep '[ _ double>ratio >float ] unit-test ;
{ 1 12 123 1234 } [ bits>double roundtrip ] each
100 [ -10.0 10.0 uniform-random-float roundtrip ] times

11
extra/math/floating-point/floating-point.factor
View File

@ -44,3 +44,14 @@ IN: math.floating-point
[ (double-exponent-bits) 11 on-bits = ]
[ (double-mantissa-bits) 0 = ]
} 1&& ;
: check-special ( n -- n )
dup fp-special? [ "cannot be special" throw ] when ;
: double>ratio ( double -- a/b )
check-special double>bits
[ (double-sign) zero? 1 -1 ? ]
[ (double-mantissa-bits) 52 2^ / ]
[ (double-exponent-bits) ] tri
dup zero? [ 1 + ] [ [ 1 + ] dip ] if 1023 - 2 swap ^ * * ;