Artifact 76435eb1e2f3931a2572cd58ca032ec2f233507202cd7619a84eed90c525ebbe:
- File
r34/lib/pmrules.log
— part of check-in
[f2fda60abd]
at
2011-09-02 18:13:33
on branch master
— Some historical releases purely for archival purposes
git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 8046) [annotate] [blame] [check-ins using] [more...]
REDUCE 3.4, 15-Jul-91 ... 1: *** ~ already defined as operator (PMRULES) % Tests of PM. % TESTS OF BASIC CONSTRUCTS. operator f, h$ % A "literal" template. m(f(a),f(a)); T % Not literally equal. m(f(a),f(b)); %Nested operators. m(f(a,h(b)),f(a,h(b))); T % A "generic" template. m(f(a,b),f(a,?a)); {?A->B} m(f(a,b),f(?a,?b)); {?A->A,?B->B} % ??a takes "rest" of arguments. m(f(a,b),f(??a)); {??A->[A,B]} % But ?a does not. m(f(a,b),f(?a)); % Conditional matches. m(f(a,b),f(?a,?b _=(?a=?b))); m(f(a,a),f(?a,?b _=(?a=?b))); {?A->A,?B->A} % "plus" is symmetric. m(a+b+c,c+?a+?b); {?A->A,?B->B} %It is also associative. m(a+b+c,c+?a); {?A->A + B} % Note the effect of using multi-generic symbol is different. m(a+b+c,c+??c); {??C->[A,B]} %Flag h as associative. flag('(h),'assoc); m(h(a,b,d,e),h(?a,d,?b)); {?A->H(A,B),?B->E} % Substitution tests. s(f(a,b),f(a,?b)->?b^2); 2 B s(a+b,a+b->a*b); A*B % "associativity" is used to group a+b+c in to (a+b) + c. s(a+b+c,a+b->a*b); A*B + C % Only substitute top at top level. s(a+b+f(a+b),a+b->a*b,inf,0); F(A + B) + A*B % SIMPLE OPERATOR DEFINITIONS. % Numerical factorial. operator nfac$ s(nfac(3),{nfac(0)->1,nfac(?x)->?x*nfac(?x-1)},1); 3*NFAC(2) s(nfac(3),{nfac(0)->1,nfac(?x)->?x*nfac(?x-1)},2); 6*NFAC(1) si(nfac(3),{nfac(0)->1,nfac(?x)->?x*nfac(?x-1)}); 6 % General factorial. operator gamma,fac; fac(?x _=Natp(?x)) ::- ?x*fac(?x-1); HOLD(?X*FAC(?X - 1)) fac(0) :- 1; 1 fac(?x) :- Gamma(?x+1); GAMMA(?X + 1) fac(3); 6 fac(3/2); 5 GAMMA(---) 2 % Legendre polynomials in ?x of order ?n, ?n a natural number. operator legp; legp(?x,0) :- 1; 1 legp(?x,1) :- ?x; ?X legp(?x,?n _=natp(?n)) ::- ((2*?n-1)*?x*legp(?x,?n-1)-(?n-1)*legp(?x,?n-2))/?n; (2*?N - 1)*?X*LEGP(?X,?N - 1) - (?N - 1)*LEGP(?X,?N - 2) HOLD(----------------------------------------------------------) ?N legp(z,5); 4 2 Z*(63*Z - 70*Z + 15) ------------------------ 8 legp(a+b,3); 3 2 2 3 5*A + 15*A *B + 15*A*B - 3*A + 5*B - 3*B --------------------------------------------- 2 legp(x,y); LEGP(X,Y) % TESTS OF EXTENSIONS TO BASIC PATTERN MATCHER. comment *: MSet[?exprn,?val] or ?exprn ::: ?val assigns the value ?val to the projection ?exprn in such a way as to store explicitly each form of ?exprn requested. *; Nosimp('mset,(t t)); Newtok '((!: !: !: !-) Mset); infix :::-; precedence Mset,RSetd; ?exprn :::- ?val ::- (?exprn ::- (?exprn :- ?val )); HOLD(?EXPRN::-(?EXPRN:-?VAL)) scs := sin(?x)^2 + Cos(?x)^2 -> 1; 2 2 SCS := SIN(?X) + COS(?X) ->1 % The following pattern substitutes the rule sin^2 + cos^2 into a sum of % such terms. For 2n terms (ie n sin and n cos) the pattern has a worst % case complexity of O(n^3). operator trig,u; trig(?i) :::- Ap(+, Ar(?i,sin(u(?1))^2+Cos(u(?1))^2)); 2 2 HOLD(TRIG(?I):-AP(PLUS,AR(?I,SIN(U(?1)) + COS(U(?1)) ))) if si(trig 1,scs) = 1 then write("Pm ok") else Write("PM failed"); Pm ok if si(trig 10,scs) = 10 then write("Pm ok") else Write("PM failed"); Pm ok % The next one takes about 70 seconds on an HP 9000/350, calling UNIFY % 1927 times. % if si(trig 50,scs) = 50 then write("Pm ok") else Write("PM failed"); % Hypergeometric Function simplification. newtok '((!#) !#); *** # redefined flag('(#), 'symmetric); operator #,@,ghg; xx := ghg(4,3,@(a,b,c,d),@(d,1+a-b,1+a-c),1); XX := GHG(4,3,@(A,B,C,D),@(D,A - B + 1,A - C + 1),1) S(xx,sghg(3)); *** SGHG declared operator GHG(4,3,@(A,B,C,D),@(D,A - B + 1,A - C + 1),1) s(ws,sghg(2)); GHG(4,3,@(A,B,C,D),@(D,A - B + 1,A - C + 1),1) yy := ghg(3,2,@(a-1,b,c/2),@((a+b)/2,c),1); C A + B YY := GHG(3,2,@(A - 1,B,---),@(-------,C),1) 2 2 S(yy,sghg(1)); C A + B GHG(3,2,@(A - 1,B,---),@(-------,C),1) 2 2 yy := ghg(3,2,@(a-1,b,c/2),@(a/2+b/2,c),1); C A + B YY := GHG(3,2,@(A - 1,B,---),@(-------,C),1) 2 2 S(yy,sghg(1)); C A + B GHG(3,2,@(A - 1,B,---),@(-------,C),1) 2 2 % Some Ghg theorems. flag('(@), 'symmetric); % Watson's Theorem. SGhg(1) := Ghg(3,2,@(?a,?b,?c),@(?d _=?d=(1+?a+?b)/2,?e _=?e=2*?c),1) -> Gamma(1/2)*Gamma(?c+1/2)*Gamma((1+?a+?b)/2)*Gamma((1-?a-?b)/2+?c)/ (Gamma((1+?a)/2)*Gamma((1+?b)/2)*Gamma((1-?a)/2+?c) *Gamma((1-?b)/2+?c)); SGHG(1) := GHG(3,2,@(?A,?B,?C), 1 + ?A + ?B @(?D _= ?D=-------------,?E _= ?E=2*?C),1)->( 2 - ?A - ?B + 2*?C + 1 2*?C + 1 GAMMA(-----------------------)*GAMMA(----------) 2 2 ?A + ?B + 1 1 *GAMMA(-------------)*GAMMA(---))/( 2 2 - ?A + 2*?C + 1 - ?B + 2*?C + 1 GAMMA(------------------)*GAMMA(------------------) 2 2 ?A + 1 ?B + 1 *GAMMA(--------)*GAMMA(--------)) 2 2 % Dixon's theorem. SGhg(2) := Ghg(3,2,@(?a,?b,?c),@(?d _=?d=1+?a-?b,?e _=?e=1+?a-?c),1) -> Gamma(1+?a/2)*Gamma(1+?a-?b)*Gamma(1+?a-?c)*Gamma(1+?a/2-?b-?c)/ (Gamma(1+?a)*Gamma(1+?a/2-?b)*Gamma(1+?a/2-?c)*Gamma(1+?a-?b-?c)); SGHG(2) := GHG(3,2,@(?A,?B,?C), @(?D _= ?D=1 + ?A - ?B,?E _= ?E=1 + ?A - ?C),1)->( ?A - 2*?B - 2*?C + 2 ?A + 2 GAMMA(----------------------)*GAMMA(--------) 2 2 *GAMMA(?A - ?B + 1)*GAMMA(?A - ?C + 1))/( ?A - 2*?B + 2 ?A - 2*?C + 2 GAMMA(---------------)*GAMMA(---------------) 2 2 *GAMMA(?A - ?B - ?C + 1)*GAMMA(?A + 1)) SGhg(3) := Ghg(?p,?q,@(?a,??b),@(?a,??c),?z) -> Ghg(?p-1,?q-1,@(??b),@(??c),?z); SGHG(3) := GHG(?P,?Q,@(??B,?A),@(?A,??C),?Z) ->GHG(?P - 1,?Q - 1,@(??B),@(??C),?Z) SGhg(9) := Ghg(1,0,@(?a),?b,?z ) -> (1-?z)^(-?a); 1 SGHG(9) := GHG(1,0,@(?A),?B,?Z)->--------------- ?A ( - ?Z + 1) SGhg(10) := Ghg(0,0,?a,?b,?z) -> E^?z; ?Z SGHG(10) := GHG(0,0,?A,?B,?Z)->E SGhg(11) := Ghg(?p,?q,@(??t),@(??b),0) -> 1; SGHG(11) := GHG(?P,?Q,@(??T),@(??B),0)->1 % If one of the bottom parameters is zero or a negative integer the % hypergeometric functions may be singular, so the presence of a % functions of this type causes a warning message to be printed. % Note it seems to have an off by one level spec., so this may need % changing in future. % % Reference: AS 15.1; Slater, Generalized Hypergeometric Functions, % Cambridge University Press,1966. s(Ghg(3,2,@(a,b,c),@(b,c),z),SGhg(3)); GHG(2,1,@(A,B),@(B),Z) si(Ghg(3,2,@(a,b,c),@(b,c),z),{SGhg(3),Sghg(9)}); 1 ------------- A ( - Z + 1) S(Ghg(3,2,@(a-1,b,c),@(a-b,a-c),1),sghg 2); A - 2*B - 2*C + 1 A + 1 GAMMA(-------------------)*GAMMA(-------)*GAMMA(A - B)*GAMMA(A - C) 2 2 --------------------------------------------------------------------- A - 2*B + 1 A - 2*C + 1 GAMMA(-------------)*GAMMA(-------------)*GAMMA(A - B - C)*GAMMA(A) 2 2 end; Quitting