/* Filename averm.mac

   ***************************************************************
   *							         *
   *                     <package name>                          *
   *                <functionality description>                  *
   *                                                             *
   *          from: Perturbation Methods, Bifurcation            *
   *                Theory and Computer Algebra.                 *
   *           by Rand & Armbruster (Springer 1987)              *
   *                Programmed by Richard Rand                   *
   *      These files are released to the public domain          *
   *            						 *
   ***************************************************************
*/ 
/* program number 8: averm(), allows mth order averaging. see page 128 in
   "perturbation methods, bifurcation theory and computer algebra". */


/* program to perform mth order averaging 
   on an n-dimensional system of nonautonomous ode's */

/* averaging is performed by converting trig terms to
   complex exponentials, then killing exponentials   */

averm():=block(
      choice1:read("do you want to enter a new problem? (y/n)"),
      if choice1 = n then go(jump1),
      kill(x),
      print("are you considering a weakly nonlinear oscillator of the form"),
      choice2:read("z'' + omega0^2 z = eps f(z,zdot,t) ? (y/n)"),
      if choice2 = n then go(jump2),
		
/* enter data for single oscillator problem */
      n:2,
      omega0:read("enter omega0"),
      f:read("enter f(z,zdot,t)")*eps,
/* does f(z,zdot,t) depend explicitly on t? */
      test:diff(f,t),
      if test=0 then omega1:omega0 
            else(
      	    omega:read("enter the forcing frequency"),
            k:read("enter the order of the subharmonic resonance"),
            omega1:omega/k),
/* van der pol transformation */
      zsub:[z=cos(omega1*t)*x1-sin(omega1*t)*x2,
               zdot=-omega1*sin(omega1*t)*x1-omega1*cos(omega1*t)*x2],
/* substitute zsub into transformed eqs */
/* scale time so that averaging occurs over period 2 pi */
      vf:ev([-1/omega1^2*(eps*kapomega/k^2*z + f)*sin(omega1*t),
             -1/omega1^2*(eps*kapomega/k^2*z + f)*cos(omega1*t)],
             zsub,t=tau/omega1,infeval),
      vf:ev(vf,tau=t),
      if omega1 # omega0 
      then print("we write eps*kapomega =",omega^2-k^2*omega0^2)
            else vf:ev(vf,kapomega=0),
      vf2:expand(exponentialize(vf)),
      for i:1 thru 2 do vf2[i]:map(factor,vf2[i]),
      x:[x1,x2],
      go(jump1),


jump2,
/* enter data for general problem of n ode's */
      n:read("enter number of differential equations"),
      x:makelist(concat('x,i),i,1,n),	 
      print("the ode's are of the form:"),
      print("dx/dt = eps f(x,t)"),
      print("where x =",x),
      print("scale time t such that averaging occurs over 2 pi"),
      vf:makelist(read("enter rhs(",i,")=eps*...")*eps,i,1,n),
      for i:1 thru n do print("d",x[i],"/dt =",vf[i]),
      vf2:expand(exponentialize(vf)),
      for i:1 thru n do vf2[i]:map(factor,vf2[i]),


jump1,
/* averaging */
      m:read("enter order of averaging"),
      if m=1 
/* first order averaging */         
      then (temp0:demoivre(apply1(f,killexp)),
           result:taylor(temp0,eps,0,1))
/* averaging of order m > 1 */
      else
      y:makelist(concat('y,i),i,1,n),
      wlist:makelist(concat('w,i),i,1,n),      
      depends(wlist,cons(t,y)),
      trafo:y,
      xsub:maplist("=",y,x),
/* wnull sets wlist to zero */
      wnull:vfun(wlist,0),
      jacob[i,j] := diff(wlist[i],y[j]),
      jac:genmatrix(jacob,n,n),
/* main loop */
      for i :1 thru m-1 do (
	  temp1:maplist("=",x,y+eps^i*wlist),
/* here x is the list [x1,x2,...,xn], y is the list [y1,y2,...,yn],
        wlist is the transformation vector [w1,w2,...,wn] */
	  temp2:taylor(sum((-eps)^(i*j)*jac^^j,j,0,m-1).
		                (ev(vf2,temp1) - diff(wlist,t)*eps^i),eps,0,m),
/* jac is the jacobian d wlist/dy of the transformation wlist */
          temp3:mattolist(temp2,n),
          temp4:map(expand,taylor(ev(temp3,wnull,diff),eps,0,i)),
/* the ith order mean */
	  mean:apply1(temp4,killexp),
	  temp6:expand(temp4-mean),
	  temp7:ev(integrate(temp6,t),eps=1),
/* the ith order transformation */	  
          temp8:maplist("=",wlist,temp7),
	  temp9:ratsimp(temp8),
/* the transformed de */
	  vf2:expand(ev(temp3,temp9,diff,xsub,infeval)),
/* the sum of all transformations */
	  trafo:expand(trafo+ev(eps^i*wlist,temp9))),
/* end of main loop */
      print("the transformation: ",x,"="),
      print(ratsimp(demoivre(trafo))),
/* the final averaging */
      result:apply1(vf2,killexp),
/* replace x by y */
      for i:1 thru n do result:subst(concat('y,i),concat('x,i),result),
      result)$


/* auxiliary functions */
      vfun(list,value):=map(lambda([u],u=value),list)$
      mattolist(mat,dim):=if dim>1 then makelist(mat[i,1],i,1,dim) else [mat]$
      contains_t(exp):= not freeof(t,exp)$
      matchdeclare(q,contains_t)$
      defrule(killexp,exp(q),0)$
