
#
#--> TAYLOR(f,[xj,..xl],d) -- compute D[xj@kj,..,xl@kl](f) such that
#                             kj + .. + kl <= d   where  1 <= j,l <= n
#--> TAYLOR(f,p,d) -- compute D[x1@k1,..,xp@kp](f)  such that k1 + .. + kp <= d
#                     equivalent to TAYLOR(f,[x1,..xp],d)
#--> TAYLOR(f,d) -- compute D[x1@k1,..,xn@kn](f)    such that k1 + .. + kn <= d
#                   equivalent to TAYLOR(f,[x1,..xn],d)
#
# Given a Maple procedure f, a function of n complex arguments
#
#      X = x1, x2, x3, .. , xn
#
# TAYLOR(f,[xi, .. , xk],d) computes the 'taylor-coefficients' of f
# wrt to {xi, .. , xk} up to the total degree d, where 1 <= i,k <= n
# i.e. returns a Maple procedure g, which computes
#
#                                   v
#      ( D[i] + D[i+1] + .. + D[k] ) f(X)   where  0 <= v <= d
#
# The reason why 'taylor-coefficients' is written in quotes is that
# this coefficients are computed without the leading term  1/(v!) !
#
# Note: Redundant calculations of same derivatives are avoided !
#
# The returned value of the generated procedure g is always an array.
# Each entry of this array is also an array!
#
# The TAYLOR function is based on the GRADIENT function, so the
# restrictions concerning the procedure f are the same as in GRADIENT.
# For further information please see GRADIENT.
#
# Author: Walter Neuenschwander Mar/92
#

TAYLOR := proc(p)
      local indeps,body,params,totaldeg,neue,
            `total/k-1`,`total/k`,`delta/k-1`,`delta/k`,sequ,i,j,k,t,n;
global taylor_hess, include_funcval, generate_array, `TAYLOR/Degree`,
       return_taylor;

    if nargs < 2 then
       ERROR(`procedure 'taylor' needs at least two arguments`); fi;
    if (nargs = 2 or nargs = 3) and not type(args[1],procedure) then 
       ERROR(`1st argument (function) must be a procedure`,args[1]); fi;
    if (nargs = 2 and not type(args[2],integer)) or 
       (nargs = 3 and not type(args[3],integer)) then
ERROR(`the total degree of the derivatives must be an integer value`);fi;
    if nargs = 3  and not (type(args[2],integer) or type(args[2],list) or 
                           type(args[2],string)) then
       ERROR(`2nd argument must be a list of vars or a var alone`,args[2]); fi;
    if nargs = 3 and type(args[2],string) then 
       RETURN(procname(args[1],[args[2]],args[3])); fi;
    if nargs=2 and type(args[1],name) then 
       RETURN( procname(eval(args[1]),args[2])); fi;
    if nargs=3 and type(args[1],name) then 
       RETURN( procname(eval(args[1]),args[2],args[3])); fi;

    if nargs = 2 then indeps := [op(1,args[1])]; totaldeg := args[2]; fi;

    if nargs = 3 and type(args[2],integer) then
       if nops([op(1,args[1])]) < args[2] then
          ERROR(`the procedure must have at least`,args[2],` parameters`); 
       else indeps :=[op(1..args[2],[op(1,args[1])])]; 
           # differentiate with respect to the
           # first 'indeps' variables appearing in the procedure's parameterlist
            totaldeg := args[3];
       fi;           
    elif nargs = 3 then indeps := args[2]; totaldeg := args[3];
    fi;               

    params := [op(1,args[1])];
    if ({op(indeps)} intersect {op(params)}) <> {op(indeps)} then
        ERROR(`the list of the independent variables must be a subset of`, 
              `the list of parameters passed to the procedure`,args[2]);    
    fi;

    if not type(GRADIENT,procedure) then
        ERROR(`GRADIENT procedure not loaded`) fi;

    body := args[1];
    if totaldeg = 0 then RETURN(op(body)); fi;
    n := nops(indeps);
    taylor_hess := false;
    include_funcval := true;
    generate_array := false;
    `TAYLOR/Degree` := totaldeg;
    if totaldeg < 2 then return_taylor := true;  fi;
    body := GRADIENT(body,indeps);

    taylor_hess := true;
    include_funcval := false;
    return_taylor := false;

    `delta/k-1` := array(0..n-1);
    `delta/k` := array(0..n-1);
    `total/k-1` := 1; 
    neue := 1;
    for i from 0 to n-1 do `delta/k`[i]:=0; od;
    for k from 0 to totaldeg-2 do
        `delta/k-1` := copy(`delta/k`);
        neue := neue*(n+k)/(k+1); 
        `total/k` := `total/k-1` + neue; 
        `delta/k`[0] := `total/k-1`;
        for j from 2 to n do
            `delta/k`[j-1] := `delta/k`[j-2]+`total/k-1`-`delta/k-1`[j-2];
        od;
        sequ := {};
        for j from 1 to n do
            sequ := sequ union 
                         {seq(t,t=j*`total/k`+1..j*`total/k`+`delta/k`[j-1])};
        od;
        `total/k-1` := `total/k`;
        if k = totaldeg-2 then return_taylor := true; fi;
        body := GRADIENT(op(body),indeps,sequ);
   od;
   taylor_hess := false;
   return_taylor := false;
   `TAYLOR/Degree` := '`TAYLOR/Degree`';
   RETURN(op(body));
end:

`help/text/TAYLOR` := TEXT(
`FUNCTION: TAYLOR - procedure differentiation (algorithmic differentiation)`,
`   `,
`CALLING SEQUNECE :`,
`   `,
`   TAYLOR(f,X,d) -- compute the 'taylor-coefficients' of f wrt to `,
`                    X up to the total degree d`,
`   TAYLOR(f,p,d) -- compute the 'taylor-coefficients' of f wrt to first p`,
`                    variables appearing in the parameterlist of f up to`,
`                    the total degree d`,
`   TAYLOR(f,d) -- compute the 'taylor-coefficients' of f wrt to all`,
`                  variables in the parameterlist of f up to `,
`                  the total degree d`,
`   `,
`PARAMETERS:`,
`   f - a procedure`,
`   X - a name or a list of names`,
`   p - a positive integer`,
`   d - a positive integer`,
`   `,
`SYNOPSIS:   `,
`   `,
`- Given a Maple procedure f, a function of n complex arguments`,
`   `,
`       X = x1, x2, x3, .. , xn`,
`   `,
`  TAYLOR(f,[xi, .. , xk],d) computes the 'taylor-coefficients' of f`,
`  wrt to {xi, .. , xk} up to the total degree d, where 1 <= i,k <= n`,
`  i.e. returns a Maple procedure g, which computes`,
`   `,
`                                    v`,
`       ( D[i] + D[i+1] + .. + D[k] ) f(X)   where  0 <= v <= d`,
`   `,
`  The reason why 'taylor-coefficients' is written in quotes is that`,
`  this coefficients are computed without the leading term  1/(v!) !`,
`   `,
`  Note: Redundant calculations of same derivatives are avoided !`,
`        So the list of these coefficients will have`,
`   `,
`         d                                            d`,
`       -----                                        -----      `,
`        \\    ( m + j - 1 )                           \\      j`,
`         )   (           )   entries, instead of      )    m     !!!`,
`        /    (     j     )                           /`,
`       -----                                        -----`,
`       j = 0                                        j = 0`,
`   `,
`       where m is the number of independent variables in f `,
`       i.e. m = k-i in the notation used above.`,
`   `,
` For example:`,
`   `,
`    > f := proc(x,y,z) x^2*y^3*z^4 end:`,
`    > tf := TAYLOR(f,2):`,
`    > tf(x,y,z):`,
`    > eval("[1]) , eval("[2]) , eval("[3]);`,
`   `,
`     2  3  4         3  4     2  2  4     2  3  3`,
`    x  y  z , [ 2 x y  z , 3 x  y  z , 4 x  y  z  ],`,
`   `,
`            3  4       2  4       3  3     2    4      2  2  3      2  3  2`,
`       [ 2 y  z , 6 x y  z , 8 x y  z , 6 x  y z , 12 x  y  z , 12 x  y  z  ]`,
`   `,
`  This sequence represents the following values:`,
`   `,
`    f(x,y,z), [  D[1](f) ,  D[2](f)  ,   D[3](f)  ],`,
`   `,
`       [ D[1,1](f), D[1,2](f), D[1,3](f), D[2,2](f), D[2,3](f),  D[3,3](f)  ]`,
`   `,
`  The derivatives D[2,1](f), D[3,1](f), D[3,2](f) were eliminated!`,
`    `,
`- The Maple procedure f may contain assigments to temporary (local)`,
`  variables or local defined functions (subroutines).`,
`   `,
`- The returned value of the generated procedure g is always an array.`,
`  Each entry of this array is also an array!`,
`   `,
`- The TAYLOR function is based on the GRADIENT function, so the`,
`  restrictions concerning the procedure f are the same as in GRADIENT.`,
`  The GRADIENT function must be loaded before TAYLOR can be used`,
`  For further information please see GRADIENT.`,
`   `,
`EXAMPLES:   `,
`   `,
`> f := proc(x,y) local a,b,c; a := x*y; b := a*x*y; c := b*x; a*b*c end;`,
`> tf:= TAYLOR(f,2):`,
`> f(x,y);   `,
`   `,
`                                      6  5`,
`                                     x  y`,
`> eval(tf(x,y));`,
`   `,
`                                  6  5`,
`                               [ x  y , t2, t3 ]`,
`> eval("[2]) , eval("[3]);`,
`   `,
`                  5  5     6  4          5  4      5  4      6  3`,
`             [ 6 y  x , 5 x  y  ], [ 30 y  x , 30 x  y , 20 x  y  ]`,
`   `,
`>   `,
`> f := proc(x,y,z) local a; a := x^2*y*z; a*x*y; end;`,
`> tf := TAYLOR(f,[y,z],3):`,
`> eval(tf(x,y,z));`,
`   `,
`                               3  2`,
`                            [ x  y  z, t2, t3, t4 ]`,
`   `,
`> eval("[2]) , eval("[3]) , eval("[4]);`,
`   `,
`              3       3  2         3       3                 3`,
`         [ 2 x  z y, x  y  ], [ 2 x  z, 2 x  y, 0 ], [ 0, 2 x , 0, 0 ]`,
`   `,
`> tf := TAYLOR(f,3):`,
`> eval(tf(x,y,z));`,
`   `,
`                               3  2`,
`                            [ x  y  z, t2, t3, t4 ]`,
`   `,
`> eval("[2]) , eval("[3]) , eval("[4]);`,
`   `,
`            2  2       3       3  2`,
`       [ 3 x  y  z, 2 x  z y, x  y  ],`,
`   `,
`                2         2         2  2     3       3`,
`           [ 6 y  z x, 6 x  y z, 3 x  y , 2 x  z, 2 x  y, 0 ],`,
`   `,
`                2                 2       2       2             3`,
`           [ 6 y  z, 12 x y z, 6 y  x, 6 x  z, 6 x  y, 0, 0, 2 x , 0, 0 ]`,
`   `,
`   `,
`SEE ALSO: D, diff, GRADIENT, JACOBIAN, HESSIAN`
):

#save `TAYLOR.m`;
#quit
