exptf.red 2.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263
  1. module exptf; % Functions for raising canonical forms to a power.
  2. % Author: Anthony C. Hearn.
  3. % Copyright (c) 1990 The RAND Corporation. All rights reserved.
  4. fluid '(!*exp);
  5. symbolic procedure exptsq(u,n);
  6. begin scalar x;
  7. if n=1 then return u
  8. else if n=0
  9. then return if null numr u then rerror(poly,4," 0**0 formed")
  10. else 1 ./ 1
  11. else if null numr u then return u
  12. else if n<0 then return simpexpt list(mk!*sq u,n)
  13. else if null !*exp
  14. then return mksfpf(numr u,n) ./ mksfpf(denr u,n)
  15. else if kernp u then return mksq(mvar numr u,n)
  16. else if denr u=1 then return exptf(numr u,n) ./ 1
  17. else if domainp numr u
  18. then x := multsq(!:expt(numr u,n) ./ 1,1 ./ exptf(denr u,n))
  19. else <<x := u;
  20. % Since U is in lowest terms, then so is U^N.
  21. while (n := n-1)>0
  22. do x := multf(numr u,numr x) ./ multf(denr u,denr x);
  23. % We need canonsq for a:=1+x/2; let x^2=0; a^2;
  24. x := canonsq x>>;
  25. if null cdr x then rerror(poly,101,"Zero divisor");
  26. return x
  27. end;
  28. symbolic procedure exptf(u,n);
  29. if domainp u then !:expt(u,n)
  30. else if !*exp or kernlp u then exptf1(u,n)
  31. else mksfpf(u,n);
  32. symbolic procedure exptf1(u,n);
  33. % Iterative multiplication seems to be faster than a binary sub-
  34. % division algorithm, probably because multiplying a small polynomial
  35. % by a large one is cheaper than multiplying two medium sized ones.
  36. if n=0 then 1
  37. else begin scalar x;
  38. x := u; while (n := n-1)>0 do x := multf(u,x); return x
  39. end;
  40. symbolic procedure exptf2(u,n);
  41. % Binary version of EXPTF1, Used with EXP off, since expressions
  42. % formed in that case tend to be smaller than with EXP on.
  43. if n=0 then 1
  44. else begin scalar x; integer m;
  45. x := 1;
  46. a: m := n;
  47. if m-2*(n := n/2) neq 0 then x := multf(u,x);
  48. if n=0 then return x;
  49. u := multf(u,u);
  50. go to a
  51. end;
  52. endmodule;
  53. end;