extra/math/approx/approx.factor

   1 ! Copyright (C) 2010 John Benediktsson.
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: combinators kernel locals math math.functions ;
   5
   6 IN: math.approx
   7
   8 <PRIVATE
   9
  10 :: (simplest) ( n d n' d' -- val ) ! assumes 0 < n/d < n'/d'
  11     n  d  /mod :> ( q  r  )
  12     n' d' /mod :> ( q' r' )
  13     {
  14         { [ r zero? ] [ q ] }
  15         { [ q q' = not ] [ q 1 + ] }
  16         [
  17             d' r' d r (simplest) >fraction :> ( n'' d'' )
  18             q n'' * d'' + n'' /
  19         ]
  20     } cond ;
  21
  22 :: simplest ( x y -- val )
  23     {
  24         { [ x y > ] [ y x simplest ] }
  25         { [ x y = ] [ x ] }
  26         { [ x 0 > ] [ x y [ >fraction ] bi@ (simplest) ] }
  27         { [ y 0 < ] [ y x [ neg >fraction ] bi@ (simplest) neg ] }
  28         [ 0 ]
  29     } cond ;
  30
  31 : check-float ( x -- x )
  32     dup float? [ "can't be floats" throw ] when ;
  33
  34 PRIVATE>
  35
  36 : approximate ( x epsilon -- y )
  37     [ check-float ] bi@ [ - ] [ + ] 2bi simplest ;
  38