From 13a4e3f2a8a8bca12d730c4e3e9518a90081b27a Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 19 Apr 2012 12:19:14 -0700
Subject: [PATCH] math.functions: adding "roots" word to get arbitrary roots
 from numbers.

---
 basis/math/functions/functions-docs.factor  | 6 +++++-
 basis/math/functions/functions-tests.factor | 8 ++++++++
 basis/math/functions/functions.factor       | 5 +++++
 3 files changed, 18 insertions(+), 1 deletion(-)

diff --git a/basis/math/functions/functions-docs.factor b/basis/math/functions/functions-docs.factor
index 1f93ef1984..e04397a50a 100644
--- a/basis/math/functions/functions-docs.factor
+++ b/basis/math/functions/functions-docs.factor
@@ -306,7 +306,6 @@ HELP: ~
     }
 } ;
 
-
 HELP: truncate
 { $values { "x" real } { "y" "a whole real number" } }
 { $description "Outputs the number that results from subtracting the fractional component of " { $snippet "x" } "." }
@@ -326,3 +325,8 @@ HELP: round
 { $values { "x" real } { "y" "a whole real number" } }
 { $description "Outputs the whole number closest to " { $snippet "x" } "." }
 { $notes "The result is not necessarily an integer." } ;
+
+HELP: roots
+{ $values { "x" number } { "t" integer } { "seq" sequence } }
+{ $description "Outputs the " { $snippet "t" } " roots of a number " { $snippet "x" } "." }
+{ $notes "The results are not necessarily real." } ;
diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor
index 2e225c0dbd..4d58aff2e1 100644
--- a/basis/math/functions/functions-tests.factor
+++ b/basis/math/functions/functions-tests.factor
@@ -230,3 +230,11 @@ CONSTANT: log10-factorial-1000 0x1.40f3593ed6f8ep11
 [ 1.75 ] [ 1.0 2.5 0.5 lerp ] unit-test
 
 [ C{ 1 2 } ] [ C{ 1 2 } 1 ^ ] unit-test
+
+{ { t t t } } [
+    3 3 roots {
+        1.442249570307408
+        C{ -0.7211247851537038 1.249024766483407 }
+        C{ -0.7211247851537049 -1.249024766483406 }
+    } [ .01 ~ ] 2map
+] unit-test
diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor
index b56e2a4f2c..291bcf2516 100644
--- a/basis/math/functions/functions.factor
+++ b/basis/math/functions/functions.factor
@@ -357,3 +357,8 @@ M: real atan >float atan ; inline
     [ [ / floor ] [ * ] bi ] unless-zero ;
 
 : lerp ( a b t -- a_t ) [ over - ] dip * + ; inline
+
+: roots ( x t -- seq )
+    [ [ log ] [ recip ] bi* * exp ]
+    [ recip 2pi * 0 swap complex boa exp ]
+    [ iota [ ^ * ] with with map ] tri ;