1module sfrules;  % Rules for definite integration.
2
3% Redistribution and use in source and binary forms, with or without
4% modification, are permitted provided that the following conditions are met:
5%
6%    * Redistributions of source code must retain the relevant copyright
7%      notice, this list of conditions and the following disclaimer.
8%    * Redistributions in binary form must reproduce the above copyright
9%      notice, this list of conditions and the following disclaimer in the
10%      documentation and/or other materials provided with the distribution.
11%
12% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
13% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
14% THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
15% PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS OR
16% CONTRIBUTORS
17% BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
18% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
19% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
20% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
21% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
22% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
23% POSSIBILITY OF SUCH DAMAGE.
24%
25
26
27algebraic;
28
29operator defint,choose;
30
31put('intgggg,'simpfn,'simpintgggg);
32
33share mellincoef$
34
35defint_rules:=
36
37{ defint(~x**(~a),~f1,~f2,~x) => intgggg(choose(f1,x),choose(f2,x),a,x),
38  defint(~x,~f1,~f2,~x) => intgggg(choose(f1,x),choose(f2,x),1,x),
39  defint(~x**(~a),~f1,~x) => intgggg(choose(f1,x),0,a,x),
40  defint(~x,~f1,~x) => intgggg(choose(f1,x),0,1,x),
41  defint(~f1,~f2,~x) => intgggg(choose(f1,x),choose(f2,x),0,x),
42  defint(~f1,~x) => intgggg(choose(f1,x),0,0,x)};
43
44
45let defint_rules;
46
47choose_data :=
48
49{ choose(1/e**(~x),~var) => f1(1,x),
50  choose(sin(~x),~var)   => f1(2,x),
51  choose(Heaviside (1-(~x)),~var) => f1(3,x),
52  choose(Heaviside ((~p-~x)/~p),~var) => f1(3,x/p),
53  choose(Heaviside ((~x)-1),~var) => f1(4,x),
54
55  choose(~f,~var)        => unknown };  % fallthrough case
56
57let choose_data;
58
59fluid '(mellin!-transforms!* mellin!-coefficients!*);
60
61symbolic (mellin!-transforms!* :=mkvect(200))$
62
63symbolic putv(mellin!-transforms!*,0,'(1 . 1)); % undefined case
64symbolic putv(mellin!-transforms!*,1,'(() (1 0 0 1) () (nil) 1 x));
65symbolic putv(mellin!-transforms!*,2,'
66    (() (1 0 0 2) () ((quotient 1 2) nil)
67    (sqrt pi) (quotient (expt x 2) 4)));
68
69    % the Heavisides
70
71symbolic putv(mellin!-transforms!*,3,'(() (1 0 1 1) (1) (nil) 1 x));
72symbolic putv(mellin!-transforms!*,4,'(() (0 1 1 1) (1) (nil) 1 x));
73
74
75
76symbolic (mellin!-coefficients!* :=mkvect(200))$
77
78symbolic procedure simpintgggg (u);
79
80   begin scalar ff1,ff2,alpha,var,chosen_num,coef;
81
82        ff1 := prepsq simp car u;
83        if (cadr u) = 0 then ff2 := '(0 0 x) else
84                ff2 := prepsq simp cadr u;
85        if (ff1 = 'unknown) then return simp 'unknown;
86        if (ff2 = 'unknown) then return simp 'unknown;
87        alpha := caddr u;
88        var := cadddr u;
89
90        chosen_num := cadr ff1;
91        put('f1,'g,getv(mellin!-transforms!*,chosen_num));
92        coef := getv(mellin!-coefficients!*,chosen_num);
93        if coef then mellincoef:= coef else mellincoef :=1;
94
95        chosen_num := cadr ff2;
96        put('f2,'g,getv(mellin!-transforms!*,chosen_num));
97        coef := getv(mellin!-coefficients!*,chosen_num);
98        if coef then mellincoef:= coef * mellincoef ;
99
100       return
101        simp list('intgg,list('f1,caddr ff1), list('f2,caddr ff2),
102                  alpha,var);
103   end;
104
105 % some rules which let the results look more convenient ...
106
107algebraic <<
108
109 for all z let sinh(z) = (exp (z) - exp(-z))/2;
110 for all z let cosh(z) = (exp (z) + exp(-z))/2;
111>>;
112
113endmodule;
114
115end;
116
117
118
119