####################################################################################################
## Typechecking
####################################################################################################

# Loosely inspired by formatdiffeq. To be improved.
typecheck_hr_eq := proc(l, inicondtype::type)
    local r, ini, eq;
    if type(l, set) then
        r := selectremove(type, l, inicondtype);
        ini, eq := r[1], r[2];
        if nops(eq) <> 1 then return false end if;
        eq := op(eq);
        if type(eq,'`=`') then eq := lhs(eq) - rhs(eq) end if;
        if indets(eq) = {} then
        #or not type(eq, Or(`+`,`*`,specfunc(anything,diff))) then
            return false
        end if;
        return true;
    else
        userinfo(6, NumGfun, "typechecking bare equation");
        return true;
    end if;
end proc:

`type/hrrec` := proc(eq) # human-readable gfun rec
    typecheck_hr_eq(eq, typefunc(nonnegint, name)=anything);
end proc:

`type/hrdeq` := proc(eq) # human-readable gfun deq
    typecheck_hr_eq(eq, 'function'(0)=anything);
end proc:

####################################################################################################
## Misc
####################################################################################################

call := proc(base::table,case::name)
    local casename,fun;
    for casename in [case,`generic`] do
        fun := base[casename];
        if type(fun,procedure) then
            return(fun(args[3..-1]));
        end if
    end do;
    error("Case %1 not implemented for %2",case,base)
end proc:

singularities := proc(deq, yofz)
    local y, z;
    y, z := getname(yofz);
    RootOf(myformatdiffeq(deq,yofz)[-1],z)
end proc:

evalf_absoluteprec := proc(expr, prec::posint)::Float;
    local e;
    e := SFloatExponent(evalf[1](expr));
    evalf[prec+e+1](expr);
end proc:

fail_if_singular := proc(deq, yofz::function(name), points::list)
    local y, z, coef, r, ini, a, lc;
    y, z := getname(yofz);
    lc := read_diffeq(deq, yofz)[1][-1];
    for a in points do
        if eval(lc,z=a) = 0 then
            error("equation %1 is singular in %2", deq, a)
        end if;
    end do;
end proc:

argmax := proc(f, r::name=integer..integer)::integer;
    description "Returns the smallest integer n between first and last for which f(n) is maximal";
    local x, first, last, n, val, nmax, valmax;
    x, first, last := lhs(r), op(rhs(r));
    valmax := -infinity;
    for n from first to last do
        val := eval(f, x=n);
        if val > valmax then
            valmax := val;
            nmax := n;
        end if;
    end do;
    return nmax;
end proc:

falling_factorial := proc(z, n::nonnegint)
    local k;
    return mul(z-k, k=0..n-1)
end proc:

colinear := proc(u::indexable, v::indexable, support)::boolean;
    local i, uoverv, voveru;
    for i in support do
        if assigned(voveru) then
            if normal(v[i] - u[i] * voveru) <> 0 then return false end if;
        elif assigned(uoverv) then
            if normal(u[i] - v[i] * uoverv) <> 0 then return false end if;
        elif u[i] <> 0 then
            voveru := v[i]/u[i]
        elif v[i] <> 0 then
            uoverv := u[i]/v[i]
        end if;
    end do;
    return true;
end proc:

####################################################################################################
## Parsing etc.
####################################################################################################

## Names

getname := proc(fofx::function(name))
    option inline;
    op(0, fofx), op(1, fofx)
end proc:

make_fresh_name_generator := proc(base::name)::procedure;
    local curname;
    curname := 0;
    proc()::name;
        curname := curname + 1;
        return(cat(base,curname))
    end proc:
end proc:

## Recs/diffeqs

ordfrec := proc(frec)::nonnegint;
    nops(frec) - 2
end proc:

orddiffeq := proc(deq, yofz)::nonnegint;
    option remember;
    nops(gfun:-formatdiffeq([deq, yofz])) - 2;
end proc:

ordrec := proc(eq, fofx::function(name))::nonnegint;
    local i,f,x;
    f,x := getname(fofx);
    max(seq(i-x,i=map(op,indets(eq,specfunc(linear,f)))));
end proc:

## FIXME: renvoyer une table pour avoir les indices corrects ?
read_diffeq_or_rec := proc(format_function, eq, fofx)
    local coefs, r, f, x, inicond_eqns;
    f,x := getname(fofx);
    coefs := format_function([eq, fofx], f, x, inicond_eqns);
    r := ordfrec(coefs);
    coefs, r, inicond_eqns
end proc:

read_diffeq := proc(deq, yofz::function(name))
    read_diffeq_or_rec(gfun:-formatdiffeq, args)
end proc:

read_rec := proc(rec, uofn::function(name))
    read_diffeq_or_rec(gfun:-formatrec, args)
end proc:

myformatrec := proc(rec, uofk::function(name))
    gfun:-formatrec([rec,uofk],getname(uofk))
end proc:

####################################################################################################
## Floating point numbers, rounding etc.
####################################################################################################

# on ne se contente pas de tronquer, on regarde le chiffre suivant de sorte que
# abs(résultat-p/q) <= 6/10 · sqrt(2) · 10^(-prec)
# (ce n'est pas pour autant un arrondi au plus proche), sinon, pas moyen de garantir une erreur
# totale <= 10^(-prec) lorsque p/q est déjà inexact !
`makeitfloat/Q[i]` := proc(p,q,prec)
    local mantissa;
    mantissa := proc(num, den)
        local m;
        m := iquo(num*10^(prec+1), q);
        if irem(m, 10) < 5 then
            return iquo(m, 10)
        else
            return iquo(m, 10) + 1
        end if;
    end proc;
    Float(mantissa(Re(p),q)+I*mantissa(Im(p),q),-prec);
end proc:

`makeitfloat/ndmatrix` := proc(mat, prec)
    map(
        p -> makeitfloat(
            [p,op(2,mat)],
            prec),
        op(1, mat));
end proc:

makeitfloat := proc(x, prec::posint)
    if type(x, [complex(integer),integer]) then
        `makeitfloat/Q[i]`(op(x),prec);
    elif type(x, complex(rational)) then
        `makeitfloat/Q[i]`(numer(x),denom(x), prec)
    elif type(x, ndmatrix) then
        `makeitfloat/ndmatrix`(x, prec)
    else
        error("invalid argument, %1", x)
    end if
end proc:


