math.functions: adding e^-1.

This is for calculating e^x-1 for small values more accurately.  You can also
call expm1(x) function if you want, and it's available on your platform.

FUNCTION: double expm1 ( double x )

diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor
index 36a9fbf15ccca21794b798d153482029d1771f4a..583549783caf613daf691d7274af83fd1a5067b5 100644 (file)
--- a/basis/math/functions/functions-tests.factor
+++ b/basis/math/functions/functions-tests.factor
@@ -96,6 +96,28 @@ CONSTANT: log10-factorial-1000 0x1.40f3593ed6f8ep11
 { e 1.e-10 } [ 1 e^ ] unit-test~
 { 1.0 1.e-10 } [ -1 e^ e * ] unit-test~
 
+{ 0.0 } [ 0.0 e^-1 ] unit-test
+{ -0.0 } [ -0.0 e^-1 ] unit-test
+{ 1/0. } [ 1/0. e^-1 ] unit-test
+{ -1.0 } [ -1/0. e^-1 ] unit-test
+{ -1.0 } [ -1/0. e^-1 ] unit-test
+{ t } [ NAN: 8000000000000 dup e^-1 [ fp-nan-payload ] same? ] unit-test
+{ 5e-324 } [ 5e-324 e^-1 ] unit-test
+{ 1e-20 } [ 1e-20 e^-1 ] unit-test
+{ -5e-324 } [ -5e-324 e^-1 ] unit-test
+{ -1e-20 } [ -1e-20 e^-1 ] unit-test
+{ 1.0000000000500000e-10 } [ 1e-10 e^-1 ] unit-test
+{ 22025.465794806718 } [ 10.0 e^-1 ] unit-test
+{ -9.999999999500001e-11 } [ -1e-10 e^-1 ] unit-test
+{ -0.9999546000702375 } [ -10.0 e^-1 ] unit-test
+{ -1.0 } [ -38.0 e^-1 ] unit-test
+{ -1.0 } [ -1e50 e^-1 ] unit-test
+{ 1.9424263952412558e+130 } [ 300 e^-1 ] unit-test
+{ 1.7976931346824240e+308 } [ 709.78271289328393 e^-1 ] unit-test
+{ 1/0. } [ 1000.0 e^-1 ] unit-test
+{ 1/0. } [ 1e50 e^-1 ] unit-test
+{ 1/0. } [ 1.79e308 e^-1 ] unit-test
+
 { 1.0 } [ 0 cosh ] unit-test
 { 1.0 } [ 0.0 cosh ] unit-test
 { 0.0 } [ 1 acosh ] unit-test

diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor
index 0a0d408426630f893d06cd86347b3774a350b973..a0ac2112a63c90b4ced4765d19d552f34529ac21 100644 (file)
--- a/basis/math/functions/functions.factor
+++ b/basis/math/functions/functions.factor
@@ -239,6 +239,19 @@ M: complex log10 log 10 log / ; inline
 
 M: bignum log10 [ log10 ] log10-2 (bignum-log) ;
 
+GENERIC: e^-1 ( x -- e^x-1 )
+
+M: float e^-1
+    dup abs 0.7 < [
+        dup e^ dup 1.0 = [
+            drop
+        ] [
+            [ 1.0 - * ] [ log / ] bi
+        ] if
+    ] [ e^ 1.0 - ] if ; inline
+
+M: real e^-1 >float e^-1 ; inline
+
 GENERIC: cos ( x -- y ) foldable
 
 M: complex cos