####################################################################################################
## Utilities
####################################################################################################

`value/Coeftayl` := proc(expr, eqn, k)
    if type(k, nonnegint) then
        return(coeftayl(args))
    else
        return(Coeftayl(args))
    end if;
end proc:

## Roots & poles

first_root := proc(P::polynom, x::name, $) # deprecated
    description
        "Compute a floating-point approximation of the first (nearest from 0) root"
        "of a polynomial";
    convert(min(op(map(abs, {fsolve(P, x, complex)}))),rational)
end proc:

root_multiplicity := proc(p::polynom, z::name, alpha::complexcons)::nonnegint;
    local m;
    for m from 0 while eval(evala(p/(z-alpha)^m),z=alpha)=0 do NULL end do;
    m;
end proc:

pole_multiplicity := proc(rat::ratpoly, z::name, alpha::complexcons)::nonnegint;
    root_multiplicity(denom(normal(rat)), z, alpha)
end proc:

dominant_root := proc(p::polynom, z::name)
    local candidates;
    candidates :=  sort(
        map(
            x -> [x, root_multiplicity(p,z,x)],
            infsing(1/p, z)[1]),
        proc(x,y) x[2]<y[2] end proc);
    return(op(candidates[1]));
end proc:

## Inequations

solve_ineq := proc(ineq::`<`,x::name, n0 := 0, $)::posint;
    description "Finds n >= n0 s.t. expr(n) < epsilon (for nonnegative nonincreasing expr)";
    local expression,evalexpr,epsilon,dicho,n;
    expression := lhs(ineq);
    epsilon := rhs(ineq);
    evalexpr := proc(t)
        evalf(subs(x=evalf(t),expression)) # evalf for speed, as usual
    end proc:
    dicho := proc(i, j)
        local m;
        m := iquo(i+j,2);
        if j-i <= 2 then j elif evalexpr(m) > epsilon then dicho(m,j) else dicho(i,m) end if;
    end proc:
    n := n0;
    while evalexpr(2*n) > epsilon do n := 2*n end do;
    n := dicho(n,2*n);
    return n;
end proc:

####################################################################################################
## Rational polynomials
####################################################################################################

bound_ratpoly_int := proc(rat::ratpoly, x)
    local critical, candidates, i;
    description "Compute a bound on the abs(rat(i)), i nonnegative integer.";
    critical := {fsolve(denom(rat)=0),fsolve(diff(rat,x)=0)};
    candidates := select(
        type,
        map(ceil, critical) union map(floor, critical) union {0},
        'nonnegative');
    max( seq(eval(rat, x=i), i in candidates) );
end proc:

# more or less dead code
bound_ratpoly_on_disk := proc(rat::ratpoly, z::name, radius::realcons, $)::realcons;
    local theta, m, eq, critical;
    description "Bound a rational function on a zero-centered disk (containing no pole).";
    if rat = 0 then
        0
    else
        m := eval(abs(rat)^2, z=radius*exp(I*theta)) assuming theta::real;
        eq := numer(convert(diff(m, theta),trig));
        critical := select(type,{evalf(solve(eq,theta))},float) union {0.};
        max(op(map(t -> eval(m, theta=t), critical)));
    end if;
end proc:

# - Hypothèses sur alpha et m :  ce sont 'au pire' l'inverse du premier pôle, et sa multiplicité.
# - Peut-être à raffiner : borne valable à partir d'un certain rang ???
bound_ratpoly_coeffs := proc(rat::ratpoly, z::name, alpha::complexcons, m::posint, $)::realcons;
    description "Computes M s.t. M/(1-abs(alpha)·z)^m is a majorant series for rat---that is,"
        "rat(z) = Sum(u_n·z^n) where |u_n| <= M·binomial(n+m-1,m-1)·alpha^n.";
    option remember;
    local auxrat, n, vofn, allv, Zum, a, A, s, M_ini, M, j;
    if type(rat, constant) then return(abs(rat)) end if;
    auxrat := subs(z=z/convert(evalf(abs(alpha)*11/10),rational), rat);
    # Maybe a bit more elegant, but slower
    #auxrat := subs(z=z/alpha, rat);
    s := degree(numer(auxrat));
    vofn := ratpolytocoeff(auxrat, z, n) / binomial(n+m-1,m-1);
    if hasfun(vofn, piecewise) then
        M_ini := max(seq(evalf(abs(subs(n=j, vofn))),j=0..s-1));
        vofn := simplify(vofn) assuming n > s;
    else
        M_ini := 0
    end if;
    # Maple 10 bug: allvalues doesn't understand Sum's over RootOf's
    vofn := subs({seq(Zum=add(subs(op([2,1],Zum)=a,op(1,Zum)),a=allvalues(op([2,2],Zum))),
        Zum=indets(vofn,specfunc(anything,Sum)))},vofn);
    allv := expand(allvalues(vofn, 'implicit'));
    allv := subs(
        {seq(A=1,A=indets(allv, constant^(Or(identical(n),constant&*identical(n)))))},
        allv);
    allv := evalf(allv);
    allv := map(abs,allv) assuming n::posint; # for some reason nonnegint isn't enough
    M := max(M_ini, map(bound_ratpoly_int,allv,n));
        # FIXME: BUG si racine non dominante de multiplicité plus grande que la plus grande
        # multiplicité d'une racine dominante.
    userinfo(15, bounds, allv, M);
    M
end proc:

bound_ratpoly := proc(xrat::ratpoly, z::name, $)
    description "Computes a majorant of the form M/(1-rho)^m for rat.";
    local rat, rho, m,M, B;
    userinfo(1, bounds, series(xrat,z));
    rat := normal(xrat);
    rho, m := dominant_root(denom(rat), z);
    if rho = 0 then
        error("0 is a pole of %1",xrat);
    end if;
    M := ceil(bound_ratpoly_coeffs(rat,z,1/rho,m));
    B := simplify(M/(1-z/abs(rho))^m);
    userinfo(15, bounds, ( map(abs, convert(series(xrat, z, 20),polynom)) -
        convert(series(B,z,20),polynom) ))
    assuming z::positive;
    return(B);
end proc:

###################################################################################################
## 'Tight' bounds for holonomic functions
###################################################################################################

# Unified backend for bound_diffeq, bound_rec and needed_terms. Fields of the output are meant for
# the respective internal use of these functions.
majorant_series := proc(deq, yofz::function(name))
    option remember;
    local y,z,coef,r,none,nbterms_proc,coeff_bound,nmin,majorant,rad,P,rho,alpha,M,j,K,
        basemaj,N,A,algeq,exponents,n;
    y, z := getname(yofz);
    coef, r, none := read_diffeq(deq, y(z));
    ASSERT(coef[1] = 0);

    # Default values, may be overriden by particular cases (only `reg sing` does for now)
    # rad = (near-)optimal radius from the saddle point method, as a function of n;
    # nmin = n s.t. for k>=n one has rad > z (as a function of z)
    nbterms_proc := proc(derivation_order, absdz, epsilon)
        local n1,gj,rest_bound;
        userinfo(1,bounds,"rad"=rad);
        n1 := eval(nmin,z = absdz);
        gj := diff(majorant, [z$derivation_order]);
        rest_bound := eval(gj, z=rad) * (absdz/rad)^n * 1/(1-absdz/rad);
        solve_ineq(rest_bound < epsilon, n, n1);
    end proc:
    coeff_bound := proc(n)
        Coeftayl(majorant,z=0,n)
    end proc:

    P := table([seq(j = coef[j+2], j=0..r)]); # force indexation from 0
    rho := dominant_root(P[r],z)[1];
    userinfo(5, bounds, `dominant singularity` = rho);
    if rho = 0 then error "equation singular in 0" end if;
    alpha := abs(1/rho);

    if alpha <> 0 then # singular point at finite distance
        M := table([seq(j = bound_ratpoly_coeffs(P[j]/P[r], z, 1/rho, r-j), j = 0..r-1)]);
            # Pourquoi pas K+r-j ?! Cf. rapport.
        K := max(seq( pole_multiplicity(P[j]/P[r],z,rho) - r + j, j=0..r-1 ));
        if K >= 1 then
            userinfo(5, bounds, `type` = `irregular singular`); # Fuchs criterion
            M := ceil(max(seq( M[j] / (binomial(r-1,r-1-j) * pochhammer(K,j) * alpha^j), j=0..r-1)));
            basemaj := exp(M/(1-alpha*z)^K);
            nmin := ceil(M*K/(1-alpha*z)^K);
            rad := 1/alpha * (1 - (M*K/n)^(1/(K+1)));
        else
            userinfo(5, bounds, `type` = `regular singular`);
            if M[0] = 0 then M[0] := 1 end if;  # only look for nonconstant (N>0) majorants
            algeq := expand(pochhammer(N,r))*alpha^r = add(M[j]*alpha^j*expand(pochhammer(N,j)),j=0..r-1);
            exponents := select(type,{fsolve(algeq,N)},positive);
            ASSERT(nops(exponents)=1);
            N := ceil(op(exponents));
            basemaj := 1/(1-alpha*z)^N;
            nbterms_proc :=  proc(derivation_order, absdz, epsilon)
                local rest_majorant, k;
                rest_majorant := A * Product(N+n+k,k=0..derivation_order-1) * binomial(N+n-1,n)
                    * alpha^derivation_order * (alpha * absdz)^n
                    * Hypergeom([1, N+n+derivation_order], [n+1], alpha*absdz);
                solve_ineq(eval(rest_majorant) < epsilon, n, 1);
            end proc:
            coeff_bound := proc(n)
                binomial(n+N-1,N-1) * alpha^n
            end proc:
        end if;
    else # no singular point at finite distance
        K := max(0, seq( degree(P[j] + r - j), j=0..r-1 ));
        M := 1/abs(P[r]) * max(op(map(abs,{seq( coeffs(P[j]), j=0..r-1 )})));
        if M = 0 then M := 1 end if;
        basemaj := exp(M*add(z^j/j,j=1..K+1));
        nmin := ceil(M*z^(K+1));
        rad := (n/M)^(1/(K+1));
    end if;
    # For many usual functions alpha>=1 and A=1
    A := ceil(max(op(map(x->1/x,seriestolist(series(evalf(basemaj),z,r))))));
    majorant := A * basemaj;
    return(table([`series` = majorant, `coeff` = coeff_bound, `nbterms` = nbterms_proc]));
end proc:

# Ce n'est pas le prototype qu'on avait évoqué, mais faute de belle expression pour le reste...
bound_diffeq := proc(deq::set, yofz::function(name), z0::complexcons:=0)
    local y, z, localdeq;
    y,z := getname(yofz);
    fail_if_singular(deq, yofz, [z0]);
    localdeq := diffeqtohomdiffeq(algebraicsubs(deq,y=z+z0,y(z)),y(z)); # I may move this into step_tm
    return(simplify(majorant_series(localdeq, yofz)[`series`]));
end proc:

bound_rec := proc(rec::set, uofn::function(name))
    local deq, y, z, u, n, maj, bound_ini, j;
    u,n := getname(uofn);
    deq := diffeqtohomdiffeq(rectodiffeq(rec, u(n), y(z)),y(z));
    fail_if_singular(deq, y(z), [0]);
    maj := majorant_series(deq, y(z))[`coeff`];
    bound_ini := eval( add(abs(u(j)),j=0..ordrec(rec,uofn)-1), rec );
    return(simplify(bound_ini * maj(n))) # maj(n) to use the right variable
end proc:

`needed_terms/sharp` := proc(deq, yofz, derivation_order, z0, z1, epsilon)
    local y,z,localdeq;
    y,z := getname(yofz);
    localdeq := algebraicsubs(deq,y=z+z0,y(z)); # I may move this into step_tm
    majorant_series(localdeq, yofz)[`nbterms`](derivation_order,abs(z1-z0),epsilon);
end proc:

# needed_terms := `needed_terms/sharp`;

###################################################################################################
## Other (older) majorant series bounds
###################################################################################################

# Computes a majorant for the rest starting at n of the expansion in z0 of some derivative of
# any base solution; working on a disk of radius 1/nu (which must not contain any singularity).
# Inspiré de [vdH01].
`rest_majorant/vdHlike` := proc(inideq, yofz, n, derivation_order, z0, z1, $)
    option remember;
    local y,z,coef,r,P,rho,nu,M,N,A,none,absdz,i,k,bounds,j;
    y, z := getname(yofz);
    coef, r, none := read_diffeq(algebraicsubs(inideq,y=z+z0,y(z)), y(z));
    ASSERT(coef[1] = 0);
    P := table([seq(i = coef[i+2], i=0..r)]); # table pour forcer l'indexation 0..r
    rho := first_root(P[r], z); # rho may =infty
    absdz := abs(z1 - z0);
    if evalf(1/absdz < 1/rho) then # evalf --> sinon pbs pour tester...
        error "z1 should be inside the disk extending to the first singularity"
    end if;
    nu := (1/absdz+4/rho)/5; # compromis à faire...
    ASSERT( evalf(nu*absdz) < 1 );
    M := table([seq(
        i = bound_ratpoly_on_disk(P[i]/P[r], z, 1/nu),   # essayer avec bound_ratpoly_coefs
        i = 0..r-1)]);
    N := ceil(
        1/nu
        * max( seq(
            evalf((r*M[i])^(1/(r-i))),
            i = 0..r-1)));
    # Ici je peux remplacer le max par un seul terme si je veux juste une solution de base. Mais les
    # dérivées d'une même solution de base, je les calcule toutes d'un coup : il faut donc bien que
    # ma borne soit valable pour toutes. 
    A := max(seq(
        1 / ( nu^j * binomial(N+j, j) ),
        j = 0..r-1)); 
    userinfo(5, bounds, "N=", N, "A=", A);
    # Borne sur le reste commençant à n de la dérivée i-ième d'une solution de base quelconque.
    # (Cette forme s'évalue bien par evalf, pour un nombre de termes/précision jusqu'à quelques
    # millions.)
    return(A * Product(N+n+k,k=0..derivation_order-1) * binomial(N+n-1,n) * nu^derivation_order
        * (nu * absdz)^n * Hypergeom([1, N+n+derivation_order], [n+1], nu*absdz));
end proc:

`needed_terms/vdH01/maj` := proc(deq, yofz, derivation_order, z0, a, epsilon)
end proc:

###################################################################################################
## Bounds on values
###################################################################################################

bound_transition_matrix := proc(deq, yofz::function(name), path::list(complexcons), $)::realcons;
    option remember;
    local steps,r,m,i,n,majorant,B1,B2,B3,k,y,z;
    y,z := getname(yofz);
    steps := nops(path) - 1;
    if steps <= 0 then
        return 1
    end if;
    m := iquo(steps+1, 2);
    B1 := bound_transition_matrix(deq,yofz,path[1..m]);
    B3 := bound_transition_matrix(deq,yofz,path[m+1..-1]);
    majorant := bound_diffeq(deq,yofz,path[m]);
    r := orddiffeq(deq,yofz);
    B2 := r * max(seq(
        evalf(eval(
            diff(majorant,[z$k]),
            z=abs(path[m+1]-path[m]))),  # sic...
        k=0..r-1));
    userinfo(5, bounds, path, majorant, B1*B2*B3);
    B1 * B2 * B3;
end proc:

# exporté mais inutilisé par mon code
bound_values := proc(deq, yofz::function(name), z0::complexcons, z1::complexcons, $)::realcons;
    description "Bounds the values of the base solutions of deq (that is, the first line of the",
        "transition matrix) in the disk centered in z0 extending to z1.";
    local B, n, i;
    B := evalf(eval(bound_diffeq(deq, yofz, z0), z = abs(z1-z0)));
    userinfo(5, bounds, [z0,z1], B);
    B
end proc:

####################################################################################################
## Naive implementation of the bound from [vdH01]
####################################################################################################

`needed_terms/vdH01/zero` := proc(deq, yofz, derivation_order, z0, a, epsilon)
    local coef, r, inicond_eqns, B, rho, tau, N, C1, C2, p, y, z;
    y, z := getname(yofz);
    if derivation_order <> 0 or z0 <> 0 then
        error("Only derivation_order=0, z0=0 are allowed with `needed_terms/vdH01/zero`");
    end if;
    p := max(0, -log10(epsilon));
    coef, r, inicond_eqns := read_diffeq(deq, yofz);
    rho := simplify(convert( (abs(a)+first_root(coef[r+2],z))/2, rational)); 
    if rho = +infinity then rho := convert( 2*abs(a), rational) end if;
    tau := rho/abs(a); 
    ASSERT(tau > 1);
    B := evalf(vdH01_bound(deq, yofz, 1/rho));
        # Attention, B n'est pas une borne sur les valeurs de f (mais tq |f_k| <= B mu^k tout de
        # même).
    C1 := evalf(1/log10(tau));
    C2 := evalf(log10(B/(1-1/tau)) / log10(tau));
    N := ceil( C1 * (p+1) + C2 );
end proc:

needed_terms := `needed_terms/sharp`;
#needed_terms := `needed_terms/vdH01/zero`;

# See [vdH01, §2.4]. Traduction la plus directe possible des formules de l'article
vdH01_bound := proc(deq, yofz, mu)
    local coef, r, inicond_eqns, P, lambda, nu, M, N, A, f, y, z;
    coef, r, inicond_eqns := read_diffeq(deq, yofz);
    y, z := getname(yofz);
    if coef[1] <> 0 then
        error "inhomogenous equation"
    end if;
    P := table([seq(i = (coef[i+2]), i=0..r)]);
    f := table([seq(
        subs( inicond_eqns, i = (D@@i)(y)(0) / i! ),
        i = 0..r-1 )]);
    lambda := 1/first_root(P[r],z);
    if evalf(mu) < evalf(lambda) then
        error "1/mu should be smaller than the distance to the first singularity"
    end if;
    nu := convert((lambda + mu)/2, rational);
    #nu := convert((lambda + 4*mu)/5, rational);
    M := table([seq(
        i = bound_ratpoly_on_disk(P[i]/P[r], z, nu),
        #i = bound_ratpoly_coeffs(P[i]/P[r], z, nu, 1), 
        i = 0..r-1)]);
    N := ceil(
        1/nu
        * max( seq(
            evalf((r*M[i])^(1/(r-i))),
            i = 0..r-1)));
    A := max(seq(
        abs(f[i]) / ( nu^i * binomial(N+i, i) ),
        i = 0..r-1));
    evalf(A * binomial( ceil(mu/(mu-nu) * N), N ) * (nu/mu)^floor( nu/(mu-nu) * N ))
end proc:


