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

math.functions: fix ~ with negative (relative) tolerance

db4
Slava Pestov 2009-09-22 03:19:47 -05:00
parent 513ba1f176
commit fe0701deb1
2 changed files with 6 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -6,6 +6,10 @@ IN: math.functions.tests
[ t ] [ 4.0000001 4.0000001 .000001 ~ ] unit-test [ t ] [ 4.0000001 4.0000001 .000001 ~ ] unit-test
[ f ] [ -4.0000001 4.0000001 .00001 ~ ] unit-test [ f ] [ -4.0000001 4.0000001 .00001 ~ ] unit-test
[ t ] [ -.0000000000001 0 .0000000001 ~ ] unit-test [ t ] [ -.0000000000001 0 .0000000001 ~ ] unit-test
[ t ] [ 100 101 -.9 ~ ] unit-test
[ f ] [ 100 120 -.09 ~ ] unit-test
[ t ] [ 0 0 -.9 ~ ] unit-test
[ f ] [ 0 10 -.9 ~ ] unit-test
! Lets get the argument order correct, eh? ! Lets get the argument order correct, eh?
[ 0.0 ] [ 0.0 1.0 fatan2 ] unit-test [ 0.0 ] [ 0.0 1.0 fatan2 ] unit-test

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

@ -137,13 +137,13 @@ M: real absq sq ; inline
[ - abs ] dip < ; [ - abs ] dip < ;
: ~rel ( x y epsilon -- ? ) : ~rel ( x y epsilon -- ? )
[ [ - abs ] 2keep [ abs ] bi@ + ] dip * < ; [ [ - abs ] 2keep [ abs ] bi@ + ] dip * <= ;
: ~ ( x y epsilon -- ? ) : ~ ( x y epsilon -- ? )
{ {
{ [ 2over [ fp-nan? ] either? ] [ 3drop f ] } { [ 2over [ fp-nan? ] either? ] [ 3drop f ] }
{ [ dup zero? ] [ drop number= ] } { [ dup zero? ] [ drop number= ] }
{ [ dup 0 < ] [ ~rel ] } { [ dup 0 < ] [ neg ~rel ] }
[ ~abs ] [ ~abs ]
} cond ; } cond ;