src/Tools/rat.ML
changeset 23520 483fe92f00c1
parent 23297 06f108974fa1
child 24521 9565ac68c3cd
equal deleted inserted replaced
23519:a4ffa756d8eb 23520:483fe92f00c1
     1 (*  Title:      Pure/General/rat.ML
     1 (*  Title:      Pure/General/rat.ML
     2     ID:         $Id$
     2     ID:         $Id$
     3     Author:     Tobias Nipkow, TU Muenchen
     3     Author:     Tobias Nipkow, Florian Haftmann, TU Muenchen
     4 
     4 
     5 Canonical implementation of exact rational numbers.
     5 Canonical implementation of exact rational numbers.
     6 *)
     6 *)
     7 
     7 
     8 signature RAT =
     8 signature RAT =
    15   val rat_of_int: integer -> rat
    15   val rat_of_int: integer -> rat
    16   val rat_of_quotient: integer * integer -> rat
    16   val rat_of_quotient: integer * integer -> rat
    17   val quotient_of_rat: rat -> integer * integer
    17   val quotient_of_rat: rat -> integer * integer
    18   val string_of_rat: rat -> string
    18   val string_of_rat: rat -> string
    19   val eq: rat * rat -> bool
    19   val eq: rat * rat -> bool
    20   val cmp: rat * rat -> order
    20   val ord: rat * rat -> order
    21   val le: rat -> rat -> bool
    21   val le: rat -> rat -> bool
    22   val lt: rat -> rat -> bool
    22   val lt: rat -> rat -> bool
    23   val cmp_zero: rat -> order
    23   val signabs: rat -> order * rat
       
    24   val sign: rat -> order
       
    25   val abs: rat -> rat
    24   val add: rat -> rat -> rat
    26   val add: rat -> rat -> rat
    25   val mult: rat -> rat -> rat
    27   val mult: rat -> rat -> rat
    26   val neg: rat -> rat
    28   val neg: rat -> rat
    27   val inv: rat -> rat
    29   val inv: rat -> rat
       
    30   val rounddown: rat -> rat
    28   val roundup: rat -> rat
    31   val roundup: rat -> rat
    29   val rounddown: rat -> rat
       
    30 end;
    32 end;
    31 
    33 
    32 structure Rat : RAT =
    34 structure Rat : RAT =
    33 struct
    35 struct
    34 
    36 
    35 datatype rat = Rat of bool * integer * integer;
    37 fun common (p1, q1) (p2, q2) =
       
    38   let
       
    39     val m = Integer.lcm q1 q2;
       
    40   in ((Integer.mult p1 (Integer.div m q1), Integer.mult p2 (Integer.div m q2)), m) end;
       
    41 
       
    42 datatype rat = Rat of integer * integer; (* nominator, denominator (positive!) *)
    36 
    43 
    37 exception DIVZERO;
    44 exception DIVZERO;
    38 
    45 
    39 val zero = Rat (true, 0, 1);
       
    40 val one = Rat (true, 1, 1);
       
    41 val two = Rat (true, 2, 1);
       
    42 
       
    43 fun rat_of_int i =
       
    44   let
       
    45     val (a, p) = Integer.signabs i
       
    46   in Rat (a, p, 1) end;
       
    47 
       
    48 fun norm (a, p, q) =
       
    49   if p = 0 then Rat (true, 0, 1)
       
    50   else
       
    51     let
       
    52       val (b, absp) = Integer.signabs p;
       
    53       val m = Integer.gcd absp q;
       
    54     in Rat (a = b, absp div m, q div m) end;
       
    55 
       
    56 fun common (p1, q1, p2, q2) =
       
    57   let
       
    58     val q' = Integer.lcm q1 q2;
       
    59   in (p1 * (q' div q1), p2 * (q' div q2), q') end
       
    60 
       
    61 fun rat_of_quotient (p, q) =
    46 fun rat_of_quotient (p, q) =
    62   let
    47   let
    63     val (a, absq) = Integer.signabs q;
    48     val m = Integer.gcd (Integer.abs p) q
    64   in
    49   in Rat (Integer.div p m, Integer.div q m) end handle Div => raise DIVZERO;
    65     if absq = 0 then raise DIVZERO
       
    66     else norm (a, p, absq)
       
    67   end;
       
    68 
    50 
    69 fun quotient_of_rat (Rat (a, p, q)) = (if a then p else ~ p, q);
    51 fun quotient_of_rat (Rat r) = r;
    70 
    52 
    71 fun string_of_rat r =
    53 fun rat_of_int i = Rat (i, 1);
       
    54 
       
    55 val zero = rat_of_int 0;
       
    56 val one = rat_of_int 1;
       
    57 val two = rat_of_int 2;
       
    58 
       
    59 fun string_of_rat (Rat (p, q)) =
       
    60   Integer.string_of_int p ^ "/" ^ Integer.string_of_int q;
       
    61 
       
    62 fun eq (Rat (p1, q1), Rat (p2, q2)) = (p1 = p2 andalso q1 = q2);
       
    63 
       
    64 fun ord (Rat (p1, q1), Rat (p2, q2)) = case (Integer.sign p1, Integer.sign p2)
       
    65  of (LESS, EQUAL) => LESS
       
    66   | (LESS, GREATER) => LESS
       
    67   | (EQUAL, LESS) => GREATER
       
    68   | (EQUAL, EQUAL) => EQUAL
       
    69   | (EQUAL, GREATER) => LESS
       
    70   | (GREATER, LESS) => GREATER
       
    71   | (GREATER, EQUAL) => GREATER
       
    72   | _ => Integer.ord (fst (common (p1, q1) (p2, q2)));
       
    73 
       
    74 fun le a b = not (ord (a, b) = GREATER);
       
    75 fun lt a b = (ord (a, b) = LESS);
       
    76 
       
    77 fun sign (Rat (p, _)) = Integer.sign p;
       
    78 
       
    79 fun abs (Rat (p, q)) = Rat (Integer.abs p, q);
       
    80 
       
    81 fun signabs (Rat (p, q)) =
    72   let
    82   let
    73     val (p, q) = quotient_of_rat r;
    83     val (s, p') = Integer.signabs p;
    74   in Integer.string_of_int p ^ "/" ^ Integer.string_of_int q end;
    84   in (s, Rat (p', q)) end;
    75 
    85 
    76 fun eq (Rat (false, _, _), Rat (true, _, _)) = false
    86 fun add (Rat (p1, q1)) (Rat (p2, q2)) =
    77   | eq (Rat (true, _, _), Rat (false, _, _)) = false
    87   let
    78   | eq (Rat (_, p1, q1), Rat (_, p2, q2)) = p1 = p2 andalso q1 = q2;
    88     val ((m1, m2), n) = common (p1, q1) (p2, q2);
       
    89   in rat_of_quotient (Integer.add m1 m2, n) end;
    79 
    90 
    80 fun cmp (Rat (false, _, _), Rat (true, _, _)) = LESS
    91 fun mult (Rat (p1, q1)) (Rat (p2, q2)) =
    81   | cmp (Rat (true, _, _), Rat (false, _, _)) = GREATER
    92   rat_of_quotient (Integer.mult p1 p2, Integer.mult q1 q2);
    82   | cmp (Rat (a, p1, q1), Rat (_, p2, q2)) =
       
    83       let val (r1, r2, _) = common (p1, q1, p2, q2)
       
    84       in if a then Integer.cmp (r1, r2) else Integer.cmp (r2, r1) end;
       
    85 
    93 
    86 fun le a b = let val order = cmp (a, b) in order = LESS orelse order = EQUAL end;
    94 fun neg (Rat (p, q)) = Rat (Integer.neg p, q);
    87 fun lt a b = (cmp (a, b) = LESS);
       
    88 
    95 
    89 fun cmp_zero (Rat (false, _, _)) = LESS
    96 fun inv (Rat (p, 0)) = raise DIVZERO
    90   | cmp_zero (Rat (_, 0, _)) = EQUAL
    97   | inv (Rat (p, q)) = Rat (q, p);
    91   | cmp_zero (Rat (_, _, _)) = GREATER;
       
    92 
    98 
    93 fun add (Rat (a1, p1, q1)) (Rat(a2, p2, q2)) =
    99 fun rounddown (Rat (p, q)) = Rat (Integer.div p q, 1);
    94   let
       
    95     val (r1, r2, den) = common (p1, q1, p2, q2);
       
    96     val num = (if a1 then r1 else ~ r1)
       
    97       + (if a2 then r2 else ~ r2);
       
    98   in norm (true, num, den) end;
       
    99 
   100 
   100 fun mult (Rat (a1, p1, q1)) (Rat (a2, p2, q2)) =
   101 fun roundup (Rat (p, q)) = case Integer.divmod p q
   101   norm (a1 = a2, p1 * p2, q1 * q2);
   102  of (m, 0) => Rat (m, 1)
   102 
   103   | (m, _) => Rat (m + 1, 1);
   103 fun neg (r as Rat (b, p, q)) =
       
   104   if p = 0 then r
       
   105   else Rat (not b, p, q);
       
   106 
       
   107 fun inv (Rat (a, p, q)) =
       
   108   if q = 0 then raise DIVZERO
       
   109   else Rat (a, q, p);
       
   110 
       
   111 fun roundup (r as Rat (a, p, q)) =
       
   112   if q = 1 then r
       
   113   else
       
   114     let
       
   115       fun round true q = Rat (true, q + 1, 1)
       
   116         | round false q =
       
   117             Rat (q = 0, 0, 1);
       
   118     in round a (p div q) end;
       
   119 
       
   120 fun rounddown (r as Rat (a, p, q)) =
       
   121   if q = 1 then r
       
   122   else
       
   123     let
       
   124       fun round true q = Rat (true, q, 1)
       
   125         | round false q = Rat (false, q + 1, 1)
       
   126     in round a (p div q) end;
       
   127 
   104 
   128 end;
   105 end;
   129 
   106 
   130 infix 7 */ //;
   107 infix 7 */ //;
   131 infix 6 +/ -/;
   108 infix 6 +/ -/;