home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / language / elan.sit / rat / RATPACK.E next >
Encoding:
Text File  |  1988-11-09  |  2.8 KB  |  161 lines
  1. PACKET rational numbers:
  2.  
  3. TYPE RAT = STRUCT (INT denom, nomin);
  4.  
  5. RAT PROC zero:
  6.   RAT: [0, 1]
  7. ENDPROC zero;
  8.  
  9. INT PROC sign (RAT CONST n):
  10.   sign (n.denom) * sign (n.nomin)
  11. ENDPROC sign;
  12.  
  13. REAL PROC real (RAT CONST a):
  14.   real (a.denom) / real (a.nomin)
  15. ENDPROC real;
  16.  
  17. PROC put val (RAT CONST a):
  18.   TEXT CONST s :: sign of a;
  19.   INT VAR t :: abs (a.denom), n :: abs (a.nomin);
  20.   put (" " + s);
  21.   TEXT CONST h :: text (t DIV n);
  22.   t := 10 * (t MOD n);
  23.   put (h + ".");
  24.   UPTO 36 - length (h)
  25.   REP one digit
  26.   ENDREP.
  27.  
  28.   one digit:
  29.     put ("0123456789" SUB t DIV n + 1);
  30.     t := 10 * (t MOD n).
  31.  
  32.   sign of a:
  33.     IF a < zero
  34.     THEN "-"
  35.     ELSE " "
  36.     FI.
  37. ENDPROC put val;
  38.  
  39. PROC put (RAT CONST a):
  40.   TEXT CONST sign :: sign of a;
  41.   TEXT CONST t :: " " + sign + text (abs (a.denom)) + "/" + text (abs (a.nomin));
  42.   put (t).
  43.  
  44.   sign of a:
  45.     IF a < zero
  46.     THEN "-"
  47.     ELSE " "
  48.     FI.
  49. ENDPROC put;
  50.  
  51. RAT PROC one:
  52.   RAT: [1, 1]
  53. ENDPROC one;
  54.  
  55. INT PROC lcm (INT CONST denom, nomin):
  56.   denom DIV gcd (denom, nomin) * nomin
  57. ENDPROC lcm;
  58.  
  59. PROC get (RAT VAR a):
  60.   INT VAR d, n;
  61.   get (d);
  62.   get (n);
  63.   a := fract (d, n)
  64. ENDPROC get;
  65.  
  66. INT PROC gcd (INT CONST denom, nomin):
  67.   IF nomin <= 0
  68.   THEN denom
  69.   ELIF nomin > denom
  70.   THEN gcd (nomin, denom)
  71.   ELSE gcd (nomin, denom MOD nomin)
  72.   FI
  73. ENDPROC gcd;
  74.  
  75. RAT PROC fract (INT CONST denom, nomin):
  76.   INT CONST s :: sign (denom) * sign (nomin);
  77.   IF nomin = 0
  78.   THEN assert (false)
  79.   FI;
  80.   INT CONST c :: gcd (abs (denom), abs (nomin));
  81.   RAT: [s * abs (denom) DIV c, abs (nomin) DIV c]
  82. ENDPROC fract;
  83.  
  84. RAT PROC cont fract (INT CONST k, n):
  85.   IF k > n
  86.   THEN zero
  87.   ELSE b (k) / (a (k) + cont fract (k + 1, n))
  88.   FI
  89. ENDPROC cont fract;
  90.  
  91. RAT OP RECIP (RAT CONST a):
  92.   RAT: [a.nomin, a.denom]
  93. ENDOP RECIP;
  94.  
  95. INT OP NOMIN (RAT CONST a):
  96.   a.nomin
  97. ENDOP NOMIN;
  98.  
  99. INT OP DENOM (RAT CONST a):
  100.   a.denom
  101. ENDOP DENOM;
  102.  
  103. BOOL OP >= (RAT CONST a, b):
  104.   NOT a < b
  105. ENDOP >=;
  106.  
  107. BOOL OP > (RAT CONST a, b):
  108.   b < a
  109. ENDOP >;
  110.  
  111. BOOL OP = (RAT CONST a, b):
  112.   a.denom = b.denom AND a.nomin = b.nomin
  113. ENDOP =;
  114.  
  115. BOOL OP <> (RAT CONST a, b):
  116.   NOT a = b
  117. ENDOP <>;
  118.  
  119. BOOL OP <= (RAT CONST a, b):
  120.   NOT b < a
  121. ENDOP <=;
  122.  
  123. BOOL OP < (RAT CONST a, b):
  124.   a.denom * b.nomin < a.nomin * b.denom
  125. ENDOP <;
  126.  
  127. RAT OP / (RAT CONST a, b):
  128.   a * RECIP b
  129. ENDOP /;
  130.  
  131. RAT OP / (INT CONST a, RAT CONST b):
  132.   RECIP b * RAT: [a, 1]
  133. ENDOP /;
  134.  
  135. RAT OP - (RAT CONST a):
  136.   RAT: [- a.denom, a.nomin]
  137. ENDOP -;
  138.  
  139. RAT OP - (RAT CONST a, b):
  140.   a + - b
  141. ENDOP -;
  142.  
  143. RAT OP + (RAT CONST a, b):
  144.   fract (a.denom * b.nomin + b.denom * a.nomin, a.nomin * b.nomin)
  145. ENDOP +;
  146.  
  147. RAT OP + (INT CONST a, RAT CONST b):
  148.   b + RAT: [a, 1]
  149. ENDOP +;
  150.  
  151. RAT OP * (RAT CONST a, b):
  152.   RAT CONST c :: fract (a.denom, b.nomin), d :: fract (b.denom, a.nomin);
  153.   RAT: [c.denom * d.denom, c.nomin * d.nomin]
  154. ENDOP *;
  155.  
  156. RAT OP * (INT CONST a, RAT CONST b):
  157.   b * RAT: [a, 1]
  158. ENDOP *;
  159.  
  160. ENDPACKET rational numbers;
  161.