share/contrib/trigtools/trigtools.mac

   1
   2 /*
   3 trigtools  package for working with expressions with trigonometric and hyperbolic functions.
   4 version 1.01,  2013.11
   5 Copyright (C)  A.Domarkas 2013
   6 rigtools package is free software; you can redistribute it and/or
   7 modify it under the terms of the GNU General Public License.
   8 */
   9
  10 /*
  11 The function c2sin convert expression a*cos(x)+b*sin(x)  to r*sin(x+phi).
  12 */
  13
  14 c2sin(f):=block([x,a,b,r,phi],
  15 x:listofvars(f)[1],
  16 a:coeff(f,cos(x)),b:coeff(f,sin(x)),
  17 r:signum(b)*sqrt(a^2+b^2),
  18 phi:atan(a/b),
  19 r*sin(x+phi)
  20 )$
  21
  22 /*
  23 The function c2cos convert expression a*cos(x)+b*sin(x)  to r*cos(x-phi).
  24 */
  25
  26 c2cos(f):=block([x,a,b,r,phi],
  27 x:listofvars(f)[1],
  28 a:coeff(f,sin(x)),b:coeff(f,cos(x)),
  29 r:signum(b)*sqrt(a^2+b^2),
  30 phi:atan(a/b),
  31 r*cos(x-phi))$
  32
  33 /*
  34 The function c2trig (convert to trigonometric) reduce expression with hyperbolic functions
  35  sinh, cosh, tanh, coth to trigonometric expression with sin, cos, tan, cot.
  36 */
  37
  38 c2trig(r):=block([x,i,sinv,cosv,mi,mii,%iargs:false],
  39 mi(x):=%i*x,
  40 mii(x):=-%i*x,
  41 sinv:compose_functions([mii,sin,mi]),
  42 tanv:compose_functions([mii,tan,mi]),
  43 cosv:compose_functions([cos,mi]),
  44 cotv:compose_functions([mi,cot,mi]),
  45 subst([sinh=sinv,cosh=cosv,tanh=tanv,coth=cotv],r),
  46 subst(%i=i,%%),
  47 trigrat(%%),
  48 trigreduce(%%),
  49 subst(i=%i,%%)
  50 )$
  51
  52 /*
  53 The function c2hyp (convert to hyperbolic) convert expression with exp function
  54  to expression with hyperbolic functions sinh, cosh.
  55 */
  56
  57 c2hyp(expr):=block([pa,f,e1,e2,S],
  58 pa(f):=if atom(f) then f else makelist(part(f,k),k,1,length(f)),
  59 S:[],
  60 e1:[pa(expr)],
  61 e2:sublist(%%,listp),
  62 sublist(e2,lambda ([x], part(x,1)=%e)),
  63 S:append(S,%%),
  64 e1:flatten(e2),
  65 while e1#[] do
  66 (map(pa,e1),
  67 e2:sublist(%%,listp),
  68 sublist(e2,lambda ([x], part(x,1)=%e)),
  69 S:append(S,%%),
  70 e1:flatten(e2)),
  71 makelist(exp(S[k][2])=cosh(S[k][2])+sinh(S[k][2]),k,1,length(S)),
  72 subst(%%,expr)
  73 )$
  74
  75 /*
  76 The function trigfactor factors expressions of form  +-sin(x)+-cos(y)
  77 */
  78
  79 trigfactor(f):=block([r,_x,_y,%piargs:false],
  80 st(f):=block([f0,fun,a1],
  81        f0:part(f,0),
  82        if f0=sin or f0=cos then return([part(f,0),part(f,1)])
  83        elseif f0="-" then
  84        f0:part(f,1,0),
  85        if f0=sin or f0=cos then
  86        return([part(f,1,0),part(f,1,1)])
  87        else fail
  88        ),
  89           cx(x):=%pi/2-x,
  90 if nterms(f)=2 and op(f)="+" then
  91 (s1:st(part(f,1))[1], s2:st(part(f,2))[1])
  92 else return(f),
  93 if s1#false and f2#false and s1#s2 then
  94          (sinv:compose_functions([cos,cx]),f1:subst([sin=sinv],f))
  95          else f1:f,
  96 _x:st(part(f1,1))[2],_y:st(part(f1,2))[2],
  97 r:[2*sin((_x+_y)/2)*cos((_x-_y)/2),2*sin((_x-_y)/2)*cos((_x+_y)/2),
  98 2*cos((_x+_y)/2)*cos((_x-_y)/2),2*sin((_x+_y)/2)*sin((_x-_y)/2)],
  99 r:append(r,-r),
 100 %piargs:true,
 101 sublist(r,lambda([x],trigrat(f1-x)=0)),
 102 expand(%%),
 103 if length(%%)>=1 then %%[1] else f )$
 104
 105 /*
 106 The function trigsolve find solutions of trigonometric equation from interval [a, b).
 107 */
 108
 109 trigsolve(eq,a,b):=block([s,i,ats,algebraic],
 110 algebraic:true,
 111 to_poly_solve([eq], [x],'simpfuncs =
 112 ['rootscontract,'expand,'radcan,'nicedummies]),
 113 s:makelist(rhs(part(%%,k)[1]),k,1,length(%%)),
 114 ats:[],
 115 for i:1 thru length(s) do
 116 (makelist(ev(s[i],%z0=k),k,-10,10),
 117 ats:append(ats,%%)),
 118 sublist(ats,lambda([e],e>=a and e<b)),
 119 sort(%%),
 120 setify(%%)
 121 )$
 122
 123 /*
 124 The function trigvalue compute values of sin(m*pi/n), cos(m*pi/n), tan(m*pi/n), cot(m*pi/n) in radicals.
 125 */
 126
 127 trigvalue(r):=block(
 128 [f,x,sol,spr,spr1,solvetrigwarn,algebraic],
 129 solvetrigwarn:false,
 130 algebraic:true,
 131 if freeof(%pi,r) then return(r),
 132 f:part(r,0),
 133 if part(r,0)="-" then f:part(r,1,0),
 134 if f=cot then f:tan,
 135 sol:solve(x=r,%pi)[1],
 136 sol*denom(rhs(sol)),
 137 map(f,%%),
 138 trigexpand(%%),
 139 factor(%%),
 140 spr:solve(%%,x),
 141 if (length(spr)<=2 or not freeof(%i,%%)) then return(r),
 142 spr1:sublist(spr,lambda([e],is(abs(rhs(e)-r)<ratepsilon))),
 143 if %%=[] then return(r),
 144 rhs(spr1[1]),
 145 sqrtdenest(%%),
 146 factor(%%)
 147 )$
 148
 149 /*
 150 The function trigeval compute values of expressions with sin(m*pi/n), cos(m*pi/n), tan(m*pi/n), cot(m*pi/n)
 151 in radicals.
 152 */
 153
 154 trigeval(r):=block([sinv,cosv,tanv,cotv],
 155 sinv:compose_functions([trigvalue,sin]),
 156 cosv:compose_functions([trigvalue,cos]),
 157 tanv:compose_functions([trigvalue,tan]),
 158 cotv:compose_functions([trigvalue,cot]),
 159 subst([sin=sinv,cos=cosv, tan=tanv,cot=cotv],r)
 160 )$
 161
 162 /*
 163 The function atan_contract contracts atan functions.
 164 */
 165
 166 atan_contract(r):=block([],
 167 if equal(r,%pi/2) then return(%pi/2)
 168 elseif equal(r,-%pi/2) then return(-%pi/2),
 169 is(abs(r)<%pi/2),
 170 if %%=true then
 171 (
 172 tan(r),
 173 trigexpand(%%),
 174 trigexpand(%%),
 175 atan(%%)
 176 )
 177 else return(r)
 178 )$
 179
 180 /*
 181 compose_functions -- function from to_poly_solve package( used for trigeval, c2trig)
 182 */
 183
 184 compose_functions(l):=block([z,f],
 185 if listp(l) then (l:reverse(l),f:z,for lk in l do
 186 f:funmake(lk,[f]),buildq([z,f],lambda([z],f))) else
 187 error("The argument to 'compose_functions' must be a list."))$
 188