Artifact bf2a0166e16a1c109061a435d3aea12e21b0fe35415ceb9b563664ddbf6c1cc4:
- Executable file
r37/packages/defint/defint0.red
— 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: 9565) [annotate] [blame] [check-ins using] [more...]
- Executable file
r38/packages/defint/defint0.red
— 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: 9565) [annotate] [blame] [check-ins using]
module defint0; % Rules for definite integration. global '(unknown_tst product_tst transform_tst transform_lst); transform_lst := '(); fluid '(!*precise); global '(spec_cond); symbolic smacro procedure mynumberp(n); begin; if numberp n then t else if listp n and car n = 'quotient and (numberp cadr n or mynumberp cadr n) and (numberp caddr n or mynumberp caddr n) then 't else if listp n and car n = 'sqrt and (numberp cadr n or cadr n = 'pi) then t else nil; end; symbolic operator mynumberp; put('intgggg,'simpfn,'simpintgggg); % put('defint,'psopfn,'new_defint); symbolic procedure new_defint(lst); begin scalar var,result,n1,n2,n3,n4,!*precise; if eqcar(car lst,'times) then return new_defint append(cdar lst,cdr lst); unknown_tst := nil; var := nth(lst,length lst); if length lst = 2 and listp car lst then lst := test_prod(lst,var); transform_tst := reval algebraic(transform_tst); if transform_tst neq t then lst := hyperbolic_test(lst); for each i in lst do specfn_test(i); if length lst = 5 then <<n1 := car lst; n2 := cadr lst; n3 := caddr lst; n4 := cadddr lst; result := reval algebraic defint2(n1,n2,n3,n4,var)>> else if length lst = 4 then <<n1 := car lst; n2 := cadr lst; n3 := caddr lst; result := reval algebraic defint2(n1,n2,n3,var)>> else if length lst = 3 then <<n1 := car lst; n2 := cadr lst; result := reval algebraic defint2(n1,n2,var)>> else if length lst = 2 then <<n1 := car lst; result := reval algebraic defint2(n1,var)>>; algebraic(transform_tst := nil); if pairp result then <<for each i in result do test_unknown(i); % Tidy up result by ensuring that just unknown is returned % and not multiples of it. if unknown_tst then return 'UNKNOWN else return result>> else return result end; symbolic procedure specfn_test(n); begin; if listp n and car n = 'times then << if listp caddr n and (car caddr n = 'm_gegenbauerp or car caddr n = 'm_jacobip) then off exp; >>; end; symbolic procedure test_prod(lst,var); begin scalar temp,ls; temp := caar lst; if temp = 'times then << if listp caddar lst then % test for special cases of Meijer G-functions of compoud functions << if car caddar lst neq 'm_chebyshevt and car caddar lst neq 'm_chebyshevu and car caddar lst neq 'm_gegenbauerp and car caddar lst neq 'm_jacobip then ls := append(cdar lst,{var}) %else returned without change else ls := lst;>> else ls := append(cdar lst,{var}); >> else if temp = 'minus and caadar lst = 'times then << if length cadar lst = 3 then ls := {{'minus,car cdadar lst},cadr cdadar lst,var} else if length cadar lst = 4 then ls := {{'minus,car cdadar lst},cadr cdadar lst, caddr cdadar lst,var}>> else ls := lst; return ls; end; symbolic procedure test_unknown(n); % A procedure to test for unknown as the result of the integration % process if pairp n then << for each i in n do test_unknown(i)>> else if n = 'unknown then unknown_tst := 't; algebraic<< heaviside_rules := { heaviside(~x) => 1 when numberp x and x >= 0, heaviside(~x) => 0 when numberp x and x < 0 }; let heaviside_rules; operator defint2,defint_choose; SHARE MELLINCOEF$ defint2_rules:= { defint2(~n,cos((~x*~~A)/~~C)-cos((~x*~~B)/~~D),~x) => defint2(-2,n,sin((A/C+B/D)*x/2),sin((A/C-B/D)*x/2),x), defint2(cos((~x*~~A)/~~C)-cos((~x*~~B)/~~D),~x) => defint2(-2,sin((A/C+B/D)*x/2),sin((A/C-B/D)*x/2),x), defint2(~b,~f1,~f2,~x) => b*defint2(f1,f2,x) when freeof (b,x), defint2(~~b*~f1,~~c*~f2,~x) => b*c*defint2(f1,f2,x) when freeof (b,x) and freeof (c,x) and not(b = 1 and c = 1), defint2(~b/~f1,~c/~f2,~x) => c*b*defint2(1/f1,1/f2,x) when freeof (b,x) and freeof (c,x) and not(b = 1 and c = 1), defint2(~~b*~f1,~c/~f2,~x) => c*b*defint2(f1,1/f2,x) when freeof (b,x) and freeof (c,x) and not(b = 1 and c = 1), defint2(~b/~f1,~~c*~f2,~x) => c*b*defint2(1/f1,f2,x) when freeof (b,x) and freeof (c,x) and not(b = 1 and c = 1), defint2(~f1/~~b,~~c*~f2,~x) => c/b*defint2(f1,f2,x) when freeof (b,x) and freeof (c,x) and not(b = 1 and c = 1), defint2(~b/~f1,~x) => b*defint2(1/f1,x) when freeof (b,x) and not(b = 1), defint2(~~b*~f1,~x) => b*defint2(f1,x) when freeof (b,x) and not(b = 1), defint2(~f1/~~b,~x) => 1/b*defint2(f1,x) when freeof (b,x) and not(b = 1), defint2((~f2+ ~~f1)/~~f3,~x) => defint2(f2/f3,x) + defint2(f1/f3,x) when not(f1=0), defint2(-~f1,~x) => - defint2(f1,x), defint2((~f2+ ~~f1)/~~f3,~n,~x) => defint2(f2/f3,n,x) + defint2(f1/f3,n,x) when not(f1=0), defint2(-~f1,~n,~x) => - defint2(f1,n,x), defint2(~n,(~f2+ ~~f1)/~~f3,~x) => defint2(n,f2/f3,x) + defint2(n,f1/f3,x) when not(f1=0), defint2(~n,-~f1,~x) => - defint2(n,f1,x), defint2(~n,(~f2+ ~~f1)/~~f3,~nn,~x) => defint2(n,f2/f3,nn,x) + defint2(n,f1/f3,nn,x) when not(f1=0), defint2(~n,-~f1,~nn,~x) => - defint2(n,f1,nn,x), defint2(~n,~nn,(~f2+ ~~f1)/~~f3,~x) => defint2(n,nn,f2/f3,x) + defint2(n,nn,f1/f3,x) when not(f1=0), defint2(~n,~nn,-~f1,~x) => - defint2(n,nn,f1,x), defint2(~n,~x^~a,~f1,~f2,~x) => n*intgggg(defint_choose(f1,x),defint_choose(f2,x),a,x) when numberp n , defint2(~n,~x,~f1,~f2,~x) => n*intgggg(defint_choose(f1,x),defint_choose(f2,x),1,x) when numberp n , defint2(~n,1/~x^~~a,~f1,~f2,~x) => n*intgggg(defint_choose(f1,x),defint_choose(f2,x),-a,x) when numberp n , defint2(~n,1/~x,~f1,~f2,~x) => n*intgggg(defint_choose(f1,x),defint_choose(f2,x),-1,x) when numberp n , defint2(~n,sqrt(~x),~f1,~f2,~x) => n*intgggg(defint_choose(f1,x),defint_choose(f2,x),1/2,x) when numberp n , defint2(~n,sqrt(~x)*~x,~f1,~f2,~x) => n*intgggg(defint_choose(f1,x),defint_choose(f2,x),3/2,x) when numberp n , defint2(~n,sqrt(~x)*~x^~a,~f1,~f2,~x) => n*intgggg(defint_choose(f1,x),defint_choose(f2,x),1/2+a,x) when numberp n , defint2(~n,1/sqrt(~x),~f1,~f2,~x) => n*intgggg(defint_choose(f1,x),defint_choose(f2,x),-1/2,x) when numberp n , defint2(~n,1/(sqrt(~x)*~x),~f1,~f2,~x) => n*intgggg(defint_choose(f1,x),defint_choose(f2,x),-3/2,x) when numberp n , defint2(~n,1/(sqrt(~x)*~x^~a),~f1,~f2,~x) => n*intgggg(defint_choose(f1,x),defint_choose(f2,x),-1/2-a,x) when numberp n , defint2(~n,1/~x,~f1,~x) => n*intgggg(defint_choose(f1,x),0,-1,x) when numberp n , defint2(~n,1/~x^(~a),~f1,~x) => n*intgggg(defint_choose(f1,x),0,-a,x) when numberp n , defint2(~n,1/sqrt(~x),~f1,~x) => n*intgggg(defint_choose(f1,x),0,-1/2,x) when numberp n, defint2(~n,1/(sqrt(~x)*~x),~f1,~x) => n*intgggg(defint_choose(f1,x),0,-3/2,x) when numberp n , defint2(~n,1/(sqrt(~x)*~x^~a),~f1,~x) => n*intgggg(defint_choose(f1,x),0,-1/2-a,x) when numberp n , defint2(~n,~x**(~a),~f1,~x) => n*intgggg(defint_choose(f1,x),0,a,x) when numberp n , defint2(~n,~x,~f1,~x) => n*intgggg(defint_choose(f1,x),0,1,x) when numberp n , defint2(~n,sqrt(~x),~f1,~x) => n*intgggg(defint_choose(f1,x),0,1/2,x) when numberp n , defint2(~n,sqrt(~x)*~x,~f1,~x) => n*intgggg(defint_choose(f1,x),0,3/2,x) when numberp n , defint2(~n,sqrt(~x)*~x^~a,~f1,~x) => n*intgggg(defint_choose(f1,x),0,1/2+a,x) when numberp n , defint2(~~b*~x^~~a/~~c,~f1,~f2,~x) => b/c*intgggg(defint_choose(f1,x),defint_choose(f2,x),a,x) when freeof(b,x) and freeof (c,x), defint2(~b/(~~c*~x^~~a),~f1,~f2,~x) => b/c*intgggg(defint_choose(f1,x),defint_choose(f2,x),-a,x) when freeof(b,x) and freeof(c,x), defint2(sqrt(~x),~f1,~f2,~x) => intgggg(defint_choose(f1,x),defint_choose(f2,x),1/2,x), defint2(sqrt(~x)*~x^~~a,~f1,~f2,~x) => intgggg(defint_choose(f1,x),defint_choose(f2,x),1/2+a,x), defint2(~b/(~~c*sqrt(~x)),~f1,~f2,~x) => b/c*intgggg(defint_choose(f1,x),defint_choose(f2,x),-1/2,x), defint2(1/(sqrt(~x)*~x^~~a),~f1,~f2,~x) => intgggg(defint_choose(f1,x),defint_choose(f2,x),-1/2-a,x), defint2(1/~x^(~~a),~f1,~x) => intgggg(defint_choose(f1,x),0,-a,x), defint2(1/sqrt(~x),~f1,~x) => intgggg(defint_choose(f1,x),0,-1/2,x), defint2(1/(sqrt(~x)*~x^~~a),~f1,~x) => intgggg(defint_choose(f1,x),0,-1/2-a,x), defint2(~x**(~~a),~f1,~x) => intgggg(defint_choose(f1,x),0,a,x), defint2(sqrt(~x),~f1,~x) => intgggg(defint_choose(f1,x),0,1/2,x), defint2(sqrt(~x)*~x^~~a,~f1,~x) => intgggg(defint_choose(f1,x),0,1/2+a,x), defint2(~b,~f1,~x) => b*defint2(f1,x) when freeof(b,x), defint2(~f1,~f2,~x) => intgggg(defint_choose(f1,x),defint_choose(f2,x),0,x), defint2(~n,~f1,~x) => n*intgggg(defint_choose(f1,x),0,0,x), defint2(~f1,~x) => intgggg(defint_choose(f1,x),0,0,x), defint2((~f1-~f2)/~f3,~f4,~x) => defint2(f1/f3,f4,x) - defint2(f2/f3,f4,x), defint2(-~b,~f1,~f2,~x) => -b*defint2(f1,f2,x) when freeof(b,x) }; let defint2_rules; >>; endmodule; end;