From 31c7bd8e864a12f3f00bc7f806d8caa43b034e69 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 3 May 2012 14:44:10 -0700
Subject: [PATCH] math.functions: adding generalized signum function.  Fixes
 #509.

---
 basis/math/functions/functions-docs.factor  | 4 ++++
 basis/math/functions/functions-tests.factor | 6 ++++++
 basis/math/functions/functions.factor       | 6 ++++++
 3 files changed, 16 insertions(+)

diff --git a/basis/math/functions/functions-docs.factor b/basis/math/functions/functions-docs.factor
index 43188d94c3..4ee8556fb3 100644
--- a/basis/math/functions/functions-docs.factor
+++ b/basis/math/functions/functions-docs.factor
@@ -336,3 +336,7 @@ HELP: roots
 HELP: sigmoid
 { $values { "x" number } { "y" number } }
 { $description "Outputs the sigmoid, an S-shaped \"logistic\" function, from 0 to 1, of the number " { $snippet "x" } "." } ;
+
+HELP: signum
+{ $values { "x" number } { "y" number } }
+{ $description "Calculates the signum value.  For a real number, " { $snippet "x" } ", this is its sign (-1, 0, or 1).  For a complex number, " { $snippet "x" } ", this is the point on the unit circle of the complex plane that is nearest to " { $snippet "x" } "." } ;
diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor
index 2a235adfaa..d1e1c94b65 100644
--- a/basis/math/functions/functions-tests.factor
+++ b/basis/math/functions/functions-tests.factor
@@ -242,3 +242,9 @@ CONSTANT: log10-factorial-1000 0x1.40f3593ed6f8ep11
 { t } [ 3 15 roots [ 15 ^ 3 .01 ~ ] all? ] unit-test
 
 { .5 } [ 0 sigmoid ] unit-test
+
+{ 1 } [ 12 signum ] unit-test
+{ -1 } [ -5.0 signum ] unit-test
+{ 0 } [ 0 signum ] unit-test
+{ t } [ C{ 3.0 -1.5 } signum C{ 0.8944271909999157 -0.4472135954999579 } 1e-10 ~ ] unit-test
+
diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor
index 4bbdb0ec43..8ae04e1881 100644
--- a/basis/math/functions/functions.factor
+++ b/basis/math/functions/functions.factor
@@ -364,3 +364,9 @@ M: real atan >float atan ; inline
     [ iota [ ^ * ] with with map ] tri ;
 
 : sigmoid ( x -- y ) neg e^ 1 + recip ; inline
+
+GENERIC: signum ( x -- y )
+
+M: real signum sgn ;
+
+M: complex signum dup abs / ;