# author: Harm Derksen, university of nijmegen, hderksen@sci.kun.nl
# Generalised pade approximations

`pade2/valuation`:=proc(f,z,x,acc)
local c;
c:=coeff(f,z,1);
if c=0 then acc else ldegree(coeff(f,z,1),x) fi;
end:

`pade2/smaller`:=proc(f,g,z,vars)
local ff,gg;
ff:=grobner[leadmon](coeff(f,z,0),vars)[2];
gg:=grobner[leadmon](coeff(g,z,0),vars)[2];
grobner[leadmon](ff+gg,vars)[2]=gg and f<>0;
end:

`pade2/wipe`:=proc(f,g,z,x,i)
local ff,gg;
ff:=coeff(coeff(f,z,1),x,i);
gg:=coeff(coeff(g,z,1),x,i);
expand(f-ff/gg*g);
end:

pade2:=proc(functionlist,point,accuracy)
local n,x,y,z,i,j,k,l,vars,appr,acc,degrees,maxdegree,smallest,ops,result;
    if not (type(functionlist,list(algebraic)) or type(functionlist,algebraic))
        then ERROR(`first argument must be a function or a list of functions`) fi;
    if not (type(point,name=algebraic) or type(point,name))
        then ERROR(`second argument is wrong`) fi;
    if not (type(accuracy,nonnegint) or type(accuracy,list(nonnegint)))
        then ERROR(`third argument must be a nonnegative integer or a list of nonnegative integers`) fi;
    if not type(functionlist,list) then 
        result:=pade2([1,functionlist],point,accuracy);
        RETURN(normal(-result[1]/result[2])) fi;
    if type(point,name) then 
        RETURN(pade2(functionlist,point=0,accuracy)) fi;
    ops:=[op(point)];x:=ops[1];
    if ops[2]<>0 then RETURN(expand(subs(x=x-ops[2],
        pade2(subs(x=x+ops[2],functionlist),x=0,accuracy))))
    fi;
    appr:=functionlist;
    n:=nops(appr);
    vars:=[seq(y[i],i=1..n),x];
    if type(accuracy,list) then 
        acc:=convert(accuracy,`+`)+n-1;
        maxdegree:=max(op(accuracy));
        degrees:=[seq(maxdegree-accuracy[i],i=1..n)];
    else
        acc:=accuracy;
        degrees:=[seq(0,i=1..n)];
    fi;
    appr:=[seq(expand(x^degrees[i]*y[i]+convert(series(appr[i],x=0,acc),
        `polynom`)*z),i=1..n)];
    for i from 0 to acc-1 do
        k:=0;
        for j to n do
            if coeff(appr[j],z,1)=0 then 
                for l to n while `pade2/smaller`(appr[j],appr[l],z,vars) do od;
                if l=n+1 then
                    RETURN([seq(expand(coeff(appr[j],y[l],1)/x^degrees[l]),l=1..n)])
                fi;
            fi;    
            if `pade2/valuation`(appr[j],z,x,acc)=i then
                if k=0 or `pade2/smaller`(appr[j],appr[k],z,vars) then
                    k:=j;
                fi;
            fi;
        od;
        if k>0 then
            appr:=[seq(`pade2/wipe`(appr[j],appr[k],z,x,i),j=1..k-1),
                expand(x*appr[k]-coeff(appr[k],x,acc-1)*x^acc),
                seq(`pade2/wipe`(appr[j],appr[k],z,x,i),j=k+1..n)];
        fi;
    od;
    smallest:=1;
    for i from 2 to n do
        if `pade2/smaller`(appr[i],appr[smallest],z,vars) then
            smallest:=i;
        fi;
    od;
    [seq(expand(coeff(appr[smallest],y[l],1)/x^degrees[l]),l=1..n)];
end:

`help/text/pade2`:=TEXT(
``,
`FUNCTION:  pade2 - pade approximations.`,
``,
`CALLING SEQUENCE:`,
` pade2([f1,f2,...,fn],x=p,a)`,
` pade2([f1,f2,...,fn],x=p,[d1,d2,...,dn])`,
` pade2(f,x=p,[d,e])`,
` pade2(f,x,[d,e])`,
``,
`PARAMETERS:`,
` f1,f2,...,fn,f   - functions in x, analytic in a neighbourhood of x=p`,
` x                - a name`,
` p                - the point where pade approximation is computed`,
` a                - a nonnegative integer`,
` d1,d2,...,dn,d,e - degree bounds`,
``,
`SYNOPSIS:`,
`- pade2([f1,f2,...,fn],x=p,[d1,d2,...,dn]) computes a generalised`,
`  pade approximation of the list [f1,f2,...,fn] at x=p. The output`,
`  is a list [g1,g2,...,gn] of polynomials in x (not all 0) such that`,
`  f1*g1+f2*g2+...+fn*gn has a zero of multiplicity d1+d2+...+dn+n-1`,
`  at x=p. The degrees of g1,g2,...,gn are bounded by d1,d2,...,dn`,
`  respectively.`,
``,
`- pade2([f1,f2,...,fn],x=p,a) gives a non-trivial list [g1,g2,...,gn] of`,
`  polynomials in x (not all 0) such that f1*g1+f2*g2+...+fn*gn has a zero`,
`  of multiplicity a at x=p. The maximum of the degrees of g1,g2,...,gn`,
`  is minimal.`,
``,
`- pade2(f,x=p,[d,e]) gives a rational function g/h such that h*f-g has`,
`  a zero of multiplicity d+e+1 at x=p. The degrees of g and h are bounded`,
`  by d and e respectively.`,
``,
`- pade2(f,x,[d,e]) does the same as pade2(f,x=0,[d,e])`,
``,
`EXAMPLES:`,
``,
`> pade2([sin(x),cos(x),exp(x)],x=0,[3,2,5]);`,
`                                  2    3                  2`,
`               [- 255 - 51 x + 9 x  + x , 24 + 99 x + 15 x ,`,
``,
`                                       2       3      4        5`,
`                   - 24 + 180 x - 120 x  + 32 x  - 4 x  + 1/5 x ]`,
``,
`> pade2([sin(x),cos(x)],x=Pi,7);`,
`        2                 2        3      2            2     3`,
`  [- 6 x  + 12 x Pi - 6 Pi  + 15, x  - 3 x  Pi + 3 x Pi  - Pi  - 15 x + 15 Pi]`,
``,
`> ff:=[cos(2*x)*(x+1)+3,cos(x)^2+x*cos(x)+1,cos(2*x)+1,cos(x)]:`,
`> gg:=pade2(ff,x=0,20);`,
``,
`                                                      2`,
`                        [-1, - x + 2, 3/2 x, - 2 x + x ]`,
``,
`> simplify(ff[1]*gg[1]+ff[2]*gg[2]+ff[3]*gg[3]+ff[4]*gg[4]);`,
``,
`                                       0`,
``,
`> pade2(tan(x),x,[7,4]);`, 
`                             6        4          2`,
`                         x (x  + 210 x  - 17955 x  + 155925)`,
`                   1/105 -----------------------------------`,
`                                    4        2`,
`                                26 x  - 666 x  + 1485`,
``
):


#save `pade2.m`;
#quit
