math.functions: fix ~ with negative (relative) tolerance
parent
513ba1f176
commit
fe0701deb1
|
@ -6,6 +6,10 @@ IN: math.functions.tests
|
|||
[ t ] [ 4.0000001 4.0000001 .000001 ~ ] unit-test
|
||||
[ f ] [ -4.0000001 4.0000001 .00001 ~ ] 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?
|
||||
[ 0.0 ] [ 0.0 1.0 fatan2 ] unit-test
|
||||
|
|
|
@ -137,13 +137,13 @@ M: real absq sq ; inline
|
|||
[ - abs ] dip < ;
|
||||
|
||||
: ~rel ( x y epsilon -- ? )
|
||||
[ [ - abs ] 2keep [ abs ] bi@ + ] dip * < ;
|
||||
[ [ - abs ] 2keep [ abs ] bi@ + ] dip * <= ;
|
||||
|
||||
: ~ ( x y epsilon -- ? )
|
||||
{
|
||||
{ [ 2over [ fp-nan? ] either? ] [ 3drop f ] }
|
||||
{ [ dup zero? ] [ drop number= ] }
|
||||
{ [ dup 0 < ] [ ~rel ] }
|
||||
{ [ dup 0 < ] [ neg ~rel ] }
|
||||
[ ~abs ]
|
||||
} cond ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue