####################################################################################################
## nthterm.mpl
## Recurrence unrolling by binary splitting.
####################################################################################################

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

## Recurrence to operator/matrix

frectopoly := proc(coef, Sn::name, $)
    local i;
    add( coef[i+2]*Sn^i, i=0..ordfrec(coef) )
end proc:

recmatrix[ndmatrix] := proc(L::polynom, Sn::name, $)
    local charpoly, den, M;
    charpoly := evalc(normal(L / lcoeff(L, Sn)));
    den := denom(charpoly);
    M := map(normal,den * Transpose([CompanionMatrix(charpoly, Sn)][1]));
    ndmatrix(M,den)
end proc:

recmatrix[generic] := proc(L, Sn, $) 
    local den, M;
    M, den := op(recmatrix[ndmatrix](args));
    map(normal, 1/den * M, expanded)
end proc:

recmatrix[ndseries] := proc(L, Sn, $)::Matrix(polynom(complex(integer)));
    local den, Mcoef, M, r;
    Mcoef, den := op(recmatrix[ndmatrix](args));
    r := degree(L, Sn);
    M := Matrix(r+1,r+1,Mcoef);
    M[-1,-1] := den;
    M[-1, 1] := den; #???
    return(M);
end proc:

#`recmatrix/imatrix` := proc(L, Sn, $)
#    local den, M, M1, X, Y;
#    M, den := `recmatrix/numden`(args);
#    X := map(evalc@Re, M);
#    Y := map(evalc@Im, M);
#    imatrix(map(convert,X,`horner`), map(convert,Y,`horner`), convert(den,`horner`));
#end proc:

# Voir si je veux mettre des rec partout... (Cf. surtout Nth_term vs /common, et gestion CI.)
frectomatrix := proc(frec, convname::name, $)
    description "Recurrence (formatrec style) --> matrix";
    local Sn, M;
    M := call(recmatrix, convname, frectopoly(frec, Sn), Sn);
    userinfo(5,recmatrix, print(M));
    M;
end proc:

## Initial values

rec_inicond_vector := proc(rec, uofn::function(name))::Vector[column];
    local u,n,i;
    u,n := getname(uofn);
    Vector(subs(select(type,rec,`=`),[seq(u(i),i=0..ordrec(rec,uofn)-1)]));
end proc:

####################################################################################################
## Binary splitting
####################################################################################################

# Prend une matrice dépendant d'un paramètre et deux indices. Calcule le produit matriciel, soit par
# multiplication directe soit par scindage binaire (en se rappelant récursivement), suivant le
# nombre de matrices à multiplier et la taille des coefficients. 
# - Le scindage binaire présente un certain overhead, et *n'apporte rien* tant que la multiplication
# est en régime quadratique. On s'attend donc à ce qu'il devienne intéressant quand le produit des
# coefficients passe à Karatsuba. Quel que soit le nombre de matrices à multiplier, tant que la
# taille des coefs du résultat n'atteint pas ce seuil, on a intérêt à les multiplier naïvement.
# - Les produits à la Waksman, eux, sont intéressants même (voire surtout) pour une multiplication
# d'entiers quadratique. En revanche, ils perdent du temps sur les matrices peu denses.
binsplit := proc(A, n::name, i::integer, j::integer, ring::matrix_ring,
                        expected_entry_size, $)
    description "Given A(n) [usually a matrix], computes A(j-1)...A(i) by binary splitting.";
    local P, P1, P2, k, m, matmult, id, Ak;
    matmult, id := op(2,ring), op(4, ring); ## test
    if j-i <= 3 or expected_entry_size(i,j) <= NumGfun_settings:-binary_splitting_threshold then
        userinfo(5, binsplit, `iterative product, bounds =`, i, j);
        P := id;
        for k from i to j-1 do
            Ak := eval(A, n=k);
            # if A does not depend on n, Maple doesn't copy it when eval() is called, so we need to
            # do it by hand (since the matrix product may be destructive -- well, not anymore)
            #if Ak=A then Ak := map(copy,A) end if;
            P := matmult(Ak, P);
        end do;
    else
        userinfo(5, binsplit, `split, bounds =`, i, j);
        m := iquo(i+j, 2);  #  gmp-chudnovsky.c déséquilibre très légèrement (a+(b-a)*0.5224)
        P1 := binsplit(A,n,m,j,ring,expected_entry_size);
        P2 := binsplit(A,n,i,m,ring,expected_entry_size);
        P := matmult(P1,P2); # try using waksman here?
    end if;
    userinfo(5, binsplit, `entry size: expected =`, expected_entry_size(i,j),
        `measured =`, length(op(1,P)[1,1]));
    P;
end proc:

# Reuse matrices to save on memory management. Maybe a few % faster than /generic.
`binsplit/inlined` := proc(A, n::name, i::integer, j::integer, ring::matrix_ring,
                        expected_entry_size, $)
    description "Given A(n) [usually a matrix], computes A(j-1)...A(i) by binary splitting.";
    local P, P1, P2, k, m, numAk, numA, denA, numP, r, tmp;
    global compact;
    if j-i <= 3 or expected_entry_size(i,j) <= binary_splitting_threshold then
        userinfo(5, binsplit, "iterative product, bounds=", i, j);
        numA, denA := op(A);
        r := op(1,numA); # size
        numP := LA_Main:-IdentityMatrix(r,compact=false,outputoptions=[]);
        tmp := Matrix(r);
        for k from i to j-1 do
            numAk := eval(numA, n=k);
            if numAk=A then numAk := copy(numA) end if;
            mvMultiply(numAk,numP, tmp);
            numP := tmp;
            tmp := numAk;
        end do;
        P := ndmatrix(
            numP,
            mul( eval(denA, n=k), k=i..j-1 ));
    else
        userinfo(5, binsplit, "split, bounds=", i, j);
        m := iquo(i+j, 2);  #  gmp-chudnovsky.c déséquilibre très légèrement (a+(b-a)*0.5224)
        P1 := binsplit(A,n,m,j,ring,expected_entry_size);
        P2 := binsplit(A,n,i,m,ring,expected_entry_size);
        P := ndmatrix( ## test
            mvMultiply(op(1,P1),op(1,P2)),
            op(2,P1) * op(2,P2));
    end if;
    userinfo(10, binsplit, "entry size : expected", expected_entry_size(i,j),
        "real", length(op(1,P)[1,1]));
    P;
end proc:

####################################################################################################
## Nth term
####################################################################################################

extractline[generic] := proc(M::Matrix)
    Row(M, 1)
end proc:

extractline[ndmatrix] := proc(M::ndmatrix)
    ndmatrix(Row(op(1,M),1),op(2,M));
end proc:

extractline[ndseries] := proc(M)
    ndmatrix(M[-1,1..-2],M[-1,-1]);
end proc:

`Nth_term/common` := proc(frec, ringname::name, n::name, N::nonnegative, $)
    local r,P,d,h,expected_entry_size,ring,A,i,k;
    userinfo(5, nth_term, `ring =`, ringname);
    userinfo(6, nth_term, frec);
    userinfo(5, nth_term, "computing term", N);
    r := ordfrec(frec);
    ring := call(genmatring, ringname, r);
    A := frectomatrix(frec, ringname);
    d := max(degree(frec[i],n)$i=1..r);
    h := add(add(length(k), k=coeffs(expand(frec[i]),n)), i=2..r+1);
    expected_entry_size := eval((i,j) -> (j-i)*(d*ilog2(j)+h));
    # Actually [u(k),...,u(N)] = A(k-1)···A(0)·[u(0),...,u(r-1)] where k=N-r+1, but to use that we
    # would have to treat the case N<r separately.
    userinfo(5, nth_term, `calling binsplit...`);
    P := binsplit(A, n, 0, N, ring, expected_entry_size);
    userinfo(5, nth_term, `...binsplit finished`);
    call(extractline,ringname,P);
end proc:

# Attention, cette fonction n'est pas faite pour être appelée par nth_term, mais directement !
`Nth_term/ndseries` := proc(frec,n,dz,N)::ndmatrix;
    description "Computes Sum(f(n)*dz^n,n=0..N-1) where f(n) satisfies rec.";
    local srec,r,i;
    r := ordfrec(frec);
    srec := [ 0, seq(frec[i+2]*(dz)^(r-i), i=0..r)];
    `Nth_term/common`(srec,ndseries,n,N);
end proc:

# ringname should be ndmatrix or ndseries for now
`nth_term/doit` := proc(rec::set, uofn::function(name), N::nonnegative, ringname::name:=ndmatrix)
    description "More user-friendly wrapper around `Nth_term/common`";
    local frec, ordrec, ini, u, n, L, v;
    frec, ordrec, ini := read_rec(rec, uofn);
    u, n := getname(uofn);  # encore une bonne raison de se débarrasser de frec
    L := `Nth_term/common`(frec, ringname, n, N);
    v := ndmatrix_multiply(L, convert(rec_inicond_vector(rec, uofn),ndmatrix));
    [op(1,v)[1],op(2,v)];
end proc:

nth_term := proc(rec::set, uofn::function(name), N::nonnegative, ringname::name:=ndmatrix)
    local v;
    v := `nth_term/doit`(args);
    v[1]/v[2];
end proc:

fnth_term := proc(rec::set, uofn::function(name), N::nonnegative, prec::posint, ringname::name:=ndmatrix)
    local v;
    v := `nth_term/doit`(rec, uofn, N, ringname);
    makeitfloat(v,prec);
end proc:


# Plus ou moins copié-collé des précédentes... (embêtant à abstraire)
rectoproc_binsplit := proc(rec, uofn::function(name))
    description "Returns a procedure computing values of u defined by rec";
    local frec, ordrec, ini, Ini, u, n, d,h,expected_entry_size,ring,A,i, k;
    u, n := getname(uofn);
    frec, ordrec, ini := read_rec(rec, uofn);
    Ini := convert(rec_inicond_vector(rec, uofn),ndmatrix);
    ring := call(genmatring, ndmatrix, ordrec);
    A := frectomatrix(frec, ndmatrix);
    d := max(degree(frec[i],n)$i=1..ordrec);
    h := add(add(length(k), k=coeffs(expand(frec[i]),n)), i=2..ordrec+1);
    expected_entry_size := eval((i,j) -> (j-i)*(d*ilog2(j)+h));
    proc(N)
        local P, L, v;
        P := binsplit(A, n, 0, N, ring, expected_entry_size);
        L := extractline[ndmatrix](P);
        v := ndmatrix_multiply(L, Ini);
        op(1,v)[1]/op(2,v);
    end proc:
end proc:
