diff --git a/extra/math/approx/approx-docs.factor b/extra/math/approx/approx-docs.factor new file mode 100644 index 0000000000..1bbfd087dc --- /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 index 0000000000..a8d387bc30 --- /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 index 0000000000..070243c592 --- /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 + + ( 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 index 0000000000..e091bb8164 --- /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 index 0000000000..1e7c451225 --- /dev/null +++ b/extra/math/approx/summary.txt @@ -0,0 +1 @@ +Approximating rational numbers.