#
#--> JACOBIAN([f1,..,fm],[xi,..,xk]) -- compute [ grad(f1,[xi,..,xk]), .. ,
#                                               grad(fm,[xi,..,xk])]
#--> JACOBIAN([f1,..,fm],p) --compute [grad(f1,[xi,..,xp]),..,grad(fm,[xi,..,xp])]
#--> JACOBIAN([f1,..,fm]) -- compute [ grad(f1,[xi,..,xn]),..,grad(fm,[xi,..,xn])]
#
# Given a list f of Maple procedures f1,..,fm, functions of n complex arguments
#
#      X = x1, x2, x3, .. , xn
#  
# JACOBIAN([f1, .. , fm],[xi, .. , xk]) computes the jacobian matrix of the
# function f  (where 1 <= i,k <= n)
#
#	              ( f1(X) )
#	              ( f2(X) )                n    
#         f :  X |--> (   :   )   where  fj : R  ---> R   for 1 <= j <= m
# 	              (   :   )
#  	              ( fm(X) )
#
# i.e. returns a Maple procedure g, which computes
#
# [[diff(f1,xi), .. , diff(f1,xk)], .. , [diff(fm,xi), .. , diff(fm,xk)]]
#
# The returned value of the generated procedure is always an array.
# Each entry of this array is also an array.
#
# The JACOBIAN 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
#

macro( A=addressof, P=pointto );
JACOBIAN := proc(p) 
      local body,locals,params,NewParams,jm,i,b1,b2,t1,h,
            sequ,genarr,funclist,indeplist,nrofvars,NrOfFuncs,gf;
global for_jacobian, generate_array, for_jacobians;

   if nargs = 0 then
       ERROR(`procedure 'JACOBIAN' needs at least one argument`); fi;
   if nargs >= 1 and not type(args[1],list) then
      ERROR(`1st argument must be a list of functions`); fi;
   if nargs = 2 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 a var alone or an integer`,args[2]);
   fi;

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

   if nargs = 2 and type(args[2],string) then 
      RETURN(procname(args[1],[args[2]])); fi;

   funclist := args[1];
   if nargs = 2 and type(args[2],list) then indeplist := args[2]; fi;
   NrOfFuncs := nops(funclist);
   for_jacobian := true;
   genarr := generate_array;
   generate_array := true;
   sequ := NULL;
   nrofvars := 0;
   for i to NrOfFuncs do
       params := [op(1,op(funclist[i]))];
       if nrofvars = 0 then 
          nrofvars := nops(params); 
          NewParams := `JACOBIAN/NewVars`(op(params));
       elif nrofvars <> nops(params) then
ERROR(`the procedure`,funclist[i],`must have`,nrofvars,`parameters `); fi;
       if nargs = 1 then indeplist := params; fi;
       if nargs = 2 and type(args[2],integer) then
          if nops(params) < args[2] then
ERROR(`the procedure`,funclist[i],`must have at least`,args[2],`parameters `); 
          else indeplist :=[op(1..args[2],params)];  fi; 
       fi;
       t1 := P( assemble(29,A(jm[i,'i']),A(h['i'])));
       sequ := sequ,P(assemble(29,A(gf[i]),A(GRADIENT(funclist[i],indeplist)))),
                    P(assemble(29,A(h), A(gf[i](NewParams)))),
                    P(assemble(30,A('i'),A(1),A(1),A(nops(indeplist)),
                                  A(true),A(t1)));
   od;
   b1 := P( assemble( 29, A(jm),A('array'(1..NrOfFuncs,1..nops(indeplist)))));
   b2 := P( assemble( 29, A(gf),A('array'(1..NrOfFuncs))));
   body :=  P( assemble( 34 , seq(A(i), i=[b1,b2,sequ,jm])));
   for_jacobians := false;
   generate_array := genarr;
   locals := gf,jm,'i',h;
   subs( ['BODY'=body,'LOCALS'=locals,'PARAMS'=NewParams],
	     proc(PARAMS) local LOCALS; BODY end )
end:

`JACOBIAN/NewVars` := proc(q) local i,sequ;
        sequ := NULL;
        for i to nargs do
            sequ := sequ , cat('t',i);
        od;
        sequ
    end:

`help/text/JACOBIAN` := TEXT(
`FUNCTION: JACOBIAN - procedure differentiation (algorithmic differentiation)`,
`   `,
`CALLING SEQUENCE:`,
`   `,
`   JACOBIAN(f,X) -- compute the jacobian matrix of f with respect to X`,
`   JACOBIAN(f,p) -- compute the jacobian matrix of f with respect to the first`,
`                  p variables appearing in the parameterlist of f`,
`   JACOBIAN(f) -- compute the jacobian matrix of f with respect to all`,
`                variables in the parameterlist of f`,
`   `,
`PARAMETERS:`,
`   f - a list of procedures`,
`   X - a name or a list of names`,
`   p - a positive integer`,
`   `,
`SYNOPSIS:   `,
`   `,
`- Given a list f of Maple procedures f1,..,fm, functions of n complex arguments`,
`   `,
`       X = x1, x2, x3, .. , xn`,
`   `,
`  JACOBIAN([f1, .. , fm],[xi, .. , xk]) computes the jacobian matrix of the`,
`  function f  (where 1 <= i,k <= n)`,
`   `,
` 	              ( f1(X) )`,
` 	              ( f2(X) )                n    `,
`	  f :  X |--> (   :   )   where  fj : R  ---> R   for 1 <= j <= m`,
`  	              (   :   )`,
`   	              ( fm(X) )`,
`   `,
`  i.e. returns a Maple procedure g, which computes`,
`   `,
`  [[diff(f1,xi), .. , diff(f1,xk)], .. , [diff(fm,xi), .. , diff(fm,xk)]]`,
`   `,
`- The Maple procedures f1,..,fm may contain assigments to temporary (local)`,
`  variables or local defined functions (subroutines)`,
`  For example, consider`,
`   `,
`  f1 := proc(x,y) local a; a := x^3*y^2; a*x*y end`,
`  f2 := proc(u,v) local a; a := 3*u^2*v^3; 4*a*v^2 end`,
`   `,
`  JACOBIAN([f1,f2],2) generates a Maple procedure, which computes the `,
`  following matrix`,
`   `,
`           [ diff(f1,x)   diff(f1,y)  ]`,
`           [                          ]`,
`           [ diff(f2,u)   diff(f2,v)  ]`,
`   `,
`  Note: - In this special case, the statement JACOBIAN([f1,f2]) leads to`,
`          the same result`,
`        - The statement JACOBIAN([f1,f2],[x,y]) will lead to an error,`,
`          because the variables x and y don't match the parameters`,
`          of the function f2!`,
`   `,
`- The returned value of the generated procedure is always a matrix.`,
`   `,
`- The JACOBIAN 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 the JACOBIAN can be used.`,
`  For further information please see GRADIENT.`,
`   `,
`EXAMPLES:   `,
`   `,
`> f1 := proc(x,y) local a; a := x^3*y^2; a*x*y end:`,
`> f2 := proc(u,v) local a; a := 3*u^2*v^3; 4*a*v^2 end:`,
`> jacf := JACOBIAN([f1,f2]);`,
`   `,
`jacf := proc(t1,t2)`,
`        local gf,jm,i,h;`,
`            jm := array(1 .. 2,1 .. 2);`,
`            gf := array(1 .. 2);`,
`            gf[1] := proc(x,y)`,
`                     local a,da,grd;`,
`                         grd := array(1 .. 2);`,
`                         da := array(1 .. 2);`,
`                         da[1] := 3*x^2*y^2;`,
`                         da[2] := 2*x^3*y;`,
`                         a := x^3*y^2;`,
`                         grd[1] := da[1]*x*y+a*y;`,
`                         grd[2] := da[2]*x*y+a*x;`,
`                         grd`,
`                     end                         ;`,
`            h := gf[1](t1,t2);`,
`            for i to 2 do  jm[1,i] := h[i] od;`,
`            gf[2] := proc(u,v)`,
`                     local a,da,grd;`,
`                         grd := array(1 .. 2);`,
`                         da := array(1 .. 2);`,
`                         da[1] := 6*u*v^3;`,
`                         da[2] := 9*u^2*v^2;`,
`                         a := 3*u^2*v^3;`,
`                         grd[1] := 4*da[1]*v^2;`,
`                         grd[2] := 4*da[2]*v^2+8*a*v;`,
`                         grd`,
`                     end                             ;`,
`            h := gf[2](t1,t2);`,
`            for i to 2 do  jm[2,i] := h[i] od;`,
`            jm`,
`        end`,
`   `,
`> f1(a,b),f2(a,b);`,
`   `,
`                                 4  3      2  5`,
`                                a  b , 12 a  b`,
`   `,
`> eval(jacf(a,b));`,
`    `,
`                             [    3  3      4  2 ]`,
`                             [ 4 a  b    3 a  b  ]`,
`                             [                   ]`,
`                             [       5      2  4 ]`,
`                             [ 24 a b   60 a  b  ]`,
`   `,
`SEE ALSO:  D, diff, GRADIENT, TAYLOR, HESSIAN`
):

macro(A = A, P = P);
#save `JACOBIAN.m`;
#quit
