lib/mlton/basic/rational.fun

   1 (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  *
   4  * MLton is released under a BSD-style license.
   5  * See the file MLton-LICENSE for details.
   6  *)
   7 (*-------------------------------------------------------------------*)
   8 (*                             Rational                              *)
   9 (*-------------------------------------------------------------------*)
  10
  11 functor Rational(I : INTEGER) : RATIONAL =
  12 struct
  13
  14 structure F =
  15    struct
  16       structure I = I
  17       open I
  18
  19       datatype t = T of I.t * I.t
  20       (* always use smallest nonnegative denominator *)
  21
  22       fun numerator(T(n,_)) = n
  23       fun denominator(T(_,n)) = n
  24
  25       fun fromInt n = T(n,I.one)
  26
  27       (*fun intTo = ITo o I.intTo*)
  28       (*val toInt = I.toInt o toI*)
  29
  30       fun isInt q = denominator q = one
  31
  32       exception ToInt
  33       fun toInt q = if isInt q then numerator q
  34                     else raise ToInt
  35
  36       fun toReal(T(p,q)) = I.toReal p / I.toReal q
  37
  38       val zero = fromInt I.zero
  39       val one = fromInt I.one
  40
  41       fun scale(T(p,q),T(p',q')) =
  42          let val l = I.lcm(q,q')
  43          in (p * (l div q'),
  44              p' * (l div q),
  45              l)
  46          end
  47
  48       val (op +) = fn (x,y) =>
  49          let val (p,p',l) = scale(x,y)
  50          in T(p + p',l)
  51          end
  52
  53       fun inverse(T(p,q)) = if I.isNegative p then T(I.~ q,I.~ p)
  54                             else T(q,p)
  55
  56       val (op ~) = fn T(m,n) => T(~m,n)
  57
  58       fun reduce(p,q) =
  59          let val g = I.gcd(p,q)
  60          in (p div g, q div g)
  61          end
  62
  63       fun make(p,q) = T(reduce(p,q))
  64
  65       fun intIntTo(m,n) = make(I.fromInt m,I.fromInt n)
  66
  67       fun (T(p,q)) * (T(p',q')) =
  68          let val (p,q') = reduce(p,q')
  69             val (p',q) = reduce(p',q)
  70          in T(I.*(p,p'),I.*(q,q'))
  71          end
  72
  73       fun compare(x,y) =
  74          let val (p,q,_) = scale(x,y)
  75          in I.compare(p,q)
  76          end
  77
  78       val {<,<=,>,>=,equal,min,max} = Relation.compare compare
  79       val op = = equal
  80
  81       (*fun random(x,y) =
  82        let val(p,p',q) = scale(x,y)
  83    in T(I.random(p,p'),q)
  84    end
  85        *)
  86       exception FromString
  87       fun stringTo _ = raise FromString
  88       (*fun toString(T(p,q)) = String.concat[I.toString p,
  89        "/",
  90        I.toString q]
  91        *)
  92       exception Input
  93       fun input _ = raise Input
  94
  95       fun output(p,out) =
  96          if isInt p then I.output(toInt p,out)
  97          else (I.output(numerator p,out) ;
  98                Out.output(out,"/") ;
  99                I.output(denominator p,out))
 100    end
 101
 102 structure R = OrderedField(F)
 103 open F R
 104
 105 end