maclaurinsubs := proc( form, fn, var)
#
# maclaurinsubs modifies the supplied expression, form,
# by replacing all instances of function calls to the function fn
# with an equivalent form like Sum( _, var=something..something).
# the correctness of the replacement depends on the convergence
# of the series, which is not checked by this function.
# the series may have a simple logarithmic singularity subtracted out,
# but otherwise it is always a maclaurin series in powers of the argument of fn.
#
# artificial values of the argument fn indicate special case functions,
# viz.  'power' for c**x, x not numeric,
#       'powerp1' for (1+x)**c, abs( x) < 1,
#       'binomial' for (a+b)**c, c a nonnegative integer,
# and   'logp1' for log(1+x), abs( x) < 1.
#
# other values of fn known and already implemented include: 
#    exp, sin, cos, tan, cot, sec, csc, arcsin, arctan, 
#    sinh, cosh, tanh, coth, sech, csch, arcsinh, arctanh, 
#    Ai, Bi, BesselI, BesselJ, Ci, Si, 
#    Ei, erf, erfc, fresnelC, fresnelS, GAMMA, and hypergeom.
# 
# the user can let additional functions be recognized and expanded,
# e.g. if `maclaurinsubs/myfunction` is defined to be a procedure,
# then  myfunction( arg1, arg2, ...)  gets replaced by the value of
# `maclaurinsubs/myfunction`( var, arg1, arg2, ...).
# 
# e.g.     maclaurinsubs( b*sin( a*x) + c, sin, k)
# returns  b*Sum( (-1)**k*(a*x)**(2*k+1)/(2*k+1)!, k=0..infinity) + c.
#
# Author: Vincent Broman, broman@nosc.mil

   local newform, dispat, base, expo;
   
   if type( form, {string, numeric}) then
      form;
   else
      newform := map( procname, args);
      if type( newform, `**`) and
      	   member( fn, {'power', 'powerp1', 'binomial'})
      then
      	 base := op( 1, newform);
	 expo := op( 2, newform);
      	 if fn = 'power' and not type( expo, numeric) then
	    Sum( (ln( base)*expo)**var/var!, var=0..infinity);
	 elif fn = 'powerp1' and
	      type( base, `+`) and
	      member( 1, {op( base)})
	 then
	    if type( expo, nonnegint) then
	       Sum( binomial( expo, var)*(base - 1)**var, var=0..expo);
	    else
	       Sum( binomial( expo, var)*(base - 1)**var, var=0..infinity);
	    fi;
	 elif fn = 'binomial' and
	      (type( expo, nonnegint) or not type( expo, numeric)) and
	      type( base, `+`) and nops( base) = 2
	 then
	    Sum( binomial( expo, var)*op( 1, base)**var
	       	     	      	     *op( 2, base)**(expo-var), var=0..expo);
	 else
	    newform;
	 fi;
      elif fn = 'logp1' and
	   type( newform, ln( `+`(algebraic))) and
      	   member( 1, {op( op( 1, newform))})
      then
	 Sum( (-1)**(var-1)*(op( 1, newform) - 1)**var/var, var=1..infinity);
      elif type( newform, function) and op( 0, newform) = fn then
	 dispat := `maclaurinsubs/`.fn;
      	 if not type( dispat, procedure) then traperror( readlib( dispat)) fi;
	 if type( dispat, procedure) then
	    dispat( var, op( newform));
	 else
	    newform;
	 fi;
      else
	 newform;		# otherwise no change
      fi;
   fi;
end:

`maclaurinsubs/exp` := proc( k, x)
   Sum( x**k/k!, k=0..infinity);
end:

`maclaurinsubs/sin` := proc( k, x)
# for all x
   Sum( (-1)**k*x**(2*k+1)/(2*k+1)!, k=0..infinity);
end:

`maclaurinsubs/cos` := proc( k, x)
# for all x
   Sum( (-1)**k*x**(2*k)/(2*k)!, k=0..infinity);
end:

`maclaurinsubs/tan` := proc( k, x)
# for abs( x) < Pi/2
   Sum( (-1)**(k-1)*4**k*(4**k-1)*bernoulli(2*k)/(2*k)!*x**(2*k-1),
      	k=1..infinity);
end:

`maclaurinsubs/cot` := proc( k, x)
# for abs( x) < Pi
   Sum( (-4)**k*bernoulli(2*k)/(2*k)!*x**(2*k-1),
      	k=0..infinity);
end:

`maclaurinsubs/sec` := proc( k, x)
# for abs( x) < Pi/2
   Sum( (-1)**k*euler(2*k)/(2*k)!*x**(2*k),
      	k=0..infinity);
end:

`maclaurinsubs/csc` := proc( k, x)
# for abs( x) < Pi
   Sum( (-1)**(k-1)*(4**k-2)*bernoulli(2*k)/(2*k)!*x**(2*k-1),
      	k=0..infinity);
end:

`maclaurinsubs/arcsin` := proc( k, x)
# for abs( x) < 1
   Sum( (2*k)!/(k!)**2/4**k/(2*k+1)*x**(2*k+1), k=0..infinity);
end:

`maclaurinsubs/arctan` := proc( k, x)
# for abs( x) < 1
   Sum( (-1)**k/(2*k+1)*x**(2*k+1), k=0..infinity);
end:

`maclaurinsubs/sinh` := proc( k, x)
# for all x
   Sum( x**(2*k+1)/(2*k+1)!, k=0..infinity);
end:

`maclaurinsubs/cosh` := proc( k, x)
# for all x
   Sum( x**(2*k)/(2*k)!, k=0..infinity);
end:

`maclaurinsubs/tanh` := proc( k, x)
# for abs( x) < Pi/2
   Sum( 4**k*(4**k-1)*bernoulli(2*k)/(2*k)!*x**(2*k-1),
      	k=1..infinity);
end:

`maclaurinsubs/coth` := proc( k, x)
# for abs( x) < Pi
   Sum( 4**k*bernoulli(2*k)/(2*k)!*x**(2*k-1),
      	k=0..infinity);
end:

`maclaurinsubs/sech` := proc( k, x)
# for abs( x) < Pi/2
   Sum( euler(2*k)/(2*k)!*x**(2*k),
      	k=0..infinity);
end:

`maclaurinsubs/csch` := proc( k, x)
# for abs( x) < Pi
   Sum( -(4**k-2)*bernoulli(2*k)/(2*k)!*x**(2*k-1),
      	k=0..infinity);
end:

`maclaurinsubs/arcsinh` := proc( k, x)
# for abs( x) < 1
   Sum( (-1)**k*(2*k)!/(k!)**2/4**k/(2*k+1)*x**(2*k+1), k=0..infinity);
end:

`maclaurinsubs/arctanh` := proc( k, x)
# for abs( x) < 1
   Sum( 1/(2*k+1)*x**(2*k+1), k=0..infinity);
end:

`maclaurinsubs/Ai` := proc( k, x)
# for all x
   Sum( GAMMA(k+1/3) * 3**k * x**(3*k) / (3*k)!, k=0..infinity)
  / 3**(2/3) / GAMMA(1/3) / GAMMA(2/3)
  -Sum( GAMMA(k+2/3) * 3**k * x**(3*k+1) / (3*k+1)!, k=0..infinity)
  / 3**(1/3) / GAMMA(1/3) / GAMMA(2/3);
end:

`maclaurinsubs/Bi` := proc( k, x)
# for all x
   Sum( GAMMA(k+1/3) * 3**k * x**(3*k) / (3*k)!, k=0..infinity)
  / 3**(1/6) / GAMMA(1/3) / GAMMA(2/3)
  +Sum( GAMMA(k+2/3) * 3**k * x**(3*k+1) / (3*k+1)!, k=0..infinity)
  * 3**(1/6) / GAMMA(1/3) / GAMMA(2/3);
end:

`maclaurinsubs/BesselI` := proc( k, n, x)
# for all x
   Sum( (1/2)**(n+2*k) * x**(n+2*k) / k! / GAMMA(n+k+1), k=0..infinity);
end:

`maclaurinsubs/BesselJ` := proc( k, n, x)
# for all x
   Sum( (1/2)**n * (-1/4)**k * x**(n+2*k) / k! / GAMMA(n+k+1), k=0..infinity);
end:

`maclaurinsubs/Ci` := proc( k, x)
# for all x
   gamma + ln( x) + Sum( (-1)**k * x**(2*k) / (2*k) / (2*k)!, k=1..infinity);
end:

`maclaurinsubs/Si` := proc( k, x)
# for all x
   Sum( (-1)**k * x**(2*k+1) / (2*k+1) / (2*k+1)!, k=0..infinity);
end:

`maclaurinsubs/Ei` := proc( k, x)
# for x > 0
   gamma + ln( x) + Sum( x**k/k/k!, k=1..infinity);
end:

`maclaurinsubs/erf` := proc( k, x)
# for all x
   2*Pi**(-1/2) * Sum( (-1)**k * x**(2*k+1) / (2*k+1) / k!, k=0..infinity);
end:

`maclaurinsubs/erfc` := proc( k, x)
# for all x
   1 - 2*Pi**(-1/2) * Sum( (-1)**k * x**(2*k+1) / (2*k+1) / k!, k=0..infinity);
end:

`maclaurinsubs/fresnelC` := proc( k, x)
# for all x
   Sum( (-1)**k*(Pi/2)**(2*k) * x**(4*k+1) / (4*k+1) / (2*k)!, k=0..infinity);
end:

`maclaurinsubs/fresnelS` := proc( k, x)
# for all x
   Sum( (-1)**k*(Pi/2)**(2*k+1) * x**(4*k+3) / (4*k+3) / (2*k+1)!, k=0..infinity);
end:

`maclaurinsubs/GAMMA` := proc( k, a)
   local x;              # third, optional argument
# for x >= 0
   
   if nargs <> 3 then
      GAMMA( op( 2..nops( [args]), [args]));
   else
      x := [args];
      x := x[3];
      GAMMA( a) - x**a * Sum( (-x)**k / k! / (a+k), k=0..infinity);
      # might also try the following instead:
      # GAMMA(a) - GAMMA(a)*exp(-x) * Sum( x**(a+k)/GAMMA(a+k+1), k=0..infinity)
   fi;
end:

`maclaurinsubs/hypergeom` := proc( k, n, d, x)
# for abs( x) < 1
   local top, alpha, beta, termnumer, termdenom;

# the test for nonpositive integer coefficients flubs if they are symbolic
   top := +infinity;
   termnumer := x**k;
   for alpha in n do
      if type( -alpha, nonnegint) then
      	 if top = infinity or (-alpha-1) < top then
      	    top := -alpha-1;
	 fi;
	 termnumer := termnumer * (-1)**k * GAMMA( 1-alpha) / GAMMA( 1-alpha-k);
      else
      	 termnumer := termnumer * GAMMA( alpha+k) / GAMMA( alpha);
      fi;
   od;
   
   termdenom := k!;
   for beta in d do
      if type( -beta, nonnegint) then
      	 termdenom := termdenom * (-1)**k * GAMMA( 1-beta) / GAMMA( 1-beta-k);
      else
      	 termdenom := termdenom * GAMMA( beta+k) / GAMMA( beta);
      fi;
   od;

   if top = infinity or top >= 0 then
      Sum ( termnumer / termdenom, k=0..top);
   else
      1;
   fi;
end:
macsubs := ":

`help/text/maclaurinsubs` := TEXT(
`FUNCTION: maclaurinsubs - substitute Maclaurin series for function calls`,
`   `,
`CALLING SEQUENCE: maclaurinsubs( expr, funcname, idx);`,
`   `,
`PARAMETERS: expr - an expression`,
`	    funcname - string naming the function to be expanded`,
`	    idx - string naming the index to sum over`,
`   `,
`SYNOPSIS:   `,
`- The call maclaurinsubs( expr, funcname, idx) returns an expression`,
`  which is at least formally equivalent to the argument expr,`,
`  differing only in that all calls to the function named funcname are`,
`  replaced by Maclaurin series in powers of the argument to the`,
`  function.  The series is in the form of a Sum expression with the`,
`  index of summation taken from the argument idx, which index should`,
`  not appear elsewhere in the form expr.  Correctness of the`,
`  substitution depends on convergence of the infinite series, which`,
`  the user must verify.  In a few cases, an obvious singularity in the`,
`  function is separated out before series expansion.`,
`   `,
`- Four special case values of the argument funcname request special`,
`  substitutions.  The following produce series in powers of x:`,
`   `,
`    funcname          form expanded         condition`,
`    'power'           c**x                  x not numeric`,
`    'powerp1'         (1 + x)**c            abs( x) < 1`,
`    'binomial'        (x + b)**c            c a nonnegative integer`,
`    'logp1'           ln( 1 + x)            abs( x) < 1`,
`     `,
`- Other values of funcname known and already implemented include: `,
`   `,
`    exp, sin, cos, tan, cot, sec, csc, arcsin, arctan, `,
`    sinh, cosh, tanh, coth, sech, csch, arcsinh, arctanh, `,
`    Ai, Bi, BesselI, BesselJ, Ci, Si, Ei, erf, erfc,`,
`    fresnelC, fresnelS, (incomplete) GAMMA, and hypergeom.`,
`     `,
`- The user can cause additional functions to be recognized and`,
`  expanded.  E.g. if  ``maclaurinsubs/myfunction``  is defined to be a`,
`  procedure and  maclaurinsubs( expr, myfunction, idx)  is invoked,`,
`  then instances inside  expr  of  myfunction( arg1, arg2, ...)`,
`  get replaced by the value of`,
`  ``maclaurinsubs/myfunction``( idx, arg1, arg2, ...).`,
`     `,
`EXAMPLES:   `,
`   `,
`> maclaurinsubs( a + sin( b*x), sin, k);`,
`                          /infinity                     \\`,
`                          | -----       k      (2 k + 1)|`,
`                          |  \\      (-1)  (b x)         |`,
`                      a + |   )     --------------------|`,
`                          |  /           (2 k + 1)!     |`,
`                          | -----                       |`,
`                          \\ k = 0                       /`,
`   `,
`> maclaurinsubs( a * sech( b + x), sech, m);`,
`                        /infinity                        \\`,
`                        | -----                     (2 m)|`,
`                        |  \\      euler(2 m) (b + x)     |`,
`                      a |   )     -----------------------|`,
`                        |  /               (2 m)!        |`,
`                        | -----                          |`,
`                        \\ m = 0                          /`,
`   `,
`> maclaurinsubs( (u/v + 1)**alpha, powerp1, k);`,
`                       infinity`,
`                        -----`,
`                         \\                              k`,
`                          )     binomial(alpha, k) (u/v)`,
`                         /`,
`                        -----`,
`                        k = 0`,
`   `,
`> maclaurinsubs( GAMMA( a, x), GAMMA, k);`,
`                                    /infinity           \\`,
`                                    | -----          k  |`,
`                                  a |  \\        (- x)   |`,
`                      GAMMA(a) - x  |   )     ----------|`,
`                                    |  /      k! (a + k)|`,
`                                    | -----             |`,
`                                    \\ k = 0             /`,
`   `,
`AUTHOR: Vincent Broman, Naval Command Control and Ocean Surveillance Center`
):
`help/text/macsubs` := ":

#save `macsubs.m`;
#quit
