
#
#--> HESSIAN(f,[xi,..xk]) -- compute  D[j,l](f)     with i <= j,l <= k
#--> HESSIAN(f,p) -- compute  D[j,l](f)             with 1 <= j,l <= p
#                    equivalent to  HESSIAN(f,[x1,..xp])
#--> HESSIAN(f) -- compute  D[j,l](f)               with 1 <= j,l <= n
#                  equivalent to  HESSIAN(f,[x1,..xn])
#
# Given a Maple procedure f, a function of n complex arguments
#
#      X = x1, x2, x3, .. , xn
#
# HESSIAN(f,[xi, .. , xk]) computes the hessian of f wrt {xi, .. , xk}
# where 1 <= i,k <= n. I.e. returns a Maple procedure g, which computes
#
#      hess( f(xi, .. , xk)) = [ diff(f,xj,xl)]  with i<= j,l <= k 
#
# The HESSIAN function uses 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
#

HESSIAN := proc(p) local indeps,body,params,genarr,incfunc;
global taylor_hess, include_funcval, generate_array, return_hess;

    if nargs = 0 then
       ERROR(`procedure 'HESSIAN' needs at least one argument`); fi;
    if (nargs = 1 or nargs = 2) 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 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 =2 and type(args[2],string) then 
       RETURN(procname(args[1],[args[2]])); fi;
    if nargs =1 and type(args[1],name) then 
       RETURN( procname(eval(args[1]))); fi;
    if nargs =2 and type(args[1],name) then 
       RETURN( procname(eval(args[1]),args[2])); fi;

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

    if nargs = 2 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'
       fi;   #  variables appearing in the procedure's parameterlist
    elif nargs = 2 then indeps := args[2];
    fi;               

    if not type(GRADIENT,procedure) then
        ERROR(`GRADIENT procedure not loaded`) 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;
   
    body := args[1];
    taylor_hess := false;
    incfunc := include_funcval;
    include_funcval := false;
    genarr := generate_array;
    generate_array := false;

    body := GRADIENT(body,indeps);

    taylor_hess := true;
    return_hess := true;

    body := GRADIENT(op(body),indeps,{1});
    taylor_hess := false;
    return_hess := false;
    generate_array := genarr;
    include_funcval := incfunc;
    RETURN(op(body));
end:

`help/text/HESSIAN` := TEXT(
`FUNCTION: HESSIAN - procedure differentiation (algorithmic differentiation)`,
` `,
`CALLING SEQUENCE:`,
` `,
`   HESSIAN(f,X) -- compute the hessian of f with respect to X`,
`   HESSIAN(f,p) -- compute the hessian of f with respect to the first`,
`                   p variables appearing in the parameterlist of f`,
`   HESSIAN(f) -- compute the hessian of f with respect to all`,
`                 variables in the parameterlist of f`,
` `,
`PARAMETERS:`,
`   f - a procedure`,
`   X - a name or a list of names`,
`   p - a positive integer`,
` `,
`SYNOPSIS:`,
` `,
`- Given a Maple procedure f, a function of n complex arguments`,
` `,
`       X = x1, x2, x3, .. , xn`,
` `,
`  HESSIAN(f,[xi, .. , xk]) computes the hessian of f wrt {xi, .. , xk}`,
`  where 1 <= i,k <= n. I.e. returns a Maple procedure g, which computes`,
` `,
`       hess( f(xi, .. , xk)) = [ diff(f,xj,xl)]  with i<= j,l <= k `,
` `,
`- The Maple procedure f may contain assigments to temporary (local)`,
`  variables. For example, consider`,
` `,
`       f := proc(x,y) local t; t := cos(x)*sin(y); t*x*y end`,
` `,
`  which uses t as a local variable to compute cos(x)*sin(y)*x*y.`,
`  The output of HESSIAN(f,[x,y]) is the procedure`,
` `,
`	proc(x,y)   `,
`	local t,t1,dt,dt1,ddt;`,
`           dt1 := array(1 .. 2);`,
`           ddt := array(1 .. 2,1 .. 2);`,
`           dt := array(1 .. 2);`,
` 	    ddt[1,1] := -cos(x)*sin(y);`,
` 	    dt[1] := -sin(x)*sin(y);`,
`  	    ddt[2,1] := -sin(x)*cos(y);`,
`  	    ddt[2,2] := -cos(x)*sin(y);`,
` 	    dt[2] := cos(x)*cos(y);`,
` 	    dt1[1] := -sin(x)*sin(y);`,
` 	    dt1[2] := cos(x)*cos(y);`,
` 	    t := cos(x)*sin(y);`,
`  	    t1 := array(1 .. 2,1 .. 2);`,
`  	    t1[1,1] := ddt[1,1]*x*y+dt[1]*y+dt1[1]*y;`,
`  	    t1[1,2] := ddt[2,1]*x*y+dt[2]*y+dt1[1]*x+t;`,
` 	    t1[2,1] := t1[1,2];`,
` 	    t1[2,2] := ddt[2,2]*x*y+dt[2]*x+dt1[2]*x;`,
`  	   t1   `,
`	end   `,
`    `,
`  Note: HESSIAN(f) and HESSIAN(f,2) gives the same output in this case!`,
`    `,
`- The HESSIAN function uses the GRADIENT function, so the restrictions`,
`  concerning the procedure f are the same as in GRADIENT.`,
`  The GRADIENT function must be loaded before HESSIAN can be used`,
`  For further information please see GRADIENT.`,
`    `,
`EXAMPLES:   `,
` `,
`> f := proc(x,y) local a; a := x^2*y; a^3*y; end:`,
`> f(x,y);`,
`                                      6  4`,
`                                     x  y`,
`> hf := HESSIAN(f):`,
`> eval(hf(x,y));`,
`                             [     4  4      5  3 ]`,
`                             [ 30 x  y   24 x  y  ]`,
`                             [                    ]`,
`                             [     5  3      6  2 ]`,
`                             [ 24 x  y   12 x  y  ]`,
`   `,
`> f := proc(a,b,c,d) local e; e := a^2*b*c^2*d; e*a*b*d; end:`,
`> f(a,b,x,y);`,
`   `,
`                                   3  2  2  2`,
`                                  a  b  x  y`,
`    `,
`> hfab := HESSIAN(f,[a,b]): hfba := HESSIAN(f,[b,a]):`,
`> eval(hfab(a,b,x,y)),eval(hfba(a,b,x,y));`,
`   `,
`           [    2  2  2               ]  [    3  2  2               ]`,
`           [ 6 b  x  y  a      %1     ]  [ 2 a  x  y        %1      ]`,
`           [                          ], [                          ]`,
`           [                  3  2  2 ]  [                2  2  2   ]`,
`           [      %1       2 a  x  y  ]  [     %1      6 b  x  y  a ]`,
`   `,
`                                   2  2  2`,
`%1 :=                           6 a  x  y  b`,
`   `,
`> f(a,x,c,d);`,
`  `,
`                                   3  2  2  2`,
`                                  a  x  c  d`,
`> hf := HESSIAN(f,[a,c,d]):`,
`> eval(hf(a,x,c,d));`,
`   `,
`                  [    2  2  2       2  2    2     2  2  2   ]`,
`                  [ 6 x  c  d  a  6 a  x  c d   6 a  x  c  d ]`,
`                  [                                          ]`,
`                  [    2  2    2      3  2  2       3  2     ]`,
`                  [ 6 a  x  c d    2 a  x  d     4 a  x  c d ]`,
`                  [                                          ]`,
`                  [    2  2  2        3  2          3  2  2  ]`,
`                  [ 6 a  x  c  d   4 a  x  c d   2 a  x  c   ]`,
`   `,
`SEE ALSO: D, diff, GRADIENT, TAYLOR, JACOBIAN`,
`   `
):

#save `HESSIAN.m`;
#quit
