int.red 2.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081
  1. module int; % Header for REDUCE integration package.
  2. % Authors: A. C. Norman and P. M. A. Moore.
  3. % Modified by: J. Davenport, J. P. Fitch, A. C. Hearn.
  4. % Note that at one point, INT had been flagged SIMP0FN. However, that
  5. % lead to problems when the arguments of INT contained pattern
  6. % variables.
  7. create!-package('(int contents csolve idepend df2q distrib divide driver
  8. symint intfac ibasics makevars jpatches reform
  9. simpsqrt hacksqrt sqrtf isolve tidysqrt trcase
  10. halfangl trialdiv vect dint), % simplog
  11. % cuberoot d3d4 factr kron lowdeg unifac uniform tdiff
  12. '(int trans));
  13. fluid '(!*noextend !*pvar frlis!* gaussiani);
  14. global '(gensymcount initl!*);
  15. !*pvar:='!_a;
  16. gaussiani := !*kk2f '(sqrt -1);
  17. gensymcount := 0;
  18. initl!* := append('(!*noextend), initl!*);
  19. flag('(interr),'transfer); %For the compiler;
  20. flag ('(atan dilog ei erf expt log tan),'transcendental);
  21. comment Kludge to define derivative of an integral and integral of
  22. a derivative;
  23. frlis!* := union('(!=x !=y),frlis!*);
  24. put('df,'opmtch,'(((int !=y !=x) !=x) (nil . t)
  25. (evl!* !=y) nil) . get('df,'opmtch));
  26. put('int,'opmtch,'(((df !=y !=x) !=x) (nil . t)
  27. (evl!* !=y) nil) . get('int,'opmtch));
  28. put('evl!*,'opmtch,'(((!=x) (nil . t) !=x nil)));
  29. put('evl!*,'simpfn,'simpiden);
  30. % Various functions used throughout the integrator.
  31. symbolic procedure flatten u;
  32. if null u then nil
  33. else if atom u then list u
  34. else if atom car u then car u . flatten cdr u
  35. else nconc(flatten car u,flatten cdr u);
  36. symbolic procedure int!-gensym1 u;
  37. <<gensymcount:=gensymcount+1;
  38. compress append(explode '!!,
  39. append(explode u,explode gensymcount))>>;
  40. symbolic procedure mknill n; if n=0 then nil else nil . mknill(n-1);
  41. symbolic procedure printc u; prin2t u; % This could be an smacro.
  42. % Selector written as an smacro.
  43. smacro procedure argof u;
  44. % Argument of a unary function.
  45. cadr u;
  46. put('nthroot,'simpfn,'simpiden);
  47. % The binary n-th root operator nthroot(x,2)=sqrt(x)
  48. % no simplification is used here.
  49. % Hope is that pbuild introduces it, and simplog removes it.
  50. endmodule;
  51. end;