#################################################################
#
# Module: PrimitiveInt							                                      					   
#################################################################

PrimitiveInt :=module()
   option package;
  description "algorithms for a  primitive tower";
  export
    DecompositionOfRemainder,
    DecompositionOfGenerators,
    AlgRaab,
    DifferentiateResidue,
    LocalResidue,
    ConstantCoefficient,
    PrimInt,
    PolynomialMatrix,
    LogarithmicPartI;
      
##################################################################
#Name: DecompositionOfRemainder
#Calling sequences: DecompositionOfRemainder(x, T, f)
#Input: x, a variable;
#           T=[t_1,...,t_n], a list of indeterminates, maybe empty;
#           f, a remainder in the primitivel tower generated by T;
#Output: two lists M, N such that
#               M=[h_n, ...,h_2,h_1,h_0], where h_i is prperly t_i-simple,
#               N=[p_n,p_{n-1}, ....,p_1], where p_i belongs to  t_iK_{i-1}[t_i]
###################################################################
DecompositionOfRemainder :=proc(x, T, f)
    local ff, n, A, q, M, N, C;
         ff := normal(f);
         if T=[] then
             return  [ff], [];
         end if;
         n := nops(T);
         A := Rational:-ProperAndPolynomialParts(ff,T[n]);
         q := coeff( A[2],T[n], 0); 
         C := DecompositionOfRemainder(x, [op(1..n-1, T)], q);
         M := [op(C[1]),A[1]];
         N := [op(C[2]), normal(A[2]-q)];
         return M, N;
      end proc:
########################################################################
#Name: DecompositionOfGenerators
#Calling sequence: DecompositionOfGenerators(x, T, dT)
#Input : x, a variable;
#            T=[t_1,...,t_n], a list of primitive monomials, not empty
#            dT=[t_1',...,t_n'], a list of derivatives
#Output: A n-order matrix M and a (n-1)-order matrix N  and a list  v such that
#                m_{ji} is the properly $t_{j-1}$-simple part of the remainder of $dT[i]$ in K_{i-1},
#                n_{ji}  is the polynomial part w.r.t. $t_{i-1}$ of the remainder of $dT[i]$ in K_{i-1},
#                 v_i is  an integrable part of $dT[i]$ in K_{i-1}
########################################################################

 DecompositionOfGenerators:=proc(x,T, dT)
    local RP, B, M, N,v,i, n;
       RP := PrimitiveTower:-CompleteReduction(x, [], [], normal(dT[1]));
       v := [RP[1]];
       n := nops(T);
       B := DecompositionOfRemainder(x,[op(1..(n-1),T)] , RP[2]);
       M :=<<op(B[1])>>;
       N := <<op(B[2])>>;
       
       for i from 2 to n do
             RP :=PrimitiveTower:-CompleteReduction(x, [op(1..i-1, T)], [op(1..i-1, dT)], normal(dT[i]));
             v :=[op(v), RP[1]];
             B := DecompositionOfRemainder(x, [op(1..(n-1),T)], RP[2]);
             M := <M|<op(B[1])>>;
             N := <N|<op(B[2])>>;
       end do;
       return M, N, v;
     end proc:

####################################################################
# Name:  AlgRaab
# Calling sequence: AlgRaab(x, T, dT, f, L)
# Input:   x,    a variable of the base field C(x);
#          T = [t1, t2, .., tn],    a list of indeterminates over the base field, T<>[];
#          dT = [t1', t2', .., tn'],   a list of derivatives of elements in T, maybe [];
#          f,   a tn-simple function in C(x, T);
#          L,   a list of properly t_n-simple function;
# Output:  [rn, cn, A, v], 
#                rn -- the number of rows of A,
#                cn -- the number of columns of A,
#                A,  a matrix over C,
#                v,  a vector in C^{rn}
#                such that  all the residues of f - c[1]*L[1] - ... - c[m]*L[m] are constants iff
#                          A(c[1], ..., c[m])^t = v'
############################################################################################### 

AlgRaab  := proc(x, T, dT, f, L)
  local m, c, g, r, S, i, j, k, H, rn, cn, A, v, s;
     m := nops(L);
     c := array(1..m);
     g := f - add(c[i]*L[i], i=1..m);

     if g = 0 then 
        rn := 1; cn := m;
        A := Matrix(rn, cn);
        v := Matrix(rn, 1);
        return [rn, cn, A, v];
      end if; 

      r := numer(DifferentiateResidue(x, T, dT, g, denom(g)));
      S := [coeffs(collect(r, [x, op(T)], 'distributed'), [x, op(T)])];
      H := {seq(c[k]=0,k=1..m)}; 
      rn := nops(S);
      cn := m;
      A := Matrix(rn, cn);
      v := Matrix(rn, 1);
      for i from 1 to rn do
           s := S[i];
           v[i,1] := -normal(subs(H, s));
           for j from 1 to cn do
                A[i, j] := coeff(s, c[j], 1);
           end do;
      end do; 
      return [rn, cn, A, v];
end proc:

################################################################################################
# Name: DifferentiateResidue
# Calling sequence: DifferentiateResidue(x, T, dT, f, p)
# Input:   x,    a variable of the base field C(x);
#             T = [t1, t2, .., tn],    a list of indeterminates over the base field, maybe [];
#             dT = [t1', t2', .., tn'],   a list of derivatives of elements in T, maybe [];
#             p,   a normal polynomial in \bC(x, t1, ..., t_{n-1})[t_n].
#             f,   a rational function in \bC(x, T);
# Output:  the derivative of the residue of f at p
############################################################################################# 
DifferentiateResidue := proc(x, T, dT, f, p)
   local r, n, s;
   r := LocalResidue(x, T, dT, f, p);
   n := nops(T);
   if n = 0 then
      return 0;
   end if;
   s := DField:-AlgebraicDerivative(x, [op(1..n-1, T)], [op(1..n-1, dT)], T[n], p, r);
   return s;
end proc:

###########################################################################################
# Name: LocalResidue
# Calling sequence: LocalResidue(x, T, dT, f, p)
# Input:   x,    a variable of the base field C(x);
#             T = [t1, t2, .., tn],    a list of indeterminates over the base field, maybe [];
#             dT = [t1', t2', .., tn'],   a list of derivatives of elements in T, maybe [];
#             p,   a normal polynomial in \bC(x, t1, ..., t_{n-1})[t_n].
#             f,   a tn-element in \bC(x, T) or an x-simple function if T = [];
# Output:  the residue of f at p
###########################################################################################
LocalResidue := proc(x, T, dT, f, p)
  local a, b, n, t, r, q, u;
  (a, b) := numer(f), denom(f);
  n := nops(T);
  if n = 0 then
     t := x;
  else
     t := T[n];
  end if;
  r := rem(b, p, t, 'q');
  if r <> 0 then
     return 0;
  end if;
  gcdex(q*DField:-Derivative(x, T, dT, p), p, t, 'u');
  return rem(a*u, p, t);
end proc:

####################################################################
# Name:  PolynomialMatrix
# Calling sequence: PolynomialMatrix(x, T, P, G)
#          x,  a variable
#          T, a list of variable,
#          P,  a list of  polynomial parts with the 0-coefficient being 0 of a remainder in K_n, order n
#          G, a (n-1)* n  matrix 
# Output:  [ A, v], 
#                A,  a matrix over C,
#                v,  a vector in C^{rn}
#                such that  P[i] - c[1]*G[i,1] - ... - c[n]*G[i,n ] =0 for 1<=i<=n-1
############################################################################################### 

PolynomialMatrix  := proc(x, T, P, G)
  local n, c, M, v, g,  S, H, i, j,l, k, rn, cn, A, w,  s;
     n := nops(P);
     if P[n]<>0 then
         return (false);
     end if;
     c :=array(1..n); 
     M :=Matrix(1, n);
     v  := Matrix(1, 1);
     
     for l from 1 to n-1 do
           g := P[l]-add(c[j]*G[l, j], j=1..n);
           if g<>0 then
              S := [coeffs(collect(numer(g), [x, op(T)], 'distributed'), [x, op(T)])];
              H := {seq(c[k]=0,k=1..n)}; 
             rn := nops(S);
            A := Matrix(rn, n);
            w := Matrix(rn, 1);
           for i from 1 to rn do
              s := S[i];
              w[i,1] := -normal(subs(H, s));
               for j from 1 to n do
                A[i, j] := coeff(s, c[j], 1);
              end do;
          end do; 
        M := MTM:-vertcat(M,  A);
        v  := MTM:-vertcat(v, w);  
       end if; 
    end do;
      return [M, v];
end proc:

#####################################################################
#Name : ConstantCoefficient
#Calling sequence: ConstantCoefficient(x, T, dT, F, G, _Z)
#Input: x, a variable;
#           T=[t_1,...,t_n], a list of primitive monomials, not empty;
#           dT=[t_1',...,t_n'], a list of derivatives
#            F, a list of properly simple parts of a remainder in K_n;
#            G, a list of  polynomial parts with the 0-coefficient being 0 of a remainder in K_n;
#Output: C, a list of n constants, 
#              lt, a logarithmic derivative
#              such that all the residues of r-c[1]*\phi_0(dT[1])-...-c[n]*\phi_{n-1}(dT[n]) are constants and lt is the 
#              Log part of the properly $t_n$-simple part of r; false, if there exist no such constants
################################################################### 

ConstantCoefficient :=proc(x, T, dT, F, G, _Z)
     local  n, lt, B, M, v, i, N, sols, S, C,s;
       n := nops(T);

       #-----------------------------------------------
       # handle  polynomial part of r w.r.t. t
       #-----------------------------------------------
        if G[n]<> 0 then
           return false;
        end if;
          
       #----------------------------------
       # handle properly $t_n$-simple part of r 
       #----------------------------------

       if F[n+1]<>0 then
           lt   := LogPart:-CompleteLogarithmicPart(x, T, dT, F[n+1], _Z);
           if lt ='false' then
              return false;
           end if;
        else
           lt:=0;
        end if;
      
       #---------------------
       # base case 
       #---------------------        
        if n=1 then
           return [0], lt;
        end if;
        
       B := DecompositionOfGenerators(x, T, dT);
       M := PolynomialMatrix(x, T, G, B[2])[1];
       v := PolynomialMatrix(x, T, G, B[2])[2];
       for i from 2 to n do
             N := AlgRaab(x, [op(1..(i-1), T)],[op(1..(i-1), dT)],  F[i], convert(LinearAlgebra:-Row(B[1], i),list));
             M := MTM:-vertcat(M,  N[3]);
             v  := MTM:-vertcat(v, N[4]);
         end do;
         try
            sols := LinearAlgebra:-LinearSolve(M,v,free = 's');
            catch "inconsistent system":
             return(false);
         end try;
         S := {seq(s[j,1]=0,  j=1..n)};
         C := [seq(subs(S, sols[j,1]),  j=1..n)];
         return C, lt;
         end proc:

##############################################################
#Name: LogarithmicPartI
#Calling sequence: 
#      LogarithmicPartI(L, _Z)
#Input:   L, a list of logarithmic derivatives in algebraic form
#            _Z, an indeterminate;
#Output: w, the integral of L 
###############################################################
LogarithmicPartI := proc(L, _Z)
      local m, w, i, p, g, _R, dz, k;
      if L = 0 then return 0;  end if;
      m := nops(L);
      w := 0; 
      for i from 1 to m do 
            (p, g) := L[i][1], L[i][2];
            _R := RootOf(p=0, index = k);
            dz := degree(p, _Z);
             w  := w  + sum(_R*subs(_Z=_R, log(g)),  k=1..dz);
      end do;
      return w;
end proc:
#####################################################################
#Name : PrimInt
#Calling sequence: PrimInt(x, T, dT, f)
#Input: x, a variable;
#           T=[t_1,...,t_n], a list of Primlnt monomials, maybe empty;
#           dT=[t_1',...,t_n'], a list of derivatives
#           f, a rational function in C(x)(T);
#Output: the integral of f if f has an elemenrary integral over C(x)(T),
#              Otherwise, return false
###################################################################    
PrimInt :=proc(x, T, dT, f)
    local ff, RP, g, R, F, h, C, lt, n, A, r, s, lp, m, integral, i;

       #--------------------------
       # trivial case
       #--------------------------

       ff := normal(f);
       if ff = 0 then
          return 0;
       end if; 

      #---------------------------
      #CompleteReduction
      #---------------------------

       RP :=PrimitiveTower:-CompleteReduction(x, T, dT, ff);
       (g, R) := RP[1], RP[2];
       F := DecompositionOfRemainder(x, T, R);

      #-----------------------------
      # Raab's algorithm
      #-----------------------------

      h  := ConstantCoefficient(x, T, dT, F[1], F[2], _Z);
   
      if  h = false then
          return false;
      end if;
      (C, lt) := h[1], h[2];
       
     #------------------------------------------
     # determine complete logarithmic parts
     #------------------------------------------

     n := nops(T); 
     A := DecompositionOfGenerators(x, T, dT); 
     integral :=0; 
       
      for i from 1 to n-1 do
         r := F[1][i+1];
         s :=  normal(add(C[j]*A[1][i+1,j], j=1..n)); 
         r := normal(r - s);
         if r <> 0 then
            lp := LogPart:-CompleteLogarithmicPart(x, [op(1..i, T)], [op(1..i, dT)],  r,  '_Z');
            integral := integral +  LogarithmicPartI(lp[1],  _Z);
         end if;
    end do;
    
     #------------------------------------------
     # form elementary integrals
     #------------------------------------------

    integral := integral+g+int(F[1][1]-add(C[j]*A[1][1,j], j=1..n), x)+ LogarithmicPartI(lt[1],  _Z);
    return normal(integral + add(C[j]*T[j], j=1..n)-add(C[j]*A[3][j], j=1..n)); 
end proc:





end module: