Artifact 22c86645a56332cff489a53b9e4754c1d51d2d9872b4b0880f69fff1b3565a62:
- Executable file
r37/packages/trigsimp/trigsmp1.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: 8752) [annotate] [blame] [check-ins using] [more...]
- Executable file
r38/packages/trigsimp/trigsmp1.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: 8752) [annotate] [blame] [check-ins using]
module trigsmp1$ % Collection of rule sets. % Revised by FJW, 22 June 1998 algebraic$ clearrules(trig_imag_rules)$ % FJW: pre-defined %% trig_normalize!* := %% { %% cos(~a)^2 => 1 - sin(a)^2 when trig_preference=sin, %% sin(~a)^2 => 1 - cos(a)^2 when trig_preference=cos, %% cosh(~a)^2 => 1 + sinh(a)^2 when hyp_preference=sinh, %% sinh(~a)^2 => cosh(a)^2 - 1 when hyp_preference=cosh %% }$ trig_normalize2sin!* := {cos(~a)^2 => 1 - sin(a)^2}$ % FJW trig_normalize2cos!* := {sin(~a)^2 => 1 - cos(a)^2}$ % FJW trig_normalize2sinh!* := {cosh(~a)^2 => 1 + sinh(a)^2}$ % FJW trig_normalize2cosh!* := {sinh(~a)^2 => cosh(a)^2 - 1}$ % FJW trig_expand_addition!* := % additions theorems { sin((~a+~b)/~~m) => sin(a/m)*cos(b/m) + cos(a/m)*sin(b/m), cos((~a+~b)/~~m) => cos(a/m)*cos(b/m) - sin(a/m)*sin(b/m), tan((~a+~b)/~~m) => (tan(a/m)+tan(b/m))/(1-tan(a/m)*tan(b/m)), cot((~a+~b)/~~m) => (cot(a/m)*cot(b/m)-1)/(cot(a/m)+cot(b/m)), sec((~a+~b)/~~m) => 1/(1/(sec(a/m)*sec(b/m))-1/(csc(a/m)*csc(b/m))), csc((~a+~b)/~~m) => 1/(1/(sec(b/m)*csc(a/m))+1/(sec(a/m)*csc(b/m))), tanh((~a+~b)/~~m) => (tanh(a/m)+tanh(b/m))/(1+tanh(a/m)*tanh(b/m)), coth((~a+~b)/~~m) => (coth(a/m)*coth(b/m)+1)/(coth(a/m)+coth(b/m)), sinh((~a+~b)/~~m) => sinh(a/m)*cosh(b/m) + cosh(a/m)*sinh(b/m), cosh((~a+~b)/~~m) => cosh(a/m)*cosh(b/m) + sinh(a/m)*sinh(b/m), sech((~a+~b)/~~m) => 1/(1/(sech(a/m)*sech(b/m))+1/(csch(a/m)*csch(b/m))), csch((~a+~b)/~~m) => 1/(1/(sech(a/m)*csch(b/m))+1/(sech(b/m)*csch(a/m))) }$ trig_expand_multiplication!* := % multiplication theorems { sin(~n*~a/~~m) => sin(a/m)*cos((n-1)*a/m) + cos(a/m)*sin((n-1)*a/m) when fixp n and n>1 and n<=15, sin(~n*~a/~~m) => 2*sin(n/2*a/m)*cos(n/2*a/m) when fixp n and mod(n,2)=0 and n>15, sin(~n*~a/~~m) => sin((n-1)/2*a/m)*cos((n+1)/2*a/m) + sin((n+1)/2*a/m)*cos((n-1)/2*a/m) when fixp n and mod(n,2)=1 and n>15, cos(~n*~a/~~m) => cos(a/m)*cos((n-1)*a/m) - sin(a/m)*sin((n-1)*a/m) when fixp n and n>1 and n<=15, cos(~n*~a/~~m) => 2*cos(n/2*a/m)**2-1 when fixp n and mod(n,2)=0 and n>15, cos(~n*~a/~~m) => cos((n-1)/2*a/m)*cos((n+1)/2*a/m) - sin((n-1)/2*a/m)*sin((n+1)/2*a/m) when fixp n and mod(n,2)=1 and n>15, sinh(~n*~a/~~m) => sinh(a/m)*cosh((n-1)*a/m)+cosh(a/m)*sinh((n-1)*a/m) when fixp n and n<=15 and n>1, sinh(~n*~a/~~m) => 2*sinh(n/2*a/m)*cosh(n/2*a/m) when fixp n and mod(n,2)=0 and n>15, sinh(~n*~a/~~m) => sinh((n-1)/2*a/m)*cosh((n+1)/2*a/m) + sinh((n+1)/2*a/m)*cosh((n-1)/2*a/m) when fixp n and mod(n,2)=1 and n>15, cosh(~n*~a/~~m) => cosh(a/m)*cosh((n-1)*a/m) + sinh(a/m)*sinh((n-1)*a/m) when fixp n and n>1 and n<=15, cosh(~n*~a/~~m) => 2*cosh(n/2*a/m)**2-1 when fixp n and mod(n,2)=0 and n>15, cosh(~n*~a/~~m) => cosh((n-1)/2*a/m)*cosh((n+1)/2*a/m)+ sinh((n-1)/2*a/m)*sinh((n+1)/2*a/m) when fixp n and mod(n,2)=1 and n>15, tan(~n*~a/~~m) => (tan(a/m)+tan((n-1)*a/m))/(1-tan(a/m)*tan((n-1)*a/m)) when fixp n and n>1 and n<=15, tan(~n*~a/~~m) => 2*tan(n/2*a/m)/(1-tan(n/2*a/m)**2) when fixp n and mod(n,2)=0 and n>15, tan(~n*~a/~~m) => ( tan((n-1)/2*a/m)+tan((n+1)/2*a/m) ) / (1-tan((n-1)/2*a/m)*tan((n+1)/2*a/m)) when fixp n and mod(n,2)=1 and n>15, tanh(~n*~a/~~m) => (tanh(a/m)+tanh((n-1)*a/m))/(1+tanh(a/m)*tanh((n-1)*a/m)) when fixp n and n>1 and n<=15, tanh(~n*~a/~~m) => 2*tanh(n/2*a/m)/(1+tanh(n/2*a/m)**2) when fixp n and mod(n,2)=0 and n>15, tanh(~n*~a/~~m) => ( tanh((n-1)/2*a/m)+tanh((n+1)/2*a/m) ) / (1+tanh((n-1)/2*a/m)*tanh((n+1)/2*a/m)) when fixp n and mod(n,2)=1 and n>15, cot(~n*~a/~~m) => (cot(a/m)*cot((n-1)*a/m)-1)/(cot(a/m)+cot((n-1)*a/m)) when fixp n and n>1 and n<=15, cot(~n*~a/~~m) => (cot(n/2*a/m)**2-1)/(2cot(n/2*a/m)) when fixp n and mod(n,2)=0 and n>15, cot(~n*~a/~~m) => ( cot((n-1)/2*a/m)*cot((n+1)/2*a/m)-1 ) / (cot((n-1)/2*a/m)+cot((n+1)/2*a/m)) when fixp n and mod(n,2)=1 and n>15, coth(~n*~a/~~m) => (coth(a/m)*coth((n-1)*a/m)+1)/(coth(a/m)+coth((n-1)*a/m)) when fixp n and n>1 and n<=15, coth(~n*~a/~~m) => (coth(n/2*a/m)**2+1)/(2coth(n/2*a/m)) when fixp n and mod(n,2)=0 and n>15, coth(~n*~a/~~m) => ( coth((n-1)/2*a/m)*coth((n+1)/2*a/m)+1 ) / (coth((n-1)/2*a/m)+coth((n+1)/2*a/m)) when fixp n and mod(n,2)=1 and n>15, sec(~n*~a/~~m) => 1/(1/(sec(a/m)*sec((n-1)*a/m))-1/(csc(a/m)*csc((n-1)*a/m))) when fixp n and n>1 and n<=15, sec(~n*~a/~~m) =>1/(1/sec(n/2*a/m)**2-1/csc(n/2*a/m)**2) when fixp n and mod(n,2)=0 and n>15, sec(~n*~a/~~m) => 1/(1/(sec((n-1)/2*a/m)*sec((n+1)/2*a/m))- 1/(csc((n-1)/2*a/m)*csc((n+1)/2*a/m))) when fixp n and mod(n,2)=1 and n>15, csc(~n*~a/~~m) => 1/(1/(sec(a/m)*csc((n-1)*a/m))+1/(csc(a/m)*sec((n-1)*a/m))) when fixp n and n>1 and n<=15, csc(~n*~a/~~m) => sec(n/2*a/m)*csc(n/2*a/m)/2 when fixp n and mod(n,2)=0, csc(~n*~a/~~m) => 1/(1/(sec((n-1)/2*a/m)*csc((n+1)/2*a/m))+ 1/(csc((n-1)/2*a/m)*sec((n+1)/2*a/m))) when fixp n and mod(n,2)=1 and n>15, sech(~n*~a/~~m) => 1/(1/(sech(a/m)*sech((n-1)*a/m))+1/(csch(a/m)*csch((n-1)*a/m))) when fixp n and n>1 and n<=15, sech(~n*~a/~~m) => 1/(1/sech(n/2*a/m)**2+1/csch(n/2*a/m)**2) when fixp n and mod(n,2)=0 and n>15, sech(~n*~a/~~m) => 1/(1/(sech((n-1)/2*a/m)*sech((n+1)/2*a/m))+ 1/(csch((n-1)/2*a/m)*csch((n+1)/2*a/m))) when fixp n and mod(n,2)=1 and n>15, csch(~n*~a/~~m) => 1/(1/(sech(a/m)*csch((n-1)*a/m))+1/(csch(a/m)*sech((n-1)*a/m))) when fixp n and n>1 and n<=15, csch(~n*~a/~~m) => sech(n/2*a/m)*csch(n/2*a/m)/2 when fixp n and mod(n,2)=0 and n>15, csch(~n*~a/~~m) => 1/(1/(sech((n-1)/2*a/m)*csch((n+1)/2*a/m))+ 1/(csch((n-1)/2*a/m)*sech((n+1)/2*a/m))) when fixp n and mod(n,2)=1 and n>15 }$ trig_combine!* := { sin(~a)*sin(~b) => 1/2*(cos(a-b) - cos(a+b)), cos(~a)*cos(~b) => 1/2*(cos(a-b) + cos(a+b)), sin(~a)*cos(~b) => 1/2*(sin(a-b) + sin(a+b)), sin(~a)^2 => 1/2*(1-cos(2*a)), cos(~a)^2 => 1/2*(1+cos(2*a)), sinh(~a)*sinh(~b) => 1/2*(cosh(a+b) - cosh(a-b)), cosh(~a)*cosh(~b) => 1/2*(cosh(a-b) + cosh(a+b)), sinh(~a)*cosh(~b) => 1/2*(sinh(a-b) + sinh(a+b)), sinh(~a)^2 => 1/2*(cosh(2*a)-1), cosh(~a)^2 => 1/2*(1+cosh(2*a)) }$ trig_standardize!* := { tan(~a) => sin(a)/cos(a), cot(~a) => cos(a)/sin(a), tanh(~a) => sinh(a)/cosh(a), coth(~a) => cosh(a)/sinh(a), sec(~a) => 1/cos(a), csc(~a) => 1/sin(a), sech(~a) => 1/cosh(a), csch(~a) => 1/sinh(a) }$ trig2exp!* := { cos(~a) => (e^(i*a) + e^(-i*a))/2, sin(~a) => -i*(e^(i*a) - e^(-i*a))/2, cosh(~a) => (e^(a) + e^(-a))/2, sinh(~a) => (e^(a) - e^(-a))/2 }$ pow2quot!* := { (~a/~b)^~c => (a^c)/(b^c) }$ exp2trig1!* := { e**(~x) => cos(x/i)+i*sin(x/i) }$ exp2trig2!* := { e**(~x) => 1/(cos(x/i)-i*sin(x/i)) }$ trig2hyp!* := { sin(~a) => -i*sinh(i*a), cos(~a) => cosh(i*a), tan(~a) => -i*tanh(i*a), cot(~a) => i*coth(i*a), sec(~a) => sech(i*a), csc(~a) => i*csch(i*a), asin(~a) => -i*asinh(i*a), acos(~a) => -i*acosh(a) }$ hyp2trig!* := { sinh(~a) => -i*sin(i*a), cosh(~a) => cos(i*a), asinh(~a) => i*asin(-i*a), acosh(~a) => i*acos(a) }$ subtan!* := { sin(~x) => cos(x)*tan(x) when trig_preference=cos, cos(~x) => sin(x)/tan(x) when trig_preference=sin, sinh(~x) => cosh(x)*tanh(x) when hyp_preference=cosh, cosh(~x) => sinh(x)/tanh(x) when hyp_preference=sinh }$ endmodule$ end$ % FJW: For debugging using the rtrace package: trrlid trig_normalize2sin!*, trig_normalize2cos!*, trig_normalize2sinh!*, trig_normalize2cosh!*, trig_expand_addition!*, trig_expand_multiplication!*, trig_combine!*, trig_standardize!*, trig2exp!*, exp2trig1!*, exp2trig2!*, trig2hyp!*, hyp2trig!*, subtan!*;