home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / CLISP-1.LHA / CLISP960530-sr.lha / src / rational.d < prev    next >
Encoding:
Text File  |  1996-04-15  |  28.4 KB  |  771 lines
  1. # Rationale Zahlen
  2.  
  3. # Liefert zu den Integers a und b mit b>1 und ggT(a,b)=1 den Bruch a/b.
  4. # I_I_to_RT(a,b)
  5. # kann GC auslösen
  6.   #define I_I_to_RT  make_ratio
  7.  
  8. # Liefert zu den Integers a und b mit b>0 und ggT(a,b)=1 den Bruch a/b
  9. # (Ratio oder Integer).
  10. # I_I_to_RA(a,b)
  11. # kann GC auslösen
  12.   local object I_I_to_RA (object a, object b);
  13. # Methode:
  14. # falls b=1, a als Ergebnis, sonst der echte Bruch a/b.
  15.   local object I_I_to_RA(a,b)
  16.     var reg2 object a;
  17.     var reg1 object b;
  18.     { if (eq(b,Fixnum_1))
  19.         { return a; }
  20.         else
  21.         { return I_I_to_RT(a,b); }
  22.     }
  23.   # define I_I_to_RA(a,b)  (eq(b,Fixnum_1) ? a : I_I_to_RT(a,b))
  24.  
  25. # Liefert zu den Integers a und b mit b>0 den Bruch a/b (Ratio oder Integer).
  26. # kann GC auslösen
  27.   local object I_posI_durch_RA (object a, object b);
  28. # Methode:
  29. # d:=ggT(a,b).
  30. # Falls d=1: I_I_to_RA anwenden,
  31. # sonst: I_I_to_RA auf a/d und b/d anwenden.
  32.   local object I_posI_durch_RA(a,b)
  33.     var reg3 object a;
  34.     var reg2 object b;
  35.     { pushSTACK(a); pushSTACK(b); # a,b retten
  36.      {var reg1 object d = I_I_gcd_I(a,b); # ggT(a,b) >0
  37.       if (eq(d,Fixnum_1)) # d=1 ?
  38.         { b = popSTACK(); a = popSTACK();
  39.           return I_I_to_RA(a,b);
  40.         }
  41.         else
  42.         { # Stackaufbau: a, b.
  43.           pushSTACK(d);
  44.           STACK_2 = I_I_exquo_I(STACK_2,d); # a/d bilden
  45.           d = popSTACK();
  46.           # Stackaufbau: a/d, b.
  47.           b = I_I_exquopos_I(popSTACK(),d); # b/d bilden (b,d>0)
  48.           return I_I_to_RA(popSTACK(),b); # (a/d)/(b/d)
  49.         }
  50.     }}
  51.  
  52. # Liefert zu den Integers a und b den Bruch a/b (Ratio oder Integer).
  53. # I_I_durch_RA(a,b)
  54. # kann GC auslösen
  55.   local object I_I_durch_RA (object a, object b);
  56. # Methode:
  57. # Falls b=0: Error.
  58. # Falls b>0: I_posI_durch_RA anwenden.
  59. # Falls b<0: I_posI_durch_RA auf (- a) und (- b) anwenden.
  60.   local object I_I_durch_RA(a,b)
  61.     var reg2 object a;
  62.     var reg1 object b;
  63.     { if (eq(b,Fixnum_0)) { divide_0(); }
  64.       if (R_minusp(b)) # b<0 ?
  65.         { pushSTACK(b); a = I_minus_I(a); b = STACK_0; # a := (- a)
  66.           STACK_0 = a; b = I_minus_I(b); a = popSTACK(); # b := (- b)
  67.         }
  68.       return I_posI_durch_RA(a,b);
  69.     }
  70.  
  71. # Liefert Zähler und Nenner einer rationalen Zahl.
  72. # RA_numden_I_I(r, num=,den=);
  73. # > r: rationale Zahl
  74. # < num: (numerator r)
  75. # < den: (denominator r)
  76.   #define RA_numden_I_I(r,num_zuweisung,den_zuweisung)  \
  77.     { if (RA_integerp(r))                                                         \
  78.         { num_zuweisung r; den_zuweisung Fixnum_1; } # Zähler = r, Nenner = 1     \
  79.         else                                                                      \
  80.         { num_zuweisung TheRatio(r)->rt_num; den_zuweisung TheRatio(r)->rt_den; } \
  81.     }
  82.  
  83. # Liefert (- r), wo r eine rationale Zahl ist.
  84. # RA_minus_RA(r)
  85. # kann GC auslösen
  86.   local object RA_minus_RA (object r);
  87. # Methode:
  88. # r Integer -> klar.
  89. # r = a/b -> Ergebnis (- a)/b
  90.   local object RA_minus_RA(r)
  91.     var reg1 object r;
  92.     { if (RA_integerp(r))
  93.         { return I_minus_I(r); }
  94.         else
  95.         { pushSTACK(TheRatio(r)->rt_den); # b retten
  96.          {var reg2 object a = TheRatio(r)->rt_num;
  97.           a = I_minus_I(a); # (- a)
  98.           # Immer noch b>1 und ggT(-a,b) = ggT(a,b) = 1
  99.           return I_I_to_RT(a,popSTACK());
  100.         }}
  101.     }
  102.  
  103. # (+ r s), wo r und s rationale Zahlen sind.
  104. # RA_RA_plus_RA(r,s)
  105. # kann GC auslösen
  106.   local object RA_RA_plus_RA (object r, object s);
  107. # Methode (vgl. [Buchberger, Collins, Loos: Computer Algebra, S.200-201])
  108. # r,s beide Integers -> klar.
  109. # r=a/b, s=c -> Ergebnis (a+b*c)/b
  110. #   (mit b>1 und ggT(a+b*c,b) = ggT(a,b) = 1)
  111. #   Bei c=0 direkt r als Ergebnis.
  112. # r=a, s=c/d -> Ergebnis (a*d+c)/d
  113. #   (mit d>1 und ggT(a*d+c,d) = ggT(c,d) = 1)
  114. #   Bei a=0 direkt s als Ergebnis.
  115. # r=a/b, s=c/d:
  116. #   g:=ggT(b,d)>0.
  117. #   Falls g=1:
  118. #     Ergebnis (a*d+b*c)/(b*d),
  119. #     (mit b*d>1 wegen b>1, d>1, und
  120. #      ggT(a*d+b*c,b*d) = 1
  121. #      wegen ggT(a*d+b*c,b) = ggT(a*d,b) = 1 (wegen ggT(a,b)=1 und ggT(d,b)=1)
  122. #      und   ggT(a*d+b*c,d) = ggT(b*c,d) = 1 (wegen ggT(b,d)=1 und ggT(c,d)=1)
  123. #     )
  124. #   Sonst b' := b/g, d' := d/g. e := a*d'+b'*c, f:= b'*d = b*d'.
  125. #   Es ist g = ggT(g*b',g*d') = g*ggT(b',d'), also ggT(b',d')=1.
  126. #   Es ist r+s = (a*d+b*c)/(b*d) = (nach Kürzen mit g) e/f.
  127. #   Außerdem:
  128. #     ggT(a,b') teilt ggT(a,b)=1, also ggT(a,b')=1. Mit ggT(d',b')=1 folgt
  129. #     1 = ggT(a*d',b') = ggT(a*d'+b'*c,b') = ggT(e,b').
  130. #     ggT(c,d') teilt ggT(c,d)=1, also ggT(c,d')=1. Mit ggT(b',d')=1 folgt
  131. #     1 = ggT(b'*c,d') = ggT(a*d'+b'*c,d') = ggT(e,d').
  132. #     Daher ist ggT(e,f) = ggT(e,b'*d'*g) = ggT(e,g).
  133. #   Errechne daher h=ggT(e,g).
  134. #   Bei h=1 ist e/f das Ergebnis (mit f>1, da d>1, und ggT(e,f)=1),
  135. #   sonst ist (e/h)/(f/h) das Ergebnis.
  136.   local object RA_RA_plus_RA(r,s)
  137.     var reg2 object r;
  138.     var reg1 object s;
  139.     { if (RA_integerp(s))
  140.         # s ist Integer
  141.         { if (eq(s,Fixnum_0)) { return r; } # s=0 -> r als Ergebnis
  142.           if (RA_integerp(r))
  143.             # beides Integers
  144.             { return I_I_plus_I(r,s); }
  145.             else
  146.             # r = a/b, s = c.
  147.             { var reg3 object x = TheRatio(r)->rt_den; # b
  148.               pushSTACK(x); pushSTACK(TheRatio(r)->rt_num); # b und a retten
  149.               x = I_I_mal_I(x,s); # b*c
  150.               x = I_I_plus_I(popSTACK(),x); # a+b*c
  151.               return I_I_to_RT(x,popSTACK()); # Bruch (a+b*c)/b
  152.         }   }
  153.         else
  154.         # s ist Ratio
  155.         { if (RA_integerp(r))
  156.             # r ist Integer
  157.             { if (eq(r,Fixnum_0)) { return s; } # r=0 -> s als Ergebnis
  158.               # r = a, s = c/d.
  159.              {var reg3 object x = TheRatio(s)->rt_den; # d
  160.               pushSTACK(x); pushSTACK(TheRatio(s)->rt_num); # d und c retten
  161.               x = I_I_mal_I(r,x); # a*d
  162.               x = I_I_plus_I(x,popSTACK()); # a*d+c
  163.               return I_I_to_RT(x,popSTACK()); # Bruch (a*d+c)/d
  164.             }}
  165.             else
  166.             # r,s beide Ratios
  167.             { var reg3 object g;
  168.               {var reg4 object b;
  169.                var reg5 object d;
  170.                pushSTACK(TheRatio(r)->rt_num); # a retten
  171.                pushSTACK(b = TheRatio(r)->rt_den); # b retten
  172.                pushSTACK(TheRatio(s)->rt_num); # c retten
  173.                pushSTACK(d = TheRatio(s)->rt_den); # d retten
  174.                # Stackaufbau: a, b, c, d.
  175.                g = I_I_gcd_I(b,d); # g = ggT(b,d) >0 bilden
  176.               }
  177.               if (eq(g,Fixnum_1))
  178.                 # g=1 -> Ergebnis (a*d+b*c)/(b*d)
  179.                 { var reg4 object x;
  180.                   STACK_3 = I_I_mal_I(STACK_3,STACK_0); # a*d
  181.                   # Stackaufbau: a*d, b, c, d.
  182.                   x = I_I_mal_I(STACK_2,STACK_1); # b*c
  183.                   STACK_3 = I_I_plus_I(STACK_3,x); # a*d+b*c
  184.                   # Stackaufbau: a*d+b*c, b, c, d.
  185.                   x = I_I_mal_I(STACK_2,STACK_0); skipSTACK(3); # b*d
  186.                   return I_I_to_RT(popSTACK(),x); # (a*d+b*c)/(b*d)
  187.                 }
  188.                 else
  189.                 # g>1
  190.                 { var reg4 object x;
  191.                   pushSTACK(g);
  192.                   # Stackaufbau: a, b, c, d, g.
  193.                   STACK_3 = I_I_exquopos_I(STACK_3,g); # b' := b/g (b,g>0)
  194.                   # Stackaufbau: a, b', c, d, g.
  195.                   x = I_I_exquopos_I(STACK_1,STACK_0); # d' := d/g (d,g>0)
  196.                   STACK_4 = I_I_mal_I(STACK_4,x); # a*d'
  197.                   # Stackaufbau: a*d', b', c, d, g.
  198.                   x = I_I_mal_I(STACK_3,STACK_2); # b'*c
  199.                   STACK_4 = I_I_plus_I(STACK_4,x); # e := a*d'+b'*c
  200.                   # Stackaufbau: e, b', c, d, g.
  201.                   STACK_3 = I_I_mal_I(STACK_3,STACK_1); # f := b'*d
  202.                   # Stackaufbau: e, f, c, d, g.
  203.                   x = I_I_gcd_I(STACK_4,STACK_0); skipSTACK(3); # h := ggT(e,g)
  204.                   # Stackaufbau: e, f.
  205.                   if (eq(x,Fixnum_1))
  206.                     # h=1
  207.                     { var reg5 object f = popSTACK();
  208.                       var reg4 object e = popSTACK();
  209.                       return I_I_to_RT(e,f); # Bruch e/f bilden
  210.                     }
  211.                     else
  212.                     # h>1
  213.                     { pushSTACK(x);
  214.                       # Stackaufbau: e, f, h.
  215.                       STACK_2 = I_I_exquo_I(STACK_2,x); # e/h bilden
  216.                       # Stackaufbau: e/h, f, h.
  217.                       x = popSTACK(); # h
  218.                       x = I_I_exquopos_I(popSTACK(),x); # f/h bilden (f,h>0)
  219.                       return I_I_to_RA(popSTACK(),x); # (e/h)/(f/h) als Ergebnis
  220.     }   }   }   }   }
  221.  
  222. # (- r s), wo r und s rationale Zahlen sind.
  223. # RA_RA_minus_RA(r,s)
  224. # kann GC auslösen
  225.   local object RA_RA_minus_RA (object r, object s);
  226. #if 0
  227. # Methode:
  228. # (+ r (- s))
  229.   local object RA_RA_minus_RA(r,s)
  230.     var reg2 object r;
  231.     var reg1 object s;
  232.     { pushSTACK(r); s = RA_minus_RA(s);
  233.       return RA_RA_plus_RA(popSTACK(),s);
  234.     }
  235. #else
  236. # Methode (vgl. [Buchberger, Collins, Loos: Computer Algebra, S.200-201])
  237. # r,s beide Integers -> klar.
  238. # r=a/b, s=c -> Ergebnis (a-b*c)/b
  239. #   (mit b>1 und ggT(a-b*c,b) = ggT(a,b) = 1)
  240. #   Bei c=0 direkt r als Ergebnis.
  241. # r=a, s=c/d -> Ergebnis (a*d-c)/d
  242. #   (mit d>1 und ggT(a*d-c,d) = ggT(-c,d) = ggT(c,d) = 1)
  243. #   Bei a=0 direkt -s = (-c)/d als Ergebnis.
  244. # r=a/b, s=c/d:
  245. #   g:=ggT(b,d)>0.
  246. #   Falls g=1:
  247. #     Ergebnis (a*d-b*c)/(b*d),
  248. #     (mit b*d>1 wegen b>1, d>1, und
  249. #      ggT(a*d-b*c,b*d) = 1
  250. #      wegen ggT(a*d-b*c,b) = ggT(a*d,b) = 1 (wegen ggT(a,b)=1 und ggT(d,b)=1)
  251. #      und   ggT(a*d-b*c,d) = ggT(b*c,d) = 1 (wegen ggT(b,d)=1 und ggT(c,d)=1)
  252. #     )
  253. #   Sonst b' := b/g, d' := d/g. e := a*d'-b'*c, f:= b'*d = b*d'.
  254. #   Es ist g = ggT(g*b',g*d') = g*ggT(b',d'), also ggT(b',d')=1.
  255. #   Es ist r-s = (a*d-b*c)/(b*d) = (nach Kürzen mit g) e/f.
  256. #   Außerdem:
  257. #     ggT(a,b') teilt ggT(a,b)=1, also ggT(a,b')=1. Mit ggT(d',b')=1 folgt
  258. #     1 = ggT(a*d',b') = ggT(a*d'-b'*c,b') = ggT(e,b').
  259. #     ggT(c,d') teilt ggT(c,d)=1, also ggT(c,d')=1. Mit ggT(b',d')=1 folgt
  260. #     1 = ggT(b'*c,d') = ggT(a*d'-b'*c,d') = ggT(e,d').
  261. #     Daher ist ggT(e,f) = ggT(e,b'*d'*g) = ggT(e,g).
  262. #   Errechne daher h=ggT(e,g).
  263. #   Bei h=1 ist e/f das Ergebnis (mit f>1, da d>1, und ggT(e,f)=1),
  264. #   sonst ist (e/h)/(f/h) das Ergebnis.
  265.   local object RA_RA_minus_RA(r,s)
  266.     var reg2 object r;
  267.     var reg1 object s;
  268.     { if (RA_integerp(s))
  269.         # s ist Integer
  270.         { if (eq(s,Fixnum_0)) { return r; } # s=0 -> r als Ergebnis
  271.           if (RA_integerp(r))
  272.             # beides Integers
  273.             { return I_I_minus_I(r,s); }
  274.             else
  275.             # r = a/b, s = c.
  276.             { var reg3 object x = TheRatio(r)->rt_den; # b
  277.               pushSTACK(x); pushSTACK(TheRatio(r)->rt_num); # b und a retten
  278.               x = I_I_mal_I(x,s); # b*c
  279.               x = I_I_minus_I(popSTACK(),x); # a-b*c
  280.               return I_I_to_RT(x,popSTACK()); # Bruch (a-b*c)/b
  281.         }   }
  282.         else
  283.         # s ist Ratio
  284.         { if (RA_integerp(r))
  285.             # r ist Integer
  286.             { if (eq(r,Fixnum_0))
  287.                 # r=0 -> -s = (-c)/d als Ergebnis
  288.                 { pushSTACK(TheRatio(s)->rt_den); # d
  289.                   s = I_minus_I(TheRatio(s)->rt_num); # -c
  290.                   return I_I_to_RT(s,popSTACK());
  291.                 }
  292.               # r = a, s = c/d.
  293.              {var reg3 object x = TheRatio(s)->rt_den; # d
  294.               pushSTACK(x); pushSTACK(TheRatio(s)->rt_num); # d und c retten
  295.               x = I_I_mal_I(r,x); # a*d
  296.               x = I_I_minus_I(x,popSTACK()); # a*d-c
  297.               return I_I_to_RT(x,popSTACK()); # Bruch (a*d-c)/d
  298.             }}
  299.             else
  300.             # r,s beide Ratios
  301.             { var reg3 object g;
  302.               {var reg4 object b;
  303.                var reg5 object d;
  304.                pushSTACK(TheRatio(r)->rt_num); # a retten
  305.                pushSTACK(b = TheRatio(r)->rt_den); # b retten
  306.                pushSTACK(TheRatio(s)->rt_num); # c retten
  307.                pushSTACK(d = TheRatio(s)->rt_den); # d retten
  308.                # Stackaufbau: a, b, c, d.
  309.                g = I_I_gcd_I(b,d); # g = ggT(b,d) >0 bilden
  310.               }
  311.               if (eq(g,Fixnum_1))
  312.                 # g=1 -> Ergebnis (a*d-b*c)/(b*d)
  313.                 { var reg4 object x;
  314.                   STACK_3 = I_I_mal_I(STACK_3,STACK_0); # a*d
  315.                   # Stackaufbau: a*d, b, c, d.
  316.                   x = I_I_mal_I(STACK_2,STACK_1); # b*c
  317.                   STACK_3 = I_I_minus_I(STACK_3,x); # a*d-b*c
  318.                   # Stackaufbau: a*d-b*c, b, c, d.
  319.                   x = I_I_mal_I(STACK_2,STACK_0); skipSTACK(3); # b*d
  320.                   return I_I_to_RT(popSTACK(),x); # (a*d-b*c)/(b*d)
  321.                 }
  322.                 else
  323.                 # g>1
  324.                 { var reg4 object x;
  325.                   pushSTACK(g);
  326.                   # Stackaufbau: a, b, c, d, g.
  327.                   STACK_3 = I_I_exquopos_I(STACK_3,g); # b' := b/g (b,g>0)
  328.                   # Stackaufbau: a, b', c, d, g.
  329.                   x = I_I_exquopos_I(STACK_1,STACK_0); # d' := d/g (d,g>0)
  330.                   STACK_4 = I_I_mal_I(STACK_4,x); # a*d'
  331.                   # Stackaufbau: a*d', b', c, d, g.
  332.                   x = I_I_mal_I(STACK_3,STACK_2); # b'*c
  333.                   STACK_4 = I_I_minus_I(STACK_4,x); # e := a*d'-b'*c
  334.                   # Stackaufbau: e, b', c, d, g.
  335.                   STACK_3 = I_I_mal_I(STACK_3,STACK_1); # f := b'*d
  336.                   # Stackaufbau: e, f, c, d, g.
  337.                   x = I_I_gcd_I(STACK_4,STACK_0); skipSTACK(3); # h := ggT(e,g)
  338.                   # Stackaufbau: e, f.
  339.                   if (eq(x,Fixnum_1))
  340.                     # h=1
  341.                     { var reg5 object f = popSTACK();
  342.                       var reg4 object e = popSTACK();
  343.                       return I_I_to_RT(e,f); # Bruch e/f bilden
  344.                     }
  345.                     else
  346.                     # h>1
  347.                     { pushSTACK(x);
  348.                       # Stackaufbau: e, f, h.
  349.                       STACK_2 = I_I_exquo_I(STACK_2,x); # e/h bilden
  350.                       # Stackaufbau: e/h, f, h.
  351.                       x = popSTACK(); # h
  352.                       x = I_I_exquopos_I(popSTACK(),x); # f/h bilden (f,h>0)
  353.                       return I_I_to_RA(popSTACK(),x); # (e/h)/(f/h) als Ergebnis
  354.     }   }   }   }   }
  355. #endif
  356.  
  357. # (1+ r), wo r eine rationale Zahl ist.
  358. # RA_1_plus_RA(r)
  359. # kann GC auslösen
  360.   local object RA_1_plus_RA (object r);
  361. # Methode:
  362. # Falls r ein Integer ist: I_1_plus_I anwenden
  363. # Falls r = a/b: (a+b)/b, wobei b>1 und ggT(a+b,b)=ggT(a,b)=1 ist.
  364.   local object RA_1_plus_RA(r)
  365.     var reg1 object r;
  366.     { if (RA_integerp(r))
  367.         { return I_1_plus_I(r); }
  368.         else
  369.         { var reg2 object x;
  370.           x = TheRatio(r)->rt_den; pushSTACK(x); # b
  371.           x = I_I_plus_I(TheRatio(r)->rt_num,x); # a+b
  372.           return I_I_to_RT(x,popSTACK()); # (a+b)/b
  373.     }   }
  374.  
  375. # (1- r), wo r eine rationale Zahl ist.
  376. # RA_minus1_plus_RA(r)
  377. # kann GC auslösen
  378.   local object RA_minus1_plus_RA (object r);
  379. # Methode:
  380. # Falls r ein Integer ist: I_minus1_plus_I anwenden
  381. # Falls r = a/b: (a-b)/b, wobei b>1 und ggT(a-b,b)=ggT(a,b)=1 ist.
  382.   local object RA_minus1_plus_RA(r)
  383.     var reg1 object r;
  384.     { if (RA_integerp(r))
  385.         { return I_minus1_plus_I(r); }
  386.         else
  387.         { var reg2 object x;
  388.           x = TheRatio(r)->rt_den; pushSTACK(x); # b
  389.           x = I_I_minus_I(TheRatio(r)->rt_num,x); # a-b
  390.           return I_I_to_RT(x,popSTACK()); # (a-b)/b
  391.     }   }
  392.  
  393. # RA_RA_comp(r,s) vergleicht zwei rationale Zahlen r und s.
  394. # Ergebnis: 0 falls r=s, +1 falls r>s, -1 falls r<s.
  395. # kann GC auslösen
  396.   local signean RA_RA_comp (object r, object s);
  397. # Methode:
  398. # r,s Integer -> klar
  399. # r<0, s>=0 -> r<s.
  400. # r>=0, s<0 -> r>s.
  401. # r Integer, s Ratio: r=a, s=b/c. Vergleiche a*c und b.
  402. # r Ratio, s Integer: r=a/b, s=c. Vergleiche a und b*c.
  403. # r,s Ratios: r=a/b, s=c/d. Vergleiche a*d und b*c.
  404.   local signean RA_RA_comp(r,s)
  405.     var reg1 object r;
  406.     var reg2 object s;
  407.     { # 1. Schritt: Test, ob beides Integers:
  408.       if (RA_integerp(r) && RA_integerp(s))
  409.         { return I_I_comp(r,s); }
  410.       # r,s nicht beide Integers.
  411.       # 2. Schritt: Test, ob die Vorzeichen bereits das Ergebnis hergeben:
  412.       if (R_minusp(r))
  413.         { if (!R_minusp(s)) { return signean_minus; } } # r<0, s>=0 -> r<s
  414.         else
  415.         { if (R_minusp(s)) { return signean_plus; } } # r>=0, s<0 -> r>s
  416.       # r,s haben gleiches Vorzeichen.
  417.       # 3. Schritt: Fallunterscheidung nach Typen
  418.       if (RA_integerp(r))
  419.         # r Integer, s Ratio: r=a, s=b/c. Vergleiche a*c und b.
  420.         { pushSTACK(TheRatio(s)->rt_num); # b
  421.           r = I_I_mal_I(r,TheRatio(s)->rt_den); # a*c
  422.           return I_I_comp(r,popSTACK()); # mit b vergleichen
  423.         }
  424.       elif (RA_integerp(s))
  425.         # r Ratio, s Integer: r=a/b, s=c. Vergleiche a und b*c.
  426.         { pushSTACK(TheRatio(r)->rt_num); # a
  427.           s = I_I_mal_I(TheRatio(r)->rt_den,s); # b*c
  428.           return I_I_comp(popSTACK(),s); # und a damit vergleichen
  429.         }
  430.       else
  431.         # r,s Ratios: r=a/b, s=c/d. Vergleiche a*d und b*c.
  432.         { pushSTACK(TheRatio(r)->rt_num); # a
  433.           pushSTACK(TheRatio(s)->rt_den); # d
  434.           # Stackaufbau: a, d.
  435.          {var reg3 object x = I_I_mal_I(TheRatio(r)->rt_den,TheRatio(s)->rt_num); # b*c
  436.           var reg4 object a = STACK_1;
  437.           STACK_1 = x;
  438.           # Stackaufbau: b*c, d.
  439.           x = I_I_mal_I(a,popSTACK()); # a*d
  440.           return I_I_comp(x,popSTACK()); # a*d und b*c vergleichen
  441.         }}
  442.     }
  443.  
  444. # Kehrwert (/ r), wo r eine rationale Zahl ist.
  445. # RA_durch_RA(r)
  446. # kann GC auslösen
  447.   local object RA_durch_RA (object r);
  448. # Methode:
  449. # r=0 -> Error.
  450. # a:=(numerator r), b:=(denominator r).
  451. # a>0 -> Ergebnis b/a (mit ggT(b,a)=1).
  452. # a<0 -> Ergebnis (- b)/(- a) (mit ggT(-b,-a)=1).
  453.   local object RA_durch_RA(r)
  454.     var reg1 object r;
  455.     { if (eq(r,Fixnum_0)) { divide_0(); } # Test auf 0
  456.      {var reg2 object a;
  457.       var reg3 object b;
  458.       RA_numden_I_I(r,a=,b=); # a:=(numerator r), b:=(denominator r)
  459.       if (R_minusp(a))
  460.         # a<0
  461.         { pushSTACK(a); b = I_minus_I(b); a = STACK_0; # b := (- b)
  462.           STACK_0 = b; a = I_minus_I(a); b = popSTACK(); # a := (- a)
  463.         }
  464.       return I_I_to_RA(b,a);
  465.     }}
  466.  
  467. # Liefert (* r s), wo r und s rationale Zahlen sind.
  468. # RA_RA_mal_RA(r,s)
  469. # kann GC auslösen
  470.   local object RA_RA_mal_RA (object r, object s);
  471. # Methode (vgl. [Buchberger, Collins, Loos: Computer Algebra, S.201])
  472. # r,s beide Integers -> klar.
  473. # r=a/b, s=c ->
  474. #   Bei c=0 Ergebnis 0.
  475. #   g:=ggT(b,c).
  476. #   Falls g=1: Ergebnis (a*c)/b (mit b>1, ggT(a*c,b)=1).
  477. #   Sonst: b':=b/g, c':=c/g, Ergebnis (a*c')/b' (mit ggT(a*c',b')=1).
  478. # r=a, s=c/d analog.
  479. # r=a/b, s=c/d ->
  480. #   g:=ggT(a,d), h:=ggT(b,c).
  481. #   a':=a/g, d':=d/g (nur bei g>1 bedeutet das Rechnung).
  482. #   b':=b/h, c':=c/h (nur bei h>1 bedeutet das Rechnung).
  483. #   Ergebnis ist = (a'*c')/(b'*d').
  484.   local object RA_RA_mal_RA(r,s)
  485.     var reg2 object r;
  486.     var reg1 object s;
  487.     { var reg4 object a;
  488.       var reg5 object b;
  489.       var reg6 object c;
  490.       if (RA_integerp(s))
  491.         # s Integer
  492.         { if (RA_integerp(r))
  493.             # beides Integer
  494.             { return I_I_mal_I(r,s); }
  495.             else
  496.             # r=a/b, s=c
  497.             { a = TheRatio(r)->rt_num; b = TheRatio(r)->rt_den; c = s;
  498.               mixed: # Bilde a/b * c
  499.               if (eq(c,Fixnum_0)) { return c; } # c=0 -> Ergebnis 0
  500.               pushSTACK(b); pushSTACK(a); pushSTACK(c);
  501.               # Stackaufbau: b, a, c.
  502.               {var reg3 object g = I_I_gcd_I(b,c); # g := ggT(b,c)
  503.                if (eq(g,Fixnum_1))
  504.                  # g=1
  505.                  { c = popSTACK(); # c
  506.                    c = I_I_mal_I(popSTACK(),c); # a*c
  507.                    return I_I_to_RT(c,popSTACK()); # (a*c)/b
  508.                  }
  509.                  else
  510.                  # g>1
  511.                  { pushSTACK(g);
  512.                    # Stackaufbau: b, a, c, g.
  513.                    STACK_3 = I_I_exquopos_I(STACK_3,g); # b' := b/g (b,g>0)
  514.                    # Stackaufbau: b', a, c, g.
  515.                    g = popSTACK();
  516.                    c = I_I_exquo_I(popSTACK(),g); # c' := c/g
  517.                    c = I_I_mal_I(popSTACK(),c); # a*c'
  518.                    return I_I_to_RA(c,popSTACK()); # (a*c')/b'
  519.         }   } }  }
  520.         else
  521.         # s ist Ratio
  522.         { if (RA_integerp(r))
  523.             # r=c, s=a/b
  524.             { a = TheRatio(s)->rt_num; b = TheRatio(s)->rt_den; c = r;
  525.               goto mixed;
  526.             }
  527.             else
  528.             # r,s beide Ratios
  529.             { var reg7 object d;
  530.               a = TheRatio(r)->rt_num; pushSTACK(a); # a
  531.               pushSTACK(TheRatio(r)->rt_den); # b
  532.               d = TheRatio(s)->rt_den; pushSTACK(d); # d
  533.               pushSTACK(TheRatio(s)->rt_num); # c
  534.               # Stackaufbau: a, b, d, c.
  535.               {var reg3 object g = I_I_gcd_I(a,d); # g := ggT(a,d)
  536.                if (!eq(g,Fixnum_1))
  537.                  # bei g>1: dividiere a und d durch g
  538.                  { a = STACK_3; STACK_3 = g;
  539.                    a = I_I_exquo_I(a,g); # a':=a/g
  540.                    g = STACK_3; STACK_3 = a;
  541.                    STACK_1 = I_I_exquopos_I(STACK_1,g); # d':=d/g (d,g>0)
  542.               }  }
  543.               # Stackaufbau: a', b, d', c.
  544.               {var reg3 object h = I_I_gcd_I(STACK_2,STACK_0); # h := ggT(b,c)
  545.                if (!eq(h,Fixnum_1))
  546.                  # bei h>1: dividiere c und b durch h
  547.                  { c = STACK_0; STACK_0 = h;
  548.                    c = I_I_exquo_I(c,h); # c':=c/h
  549.                    h = STACK_0; STACK_0 = c;
  550.                    STACK_2 = I_I_exquopos_I(STACK_2,h); # b':=b/h (b,h>0)
  551.               }  }
  552.               # Stackaufbau: a', b', d', c'.
  553.               c = popSTACK(); STACK_2 = I_I_mal_I(STACK_2,c); # a'*c'
  554.               # Stackaufbau: a'*c', b', d'.
  555.               d = popSTACK(); d = I_I_mal_I(popSTACK(),d); # b'*d'
  556.               # Stackaufbau: a'*c'.
  557.               return I_I_to_RA(popSTACK(),d); # (a'*c')/(b'*d')
  558.     }   }   }
  559.  
  560. # Liefert (/ r s), wo r und s rationale Zahlen sind.
  561. # RA_RA_durch_RA(r,s)
  562. # kann GC auslösen
  563.   local object RA_RA_durch_RA (object r, object s);
  564. # Methode:
  565. # (* r (/ s))
  566.   local object RA_RA_durch_RA(r,s)
  567.     var reg2 object r;
  568.     var reg1 object s;
  569.     { if (RA_integerp(r) && RA_integerp(s)) # r und s Integers?
  570.         { return I_I_durch_RA(r,s); } # ja -> schnell abhandeln
  571.       pushSTACK(r);
  572.       s = RA_durch_RA(s); # (/ s)
  573.       return RA_RA_mal_RA(popSTACK(),s);
  574.     }
  575.  
  576. # Liefert ganzzahligen und gebrochenen Anteil einer rationalen Zahl.
  577. # (q,r) := (truncate x)
  578. # RA_truncate_I_RA(x);
  579. # > x: rationale Zahl
  580. # < STACK_1: Quotient q, ein Integer
  581. # < STACK_0: Rest r, eine rationale Zahl
  582. # Erniedrigt STACK um 2
  583. # kann GC auslösen
  584.   local void RA_truncate_I_RA (object x);
  585. # Methode:
  586. # x Integer -> (q,r) := (x,0)
  587. # x Ratio a/b ->
  588. #   (truncate a b) liefert q und r.
  589. #   Liefere q und r/b (mit b>1 und ggT(r,b)=ggT(r+q*b,b)=ggT(a,b)=1).
  590.   local void RA_truncate_I_RA(x)
  591.     var reg1 object x;
  592.     { if (RA_integerp(x))
  593.         { pushSTACK(x); pushSTACK(Fixnum_0); } # (q,r) := (x,0)
  594.         else
  595.         { var reg2 object b = TheRatio(x)->rt_den;
  596.           pushSTACK(b);
  597.           I_I_truncate_I_I(TheRatio(x)->rt_num,b); # (truncate a b)
  598.           # Stackaufbau: b, q, r.
  599.           b = STACK_2;
  600.           STACK_2 = STACK_1; # q unverändert
  601.          {var reg3 object r = popSTACK();
  602.           STACK_0 = I_I_to_RT(r,b);
  603.     }   }}
  604.  
  605. # Liefert ganzzahligen und gebrochenen Anteil einer rationalen Zahl.
  606. # (q,r) := (floor x)
  607. # RA_floor_I_RA(x);
  608. # > x: rationale Zahl
  609. # < STACK_1: Quotient q, ein Integer
  610. # < STACK_0: Rest r, eine rationale Zahl
  611. # Erniedrigt STACK um 2
  612. # kann GC auslösen
  613.   local void RA_floor_I_RA (object x);
  614. # Methode:
  615. # x Integer -> (q,r) := (x,0)
  616. # x Ratio a/b ->
  617. #   (floor a b) liefert q und r.
  618. #   Liefere q und r/b (mit b>1 und ggT(r,b)=ggT(r+q*b,b)=ggT(a,b)=1).
  619.   local void RA_floor_I_RA(x)
  620.     var reg1 object x;
  621.     { if (RA_integerp(x))
  622.         { pushSTACK(x); pushSTACK(Fixnum_0); } # (q,r) := (x,0)
  623.         else
  624.         { var reg2 object b = TheRatio(x)->rt_den;
  625.           pushSTACK(b);
  626.           I_I_floor_I_I(TheRatio(x)->rt_num,b); # (floor a b)
  627.           # Stackaufbau: b, q, r.
  628.           b = STACK_2;
  629.           STACK_2 = STACK_1; # q unverändert
  630.          {var reg3 object r = popSTACK();
  631.           STACK_0 = I_I_to_RT(r,b);
  632.     }   }}
  633.  
  634. # Liefert ganzzahligen und gebrochenen Anteil einer rationalen Zahl.
  635. # (q,r) := (ceiling x)
  636. # RA_ceiling_I_RA(x);
  637. # > x: rationale Zahl
  638. # < STACK_1: Quotient q, ein Integer
  639. # < STACK_0: Rest r, eine rationale Zahl
  640. # Erniedrigt STACK um 2
  641. # kann GC auslösen
  642.   local void RA_ceiling_I_RA (object x);
  643. # Methode:
  644. # x Integer -> (q,r) := (x,0)
  645. # x Ratio a/b ->
  646. #   (ceiling a b) liefert q und r.
  647. #   Liefere q und r/b (mit b>1 und ggT(r,b)=ggT(r+q*b,b)=ggT(a,b)=1).
  648.   local void RA_ceiling_I_RA(x)
  649.     var reg1 object x;
  650.     { if (RA_integerp(x))
  651.         { pushSTACK(x); pushSTACK(Fixnum_0); } # (q,r) := (x,0)
  652.         else
  653.         { var reg2 object b = TheRatio(x)->rt_den;
  654.           pushSTACK(b);
  655.           I_I_ceiling_I_I(TheRatio(x)->rt_num,b); # (ceiling a b)
  656.           # Stackaufbau: b, q, r.
  657.           b = STACK_2;
  658.           STACK_2 = STACK_1; # q unverändert
  659.          {var reg3 object r = popSTACK();
  660.           STACK_0 = I_I_to_RT(r,b);
  661.     }   }}
  662.  
  663. # Liefert ganzzahligen und gebrochenen Anteil einer rationalen Zahl.
  664. # (q,r) := (round x)
  665. # RA_round_I_RA(x);
  666. # > x: rationale Zahl
  667. # < STACK_1: Quotient q, ein Integer
  668. # < STACK_0: Rest r, eine rationale Zahl
  669. # Erniedrigt STACK um 2
  670. # kann GC auslösen
  671.   local void RA_round_I_RA (object x);
  672. # Methode:
  673. # x Integer -> (q,r) := (x,0)
  674. # x Ratio a/b ->
  675. #   (round a b) liefert q und r.
  676. #   Liefere q und r/b (mit b>1 und ggT(r,b)=ggT(r+q*b,b)=ggT(a,b)=1).
  677.   local void RA_round_I_RA(x)
  678.     var reg1 object x;
  679.     { if (RA_integerp(x))
  680.         { pushSTACK(x); pushSTACK(Fixnum_0); } # (q,r) := (x,0)
  681.         else
  682.         { var reg2 object b = TheRatio(x)->rt_den;
  683.           pushSTACK(b);
  684.           I_I_round_I_I(TheRatio(x)->rt_num,b); # (round a b)
  685.           # Stackaufbau: b, q, r.
  686.           b = STACK_2;
  687.           STACK_2 = STACK_1; # q unverändert
  688.          {var reg3 object r = popSTACK();
  689.           STACK_0 = I_I_to_RT(r,b);
  690.     }   }}
  691.  
  692. # RA_I_expt_RA(x,y) = (expt x y), wo x eine rationale Zahl und y ein Integer >0 ist.
  693. # kann GC auslösen
  694.   local object RA_I_expt_RA (object x, object y);
  695.   # Methode:
  696.   # x Integer -> klar
  697.   # x Ratio a/b -> x^y = (a^y)/(b^y), gekürzt, mit b^y>=b>1.
  698.   local object RA_I_expt_RA(x,y)
  699.     var reg1 object x;
  700.     var reg2 object y;
  701.     { if (RA_integerp(x))
  702.         { return I_I_expt_I(x,y); }
  703.         else
  704.         { pushSTACK(y);
  705.           pushSTACK(TheRatio(x)->rt_den);
  706.           x = I_I_expt_I(TheRatio(x)->rt_num,y); # a^y
  707.           y = STACK_1; STACK_1 = x;
  708.           x = I_I_expt_I(popSTACK(),y); # b^y
  709.           return I_I_to_RT(popSTACK(),x); # (a^y)/(b^y)
  710.         }
  711.     }
  712.  
  713. # Stellt fest, ob eine rationale Zahl >=0 das Quadrat einer rationalen Zahl
  714. # ist.
  715. # RA_sqrtp(x)
  716. # > x: eine rationale Zahl >=0
  717. # < ergebnis: exakte Wurzel (sqrt x) falls x Quadrat, nullobj sonst
  718. # kann GC auslösen
  719.   local object RA_sqrtp (object x);
  720. # Methode:
  721. # Bei Integers: klar.
  722. # Bei Brüchen a/b : muß a=c^2 und b=d^2 sein. Dann ist die Wurzel = c/d
  723. # (mit ggT(c,d)=1 und d>1).
  724.   local object RA_sqrtp(x)
  725.     var reg1 object x;
  726.     { if (RA_integerp(x))
  727.         { return I_sqrtp(x); }
  728.         else
  729.         # x ist Ratio
  730.         { pushSTACK(TheRatio(x)->rt_num); # Zähler retten
  731.           x = TheRatio(x)->rt_den;
  732.          {var reg2 object h = I_sqrtp(x); # Nenner auf Quadratzahl testen
  733.           if (eq(h,nullobj)) { skipSTACK(1); return nullobj; }
  734.           x = STACK_0; STACK_0 = h;
  735.           h = I_sqrtp(x); # Zähler auf Quadratzahl testen
  736.           if (eq(h,nullobj)) { skipSTACK(1); return nullobj; }
  737.           # beides Quadratzahlen -> Quotient der Wurzeln bilden
  738.           return I_I_to_RT(h,popSTACK());
  739.     }   }}
  740.  
  741. # Stellt fest, ob eine rationale Zahl >=0 die n-te Potenz einer rationalen Zahl
  742. # ist.
  743. # RA_rootp(x,n)
  744. # > x: eine rationale Zahl >=0
  745. # > n: ein Integer >0
  746. # < ergebnis: exakte n-te Wurzel (expt x (/ n)) falls eine n-te Potenz, nullobj sonst
  747. # kann GC auslösen
  748.   local object RA_rootp (object x, object n);
  749. # Methode:
  750. # Bei Integers: klar.
  751. # Bei Brüchen a/b : muß a=c^n und b=d^n sein. Dann ist die Wurzel = c/d
  752. # (mit ggT(c,d)=1 und d>1).
  753.   local object RA_rootp(x,n)
  754.     var reg1 object x;
  755.     var reg3 object n;
  756.     { if (RA_integerp(x))
  757.         { return I_rootp(x,n); }
  758.         else
  759.         # x ist Ratio
  760.         { pushSTACK(TheRatio(x)->rt_num); pushSTACK(n); # Zähler und n retten
  761.           x = TheRatio(x)->rt_den;
  762.          {var reg2 object h = I_rootp(x,n); # Nenner auf n-te Potenz testen
  763.           if (eq(h,nullobj)) { skipSTACK(2); return nullobj; }
  764.           n = popSTACK(); x = STACK_0; STACK_0 = h;
  765.           h = I_rootp(x,n); # Zähler auf n-te Potenz testen
  766.           if (eq(h,nullobj)) { skipSTACK(1); return nullobj; }
  767.           # beides n-te Potenzen -> Quotient der Wurzeln bilden
  768.           return I_I_to_RT(h,popSTACK());
  769.     }   }}
  770.  
  771.