math.approx: function to approximate rationals.

diff --git a/extra/math/approx/approx-docs.factor b/extra/math/approx/approx-docs.factor
new file mode 100644 (file)
index 0000000..1bbfd08
--- /dev/null
+++ b/extra/math/approx/approx-docs.factor
@@ -0,0 +1,19 @@
+! Copyright (C) 2010 John Benediktsson.
+! See http://factorcode.org/license.txt for BSD license
+
+USING: help.markup help.syntax math math.approx ;
+
+IN: math.approx
+
+HELP: approximate
+{ $values { "x" ratio } { "epsilon" ratio } { "y" ratio } }
+{ $description
+"Applied to two fractional numbers \"x\" and \"epsilon\", returns the "
+"simplest rational number within \"epsilon\" of \"x\"."
+$nl
+"A rational number \"y\" is said to be simpler than another \"y'\" if "
+"abs numerator y <= abs numerator y', and denominator y <= demoniator y'"
+$nl
+"Any real interval contains a unique simplest rational; in particular note "
+"that 0/1 is the simplest rational of all."
+} ;

diff --git a/extra/math/approx/approx-tests.factor b/extra/math/approx/approx-tests.factor
new file mode 100644 (file)
index 0000000..a8d387b
--- /dev/null
+++ b/extra/math/approx/approx-tests.factor
@@ -0,0 +1,21 @@
+! Copyright (C) 2010 John Benediktsson.
+! See http://factorcode.org/license.txt for BSD license
+
+USING: kernel math math.approx math.constants
+math.floating-point sequences tools.test ;
+
+IN: math.approx.tests
+
+[ { 3 3 13/4 16/5 19/6 22/7 } ]
+[
+    pi double>ratio
+    { 1/2 1/4 1/8 1/16 1/32 1/64 }
+    [ approximate ] with map
+] unit-test
+
+[ { -3 -3 -13/4 -16/5 -19/6 -22/7 } ]
+[
+    pi double>ratio neg
+    { 1/2 1/4 1/8 1/16 1/32 1/64 }
+    [ approximate ] with map
+] unit-test

diff --git a/extra/math/approx/approx.factor b/extra/math/approx/approx.factor
new file mode 100644 (file)
index 0000000..070243c
--- /dev/null
+++ b/extra/math/approx/approx.factor
@@ -0,0 +1,38 @@
+! Copyright (C) 2010 John Benediktsson.
+! See http://factorcode.org/license.txt for BSD license
+
+USING: combinators kernel locals math math.functions ;
+
+IN: math.approx
+
+<PRIVATE
+
+:: (simplest) ( n d n' d' -- val ) ! assumes 0 < n/d < n'/d'
+    n  d  /mod :> ( q  r  )
+    n' d' /mod :> ( q' r' )
+    {
+        { [ r zero? ] [ q ] }
+        { [ q q' = not ] [ q 1 + ] }
+        [
+            d' r' d r (simplest) >fraction :> ( n'' d'' )
+            q n'' * d'' + n'' /
+        ]
+    } cond ;
+
+:: simplest ( x y -- val )
+    {
+        { [ x y > ] [ y x simplest ] }
+        { [ x y = ] [ x ] }
+        { [ x 0 > ] [ x y [ >fraction ] bi@ (simplest) ] }
+        { [ y 0 < ] [ y x [ neg >fraction ] bi@ (simplest) neg ] }
+        [ 0 ]
+    } cond ;
+
+: check-float ( x -- x )
+    dup float? [ "can't be floats" throw ] when ;
+
+PRIVATE>
+
+: approximate ( x epsilon -- y )
+    [ check-float ] bi@ [ - ] [ + ] 2bi simplest ;
+

diff --git a/extra/math/approx/authors.txt b/extra/math/approx/authors.txt
new file mode 100644 (file)
index 0000000..e091bb8
--- /dev/null
+++ b/extra/math/approx/authors.txt
@@ -0,0 +1 @@
+John Benediktsson

diff --git a/extra/math/approx/summary.txt b/extra/math/approx/summary.txt
new file mode 100644 (file)
index 0000000..1e7c451
--- /dev/null
+++ b/extra/math/approx/summary.txt
@@ -0,0 +1 @@
+Approximating rational numbers.