a2dip.red 3.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596
  1. module a2dip;
  2. % Convert an algebraic (prefix) form to distributive polynomial
  3. % Authors: R. Gebauer, A. C. Hearn, H. Kredel
  4. % Modified by: H. Melenk.
  5. symbolic procedure a2dip u;
  6. % Converts the algebraic (prefix) form u to a distributive poly.
  7. % We assume that all variables used have been previously
  8. % defined in dipvars!*, but a check is also made for this
  9. if atom u then a2dipatom u
  10. else if not atom car u or not idp car u
  11. then typerr(car u,"dipoly operator")
  12. % Handling expt separately because the exponents should
  13. % not be simplified as domain elements.
  14. else if car u='expt then dipfnpow(a2dip cadr u,caddr u)
  15. else (if x then apply(x,list for each y in cdr u collect a2dip y)
  16. else a2dipatom u)
  17. where x=get(car u,'dipfn);
  18. symbolic procedure a2dipatom u;
  19. % Converts the atom (or kernel) u into a distributive polynomial
  20. if u=0 then dipzero
  21. else if numberp u or not(u member dipvars!*)
  22. then dipfmon(a2bc u,evzero())
  23. else dipfmon(a2bc 1,mkexpvec u);
  24. symbolic procedure dipfnsum u;
  25. % U is a list of dip expressions. Result is the distributive poly
  26. % representation for the sum
  27. (<<for each y in cdr u do x:=dipsum(x,y);x>>)where x=car u;
  28. put('plus,'dipfn,'dipfnsum);
  29. symbolic procedure dipfnprod u;
  30. % U is a list of dip expressions. Result is the distributive poly
  31. % representation for the product
  32. % Maybe we should check for a zero
  33. (<<for each y in cdr u do x:=dipprod(x,y);x>>)where x=car u;
  34. put('times,'dipfn,'dipfnprod);
  35. symbolic procedure dipfndif u;
  36. % U is a list of two dip expressions. Result is the distributive
  37. % polynomial representation for the difference
  38. dipsum(car u,dipneg cadr u);
  39. put('difference,'dipfn,'dipfndif);
  40. symbolic procedure dipfnpow(v,n);
  41. % V is a dip. Result is the distributive poly v**n.
  42. (if not fixp n or n<0
  43. then typerr(n,"distributive polynomial exponent")
  44. else if n=0 then if dipzero!? v then rerror(dipoly,1,"0**0 invalid")
  45. else w
  46. else if dipzero!? v or n=1 then v
  47. else if dipzero!? dipmred v
  48. then dipfmon(bcpow(diplbc v,n),intevprod(n,dipevlmon v))
  49. else <<while n>0 do
  50. <<if not evenp n then w:=dipprod(w,v);
  51. n:=n/2;
  52. if n>0 then v:=dipprod(v,v)>>;
  53. w>>)
  54. where w:=dipfmon(a2bc 1,evzero());
  55. % put('expt,'dipfn,'dipfnpow);
  56. symbolic procedure dipfnneg u;
  57. % U is a list of one dip expression. Result is the distributive
  58. % polynomial representation for the negative
  59. (if dipzero!? v then v
  60. else dipmoncomp(bcneg diplbc v,dipevlmon v,dipmred v))
  61. where v=car u;
  62. put('minus,'dipfn,'dipfnneg);
  63. symbolic procedure dipfnquot u;
  64. % U is a list of two dip expressions. Result is the distributive
  65. % polynomial representation for the quotient
  66. if dipzero!? cadr u or not dipzero!? dipmred cadr u
  67. or not evzero!? dipevlmon cadr u
  68. or (!*vdpinteger and not bcone!? diplbc cadr u)
  69. then typerr(dip2a cadr u,"distributive polynomial denominator")
  70. else dipfnquot1(car u,diplbc cadr u);
  71. symbolic procedure dipfnquot1(u,v);
  72. if dipzero!? u then u
  73. else dipmoncomp(bcquot(diplbc u,v),
  74. dipevlmon u,
  75. dipfnquot1(dipmred u,v));
  76. put('quotient,'dipfn,'dipfnquot);
  77. endmodule;;end ;