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
|
[ 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
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue