)abbrev package RNORM RealNormalizationUtilities
++ Description: This package tries to rewrite an expression in
++  real form preserving its value.
RealNormalizationUtilities(R, F) : Exports == Implementation where
  R : Join(GcdDomain, Comparable, CharacteristicZero,
           PolynomialFactorizationExplicit,
           RetractableTo Integer, LinearlyExplicitOver Integer)
  F : Join(TranscendentalFunctionCategory, PrimitiveFunctionCategory,
           AlgebraicallyClosedFunctionSpace R)
  K  ==> Kernel F
  SY ==> Symbol
  Exports ==> with
    try_real : (F, SY) -> F

  Implementation ==> add

    if F has LiouvillianFunctionCategory then

      imf := sqrt(-1)$F
      imk := retract(imf)@Kernel(F)


      split_expr(e : F) : List(F) ==
          ue := univariate(e, imk)
          u_num := numer(ue)
          degree(u_num) > 1 => error "impossible"
          u_den := denom(ue)
          degree(u_den) > 1 => error "impossible"
          r_num := coefficient(u_num, 0)
          i_num := coefficient(u_num, 1)
          cd := r_den := coefficient(u_den, 0)
          if degree(u_den) > 0 then
              i_den := leadingCoefficient(u_den)
              cd := r_den*r_den + i_den*i_den
              nrn := r_num*r_den + i_num*i_den
              i_num := i_num*r_den - r_num*i_den
              r_num := nrn
          r_num := r_num/cd
          i_num := i_num/cd
          [r_num, i_num]

      do_liou1(f1 : F, op : BasicOperator, a : F) : F ==
          ll := split_expr(a)
          ra := ll(1)
          ia := ll(2)
          is?(op, 'Ei) and ra = 0 =>
              Ci(ia) + imf*Si(ia)
          is?(op, 'erf) and ra = 0 => imf*erfi(ia)
          is?(op, 'erf) and ra = ia =>
              a1 := 2*ra/sqrt(pi())
              (1 + imf)*(fresnelC(a1) - imf*fresnelS(a1))
          is?(op, 'erf) and ra = -ia =>
              a1 := 2*ra/sqrt(pi())
              (1 - imf)*(fresnelC(a1) + imf*fresnelS(a1))
          f1

      real_k(k : K) : F ==
          kf := k::F
          op := operator(k)
          arg := argument(k)
          #arg = 1 and has?(op, 'prim) => do_liou1(kf, op, first(arg))
          kf

      do_c(c : F) : F ==
          lk0 := kernels(c)
          lk : List(K) := []
          lv : List(F) := []
          for k in lk0 repeat
              op := operator(k)
              arg := argument(k)
              if #arg = 1 and is?(k, 'exp) then
                  a1 := first(arg)
                  ll := split_expr(a1)
                  ra := ll(1)
                  ia := ll(2)
                  if ra = 0 then
                      v := (cos(ia) + imf*sin(ia))
                      lk := cons(k, lk)
                      lv := cons(v, lv)
          not(empty?(lk)) => subst(c, lk, lv)
          c

      try_real(f : F, x : SY) : F ==
          lk := kernels(f)
          res_p : F := 0
          for k in lk repeat
              fu := univariate(f, k)
              num_f := numer(fu)
              den_f := denom(fu)
              degree(den_f) > 0 or degree(num_f) ~= 1 => iterate
              c_den := leadingCoefficient(den_f)
              c := leadingCoefficient(num_f)/c_den
              D(c, x) ~= 0 => iterate
              res_p := do_c(c)*real_k(k) + res_p
              f := coefficient(num_f, 0)/c_den
          lk := kernels(res_p)
          lck : List(K) := []
          rpp := res_p
          for k in lk repeat
              op := operator(k)
              arg := argument(k)
              not(is?(op, 'Ci) and #arg = 1) => iterate
              fu := univariate(rpp, k)
              num_f := numer(fu)
              den_f := denom(fu)
              degree(den_f) > 0 or degree(num_f) ~= 1 => iterate
              c_den := leadingCoefficient(den_f)
              c := leadingCoefficient(num_f)/c_den
              D(c, x) ~= 0 => iterate
              lck := cons(k, lck)
              rpp := coefficient(num_f, 0)/c_den
          lck := reverse(removeDuplicates(lck))
          lck1 : List(F) := []
          for k in lck repeat
              a := first(argument(k))
              for k1 in lck repeat
                  k = k1 => break
                  a1 := first(argument(k1))
                  a = -a1 =>
                      k := k1
                      break
              lck1 := cons(k::F, lck1)
          res_p := subst(res_p, lck, reverse(lck1))
          f + res_p

    else

      try_real(f : F, x : SY) : F == f

)abbrev package LINCOMB LinearCombinationUtilities
++ Description: This package implements frequently used operations
++  on linear combinations.
LinearCombinationUtilities(F, UP) : Exports == Implementation where
  F  : Field
  UP : UnivariatePolynomialCategory F

  N   ==> NonNegativeInteger
  RF  ==> Fraction UP
  GP  ==> LaurentPolynomial(F, UP)
  Param_Rec_F ==> Record(ratpart : F, coeffs : Vector F)
  L_Param_F ==> List Param_Rec_F
  Partial_F ==>  Union(Param_Rec_F, "failed")
  Both_F ==> Record(particular : Partial_F, basis : L_Param_F)
  Q ==> Fraction(Integer)
  Param_Rec_Q2 ==> Record(ratpart : F, coeffs : Vector Q)
  L_Param_Q2 ==> List Param_Rec_Q2
  Partial_Q2 ==> Union(Param_Rec_Q2, "failed")
  Both_Q2 ==> Record(particular : Partial_Q2, basis : L_Param_Q2)

  Exports ==> with

    dehomogenize : L_Param_F -> Both_F
      ++ dehomogenize(ls) converts list of solutions
      ++ (a, [c0, c1, ..., cn]) to homogeneous equation
      ++ L(a) + c0 f + c1 g1 + ... + cn gn = 0 into list of
      ++ solutions of inhomogeneous equation
      ++ L(a) + f + c1 g1 + ... + cn gn = 0.  This transformation
      ++ works the same for all equations, so we only
      ++ need list of solutions as argument
    lin_comb : (Vector F, List(F)) -> F
      ++ lin_comb(v, [f1, ..., fn]) computes linear combination
      ++ v(1) f1 + ... v(n) fn.  Vector v and list [f1, ..., fn]
      ++ must be of equal length.
    lin_comb : (Vector Q, List(F)) -> F
      ++ lin_comb(v, [f1, ..., fn]) computes linear combination
      ++ v(1) f1 + ... v(n) fn.  Vector v and list [f1, ..., fn]
      ++ must be of equal length.
    lin_comb! : (Vector F, Vector F, List(Vector F)) -> Vector F
      ++ lin_comb!(v, w, [f1, ..., fn]) computes linear combination
      ++ w + v(1) f1 + ... v(n) fn by modifying w in place.
      ++ Vector v and list [f1, ..., fn] must be of equal length.
    lin_comb : (Vector F, List(Vector F)) -> Vector F
      ++ lin_comb(v, [f1, ..., fn]) computes linear combination
      ++ v(1) f1 + ... v(n) fn.  Vector v and list [f1, ..., fn]
      ++ must be of equal positive length.
    lin_comb : (Vector F, List(RF)) -> RF
      ++ lin_comb(v, [f1, ..., fn]) computes linear combination
      ++ v(1) f1 + ... v(n) fn.  Vector v and list [f1, ..., fn]
      ++ must be of equal length.
    lin_comb : (Vector Q, List(RF)) -> RF
      ++ lin_comb(v, [f1, ..., fn]) computes linear combination
      ++ v(1) f1 + ... v(n) fn.  Vector v and list [f1, ..., fn]
      ++ must be of equal length.
    lin_comb : (Vector F, List(GP)) -> GP
      ++ lin_comb(v, [f1, ..., fn]) computes linear combination
      ++ v(1) f1 + ... v(n) fn.  Vector v and list [f1, ..., fn]
      ++ must be of equal length.
    lin_comb : (Vector F, List(UP)) -> UP
      ++ lin_comb(v, [f1, ..., fn]) computes linear combination
      ++ v(1) f1 + ... v(n) fn.  Vector v and list [f1, ..., fn]
      ++ must be of equal length.

  Implementation ==> add

    dehomogenize_body(Lpar, Par) ==>
        empty?(ls) => ["failed", []]
        nn := #(ls(1).coeffs)
        be1 : Par
        found : Boolean := false
        res2 : Lpar := []
        for be in ls repeat
            c := (be.coeffs)(1)
            c = 0 or found => res2 := cons(be, res2)
            be1 := be
            found := true
        not(found) => ["failed", []]
        c1inv := 1/(be1.coeffs)(1)
        ppa := c1inv*be1.ratpart
        ppv := (c1inv*be1.coeffs)(2..nn)
        res3 : Lpar := []
        for be in res2 repeat
            c := (be.coeffs)(1)
            bv := (be.coeffs)(2..nn)
            rp := be.ratpart
            if c ~= 0 then
                rp := rp - c*ppa
                bv := bv - c*ppv
            res3 := cons([rp, bv], res3)
        [[ppa, ppv], res3]

    dehomogenize(ls : L_Param_F) : Both_F ==
        dehomogenize_body(L_Param_F, Param_Rec_F)


    lin_comb(v : Vector F, lf : List(F)) : F ==
        res : F := 0
        for i in 1..#v for f in lf repeat
            res := res + v(i)*f
        res

    lin_comb(v : Vector Q, lf : List(F)) : F ==
        res : F := 0
        for i in 1..#v for f in lf repeat
            res := res + v(i)::F*f
        res

    lin_comb!(u : Vector F, v : Vector F,
              lw : List(Vector F)) : Vector F ==
        res := v
        n := #res
        for i in 1..#u for w in lw repeat
            c := u(i)
            for j in 1..n repeat
                res(j) := res(j) + c*w(j)
        res

    lin_comb(u : Vector F, lw : List(Vector F)) : Vector F ==
        n := #first(lw)
        lin_comb!(u, new(n, 0)$Vector(F), lw)

    lin_comb(v : Vector F, lf : List(RF)) : RF ==
        res : RF := 0
        for i in 1..#v for f in lf repeat
            res := res + v(i)::UP*f
        res

    lin_comb(v : Vector Q, lg : List RF) : RF ==
        res : RF := 0
        for i in 1..#v for g in lg repeat
            res := res + v(i)::F::UP::RF*g
        res

    lin_comb(v : Vector F, lf : List(GP)) : GP ==
        res : GP := 0
        for i in 1..#v for f in lf repeat
            res := res + v(i)::GP*f
        res

    lin_comb(v : Vector F, lf : List(UP)) : UP ==
        res : UP := 0
        for i in 1..#v for f in lf repeat
            res := res + v(i)*f
        res


)abbrev package EFACTOR ExpressionFactorPolynomial
++ Description: This package implements \spad{factorPolynomial}
++  for Expression.
ExpressionFactorPolynomial(R, F) : Exports == Implementation where
  R : Join(GcdDomain, Comparable)
  F : FunctionSpace R
  UP  ==> SparseUnivariatePolynomial F
  K   ==> Kernel F
  MP ==> SparseMultivariatePolynomial(R, K)
  UMP ==> SparseUnivariatePolynomial MP

  Exports ==> with

    factorPolynomial : UP -> Factored(UP)
      ++ factorPolynomial(p) factors p into irreducible factors over
      ++ field generated by its coefficients.
    factor : (UP, List F) -> Factored(UP)
      ++ factor(p, [k1, ..., kn]) factors p into irreducible factors over
      ++ field generated by its coefficients and k1, ..., kn.
    poly_factor : UMP -> Factored(UMP)
      ++ poly_factor(p) should be local but conditional.

  Implementation ==> add

    if (R is Integer or R is Complex(Integer)) then

      Exp ==> IndexedExponents(K)

      MULTFACT ==> MultivariateFactorize(K, Exp, R, MP)

      poly_factor(p) == factor(p)$MULTFACT

    else if MP has PolynomialFactorizationExplicit then

      poly_factor(p) == factorPolynomial(p)$MP

    else

      poly_factor(p) == error "factorPolynomial unimplemented"

    dummy := create()$SingletonAsOrderedSet
    xs := new()$Symbol
    xk := kernel(xs)$K

    UPCF2 ==> UnivariatePolynomialCategoryFunctions2

    fpoly_factor(p : UP) : Factored(UP) ==
        cn := leadingCoefficient(p)
        cn = 0 => nilFactor(p, 1)
        p := p/cn
        cnp := cn::UP
        pf := retract(eval(p, dummy, xk::F))@F
        p2 := univariate(numer(pf), xk)
        fres1 := poly_factor(p2)
        res : Factored(UP) := makeFR(cnp, [])
        for frec in factorList(fres1) repeat
            fr1 := frec.factor
            degree(fr1) < 1 => iterate
            frec.flag ~= "prime" and frec.flag ~= "irred" => error "impossible"
            fru : UP := map(c1 +-> c1::F, fr1
                       )$UPCF2(MP, UMP, F, UP)
            fr2 := fru/leadingCoefficient(fru)
            res := res*primeFactor(fr2, frec.exponent)
        res

    PCQF ==> PolynomialCategoryQuotientFunctions(IndexedExponents K,
                           K, R, MP, F)

    ifactor(p : UP, lk : List K) : Factored(UP) ==
        n := degree(p)
        cn := leadingCoefficient(p)
        cn = 0 => nilFactor(p, 1)
        cnp := cn::UP
        n < 1 => makeFR(cnp, [])
        n = 1 => makeFR(cnp, [["prime", p/cn, 1]])
        empty? lk => fpoly_factor(p)
        q   := minPoly(k1 := reduce(max, lk))
        lk2 := [k for k in lk | k ~= k1]
        sae := SimpleAlgebraicExtension(F, UP, q)
        ups := SparseUnivariatePolynomial sae
        p2 : ups := map(x +-> reduce univariate(x, k1, q)$PCQF, p
                 )$UPCF2(F, UP, sae, ups)
        fres1 := factor(p2, x +-> ifactor(x, lk2)
                       )$InnerAlgFactor(F, UP, sae, ups)
        res : Factored(UP) := makeFR(cnp, [])
        kf := k1::F
        for frec in factorList(fres1) repeat
            fr1 := frec.factor
            frec.flag ~= "prime" and frec.flag ~= "irred" => error "impossible"
            fru : UP := map(c1 +-> lift(c1)(kf), fr1
                      )$UPCF2(sae, ups, F, UP)
            fr2 := fru/leadingCoefficient(fru)
            res := res*primeFactor(fr2, frec.exponent)
        res

    factorPolynomial(p) == ifactor(p, algtower(coefficients(p)))

    factor(p, lf) ==
        ifactor(p, algtower(concat(lf, coefficients(p))))

)abbrev package RFSSPLIT RootFSSplit
++ Description: This package implements \spad{alg_split_roots}
++  allowing its reuse.
RootFSSplit(R, F) : Exports == Implementation where
  R : Join(IntegralDomain, RetractableTo Integer, Comparable)
  F : FunctionSpace(R)
  K ==> Kernel(F)
  Alg_Rec ==> Record(funs : List F, nroot : F, npow1 : Integer,
                     npow2 : Integer)
  Exports ==> with
      alg_split_roots : (List F, r1 : K, r2 : K) -> List(Alg_Rec)
        ++ alg_split_roots(lf, r1, r2) splits each f in lf into
        ++ linear combination of product of powers of r1 and r2
        ++ which must be independent roots.
      alg_split_root0 : (F, K, Integer) -> List F
        ++ alg_split_root0(f, r, n) returns \spad{[a1, ..., an]}
        ++ such that \spad{f = a1 + a2*r + ... an*r^(n - 1)}.
        ++ \spad{r} must be a root and \spad{n} must be its
        ++ degree.

  Implementation == add

    P ==> SparseMultivariatePolynomial(R, K)

    alg_split_root0(f : F, r : K, n : Integer) : List F ==
        n = 2 =>
            ef := eval(f, r, -(r::F))
            f0 := (f + ef)/(2::F)
            f1 := (f - ef)/(2::F)
            member?(r, kernels(f0)) =>
                print(f0::OutputForm)
                error "alg_split_root0: roots did not cancel 1"
            f1 := f1/(r::F)
            member?(r, kernels(f1)) =>
                print(f1::OutputForm)
                error "alg_split_root0: roots did not cancel 2"
            [f0, f1]
        q := univariate(f, r, minPoly r
                      )$PolynomialCategoryQuotientFunctions(IndexedExponents K,
                          K, R, P, F)
        [coefficient(q, i) for i in 0..(n-1)]

    alg_split_root2(lf : List F, r : K, n : Integer) :  List List F ==
        nlf0 : List List F := [alg_split_root0(f, r, n) for f in lf]
        res : List List F := []
        for pow1 in (0$Integer)..(n - 1) repeat
            nlf1 := nlf0
            resi : List(F) := []
            while not(empty?(nlf1)) repeat
                lf1 := first(nlf1)
                resi := cons(first(lf1), resi)
                setfirst!(nlf1, rest(lf1))
                nlf1 := rest(nlf1)
            resi := reverse!(resi)
            res := cons(resi, res)
        reverse!(res)

    alg_split_roots(lf : List F, r1 : K, r2 : K) : List(Alg_Rec) ==
        a1 := argument(r1)
        a2 := argument(r2)
        n1 : Integer := retract(a1(2))@Integer
        b1 := a1(1)
        n2 : Integer := retract(a2(2))@Integer
        b2 := a2(1)
        ll1 : List List F := alg_split_root2(lf, r1, n1)
        res : List(Alg_Rec) := []
        pow1 : Integer
        rop := operator(r1)
        for l1 in ll1 for pow1 in (0$Integer)..(n1 - 1) repeat
            every?((f1 : F) : Boolean +-> f1 = 0, l1) => iterate
            ll2 := alg_split_root2(l1, r2, n2)
            g1 := gcd(n1, pow1)$Integer
            nn1 := (n1 exquo g1)::Integer
            np1 := (pow1 exquo g1)::Integer
            for l2 in ll2 for pow2 in 0..(n2 - 1) repeat
                every?((f1 : F) : Boolean +-> f1 = 0, l2) => iterate
                g2 := gcd(n2, pow2)
                nn2 := (n2 exquo g2)::Integer
                np2 := (pow2 exquo g2)::Integer
                nn := lcm(nn1, nn2)
                bb1 := b1^(np1*(nn exquo nn1)::Integer)
                bb2 := b2^(np2*(nn exquo nn2)::Integer)
                nrr :=
                    pow1 + pow2 > 0 =>
                        kernel(rop, [bb1*bb2, nn::F])::F
                    1$F
                nl := [f1*nrr for f1 in l2]
                res := cons([nl, nrr, pow1, pow2]$Alg_Rec, res)
        res

)abbrev package INTPAR1 ParametricTranscendentalIntegration
++ Description: This package implements parametric integration
++  in transcendental case.
ParametricTranscendentalIntegration(F, UP) : Exports == Implementation where
  F  : Field
  UP : UnivariatePolynomialCategory F
  Z   ==> Integer
  Q   ==> Fraction Z
  RF  ==> Fraction UP
  Param_Rec_F ==> Record(ratpart : F, coeffs : Vector F)
  L_Param_F ==> List Param_Rec_F
  Param_Rec_Q ==> Record(ratpart : RF, coeffs : Vector F)
  L_Param_Q ==> List Param_Rec_Q
  Param_Rec_QF ==> Record(logands : List F, basis : List Vector Q)
  Param_Rec_Q2 ==> Record(logands : List RF, basis : List Vector Q)

  Exports ==> with
    primextint : (UP -> UP, List F ->  L_Param_F,
                    Matrix F -> List Vector F, List RF) -> L_Param_Q
      ++ primextint(', ext, csolve, [g1, ..., gn]) returns
      ++ a basis of solutions of the homogeneous system
      ++ \spad{h' + c1*g1 + ... + cn*gn = 0}.
      ++ Argument ext is an extended integration function on F.
      ++ csolve is solver over constants.
    expextint : (UP -> UP, (Z, List F) -> L_Param_F,
                   Matrix F -> List Vector F, List RF) -> L_Param_Q
      ++ expextint(', rde, csolve, [g1, ..., gn]) returns
      ++ a basis of solution of the homogeneous system
      ++ \spad{h' + c1*g1 + ... + cn*gn = 0}
      ++ Argument foo is an parametric rde solver on F.
      ++ csolve is solver over constants.
    diffextint : (List UP -> L_Param_F, Matrix F -> List Vector F,
                    List RF) -> L_Param_F
      ++ diffextint(ext, csolve, [g1, ..., gn]) is like primextint and
      ++ expextint but for differentialy transcendental extensions.
    unkextint : (List F ->  L_Param_F, Matrix F -> List Vector F,
                    List RF) -> L_Param_F
      ++ unkextint(ext, csolve, [g1, ..., gn]) is like primextint and
      ++ expextint but for makes no assumption about generator of
      ++ the extension.
    logextint : (UP -> UP, UP -> Factored(UP), Matrix F -> List Vector Q,
                 List UP -> Param_Rec_Q2, List(RF)) -> Param_Rec_Q2
      ++ logextint(der, ufactor, csolve, rec, [g1, ..., gn])
      ++ returns [[u1, ..., um], bas] giving basis of solution of
      ++ the homogeneous systym
      ++ \spad{c1*g1 + ... + cn*gn + c_{n+1}u1'/u1 + ... c_{n+m}um'/um  = 0}
    monologextint : (List UP, Matrix F -> List Vector Q,
                     List F -> Param_Rec_QF) -> Param_Rec_Q2
      ++ monologextint(lup, csolve, rec) is a helper for logextint

  Implementation ==> add

    N   ==> NonNegativeInteger
    GP  ==> LaurentPolynomial(F, UP)

    import from LinearCombinationUtilities(F, UP)
    import from LinearCombinationUtilities(Q, SparseUnivariatePolynomial(Q))
    import from TranscendentalHermiteIntegration(F, UP)
    import from LiftLinearDependence(F, F, UP)
    import from LiftLinearDependence(F, Q, UP)

    monologextint(lup, csolve, rec1) ==
        n0 := #lup
        lc0 := [coefficient(p, 0) for p in lup]
        lup2 := [p - c0::UP for p in lup for c0 in lc0]
        cb := csolve_pol(csolve, lup2)
        nlc0 := [lin_comb(bv, lc0) for bv in cb]
        (ll, bl) := rec1(nlc0)
        empty?(bl) => [[], []]
        n1 := #cb
        n2 := #ll
        n3 := n0 + n2
        rbl := [new(n3, 0)$Vector(Q) for bv in bl]
        nl := [le::UP::RF for le in ll]
        for rbv in rbl for bv in bl repeat
            pv := lin_comb(bv(1..n1), cb)
            for i in 1..n0 repeat rbv(i) := pv(i)
            for i in n0+1..n3 for j in n1+1.. repeat rbv(i) := bv(j)
        [nl, rbl]

    logextint(der, ufactor, csolve, rec, lg) ==
        empty?(lg) => [[], []]
        n0 := #lg
        lghr := [HermiteIntegrate(g, der) for g in lg]
        lg1 := [ghr.answer for ghr in lghr]
        cb := csolve_rf(csolve, lg1)
        lg2 := [ghr.logpart for ghr in lghr]
        lg3 := [lin_comb(bv, lg2) for bv in cb]
        lden1 := [denom(g) for g in lg3]
        (mbas, m2) := gcdDecomposition(vector(lden1))$GcdBasis(UP)
        n1 := #lg3
        mbasl := entries(mbas)
        mbasfl := [[frr.factor for frr in factorList(ufactor(mbasp))]
                     for mbasp in mbasl]
        basl1 := reduce(concat, mbasfl, [])
        sl := [#fl1 for fl1 in mbasfl]
        n3 := reduce(_+, sl, 0)
        m3 := new(n3, n1 + n3, 0)$Matrix(UP)
        for i in 1..n1 for g in lg3 repeat
            fl : List(UP) := []
            jl : List(Z) := []
            sl1 := sl
            fl1 : List(UP) := []
            j0 : Z := 1
            j1 : Z := 0
            for j in 1..n3 for fj in basl1 repeat
                j1 := j1 + 1
                if j1 > first(sl1) then
                    sl1 := rest(sl1)
                    j1 := 0
                    j0 := j0 + 1
                if m2(j0, i) = 1 then
                    fl := cons(fj, fl)
                    jl := cons(j, jl)
            nl := decompose(numer(g), fl)$PartialFractionUtilities(F, UP)
            for num in nl for j in jl repeat
                m3(j, i) := num
        lpc : List(RF) := []
        for j in 1..n3 for bj in basl1 repeat
            dbj := der(bj)
            (q, r) := divide(dbj, bj)
            m3(j, n1 + j) := r
            lpc := cons(q::RF, lpc)
        lpc := reverse!(lpc)
        rs3 := reducedSystem(m3)
        cb2 := csolve(rs3)
        cb3 := [bv(1..n1) for bv in cb2]
        cb3e := [bv(n1+1..n1+n3) for bv in cb2]
        ncb := [lin_comb(bv, cb) for bv in cb3]
        nlpc := [lin_comb(bv, lpc) for bv in cb3e]
        lg4 := [ghr.polypart::RF + ghr.specpart for ghr in lghr]
        lg5 := [lin_comb(bv, lg4) + pc for bv in ncb for pc in nlpc]
        lrf : List(RF) := []
        lg6 : List(RF) := []
        for g in lg5 repeat
            den := denom(g)
            (q, r) := divide(numer(g), den)
            lrf := cons(r/den, lrf)
            lg6 := cons(q::RF, lg6)
        lrf := reverse!(lrf)
        lg6 := reverse!(lg6)
        cb4 := csolve_rf(csolve, lrf)
        ncb2 := [lin_comb(bv, ncb) for bv in cb4]
        cb4e := [lin_comb(bv, cb3e) for bv in cb4]
        lg7 := [lin_comb(bv, lg6) for bv in cb4]
        n4 := #lg7
        (flog, fbas) := rec([retract(g)@UP for g in lg7])
        empty?(fbas) => [[], []]
        rbasl1 := [up::RF for up in basl1]
        nlog := concat(rbasl1, flog)
        n5 := #flog
        n6 := (n0 + n3 + n5)::N
        rbas := [new(n6, 0)$Vector(Q) for bv in fbas]
        for rbv in rbas for bv in fbas repeat
            bv1 := bv(1..n4)
            pv := lin_comb(bv1, ncb2)
            for i in 1..n0 repeat rbv(i) := pv(i)
            pv := lin_comb(bv1, cb4e)
            for i in n0 + 1..n0 + n3 for j in 1..n3 repeat rbv(i) := pv(j)
            for i in n0 + n3 + 1..n6 for j in n4 + 1..n4 + n5 repeat
                rbv(i) := bv(j)
        [nlog, rbas]

    RF_to_GP(f : RF) : GP ==
        (numer(f)::GP exquo denom(f)::GP)::GP

    primextint(der : UP -> UP, ext : List F -> L_Param_F,
              csolve : Matrix F -> List Vector F,
              lg : List RF) : L_Param_Q ==
        empty?(lg) => []
        n := #lg
        lghr := [HermiteIntegrate(g, der) for g in lg]
        lg1 := [ghr.logpart for ghr in lghr]
        cb := csolve_rf(csolve, lg1)
        a1l := [ghr.answer for ghr in lghr]
        lba : List(RF) := [0 for bv in cb]
        lg2 := [ghr.polypart for ghr in lghr]
        vg2 := vector([lg2])$Vector(UP)
        ldg : List(N) := [degree(g2) for g2 in lg2]
        d := reduce(max, ldg)
        dk := retract(der(monomial(1, 1)$UP))@F
        cba := [0$F for bv in cb]
        nlba : List(RF)
        for j in d..0 by -1 repeat
            n1 := #cb
            n1 = 0 => return []
            lgj : List(F) := []
            for i in 1..n repeat
                gi := vg2(i)
                gij : F := 0
                if degree(gi) = j then
                    gij := leadingCoefficient(gi)
                    vg2(i) := reductum(gi)
                lgj := cons(gij, lgj)
            lgj := reverse!(lgj)
            lgj1 : List(F) := []
            for bv in cb for aa in cba repeat
                ff := lin_comb(bv, lgj) + (j + 1)::F*dk*aa
                lgj1 := cons(ff, lgj1)
            lgj1 := reverse!(lgj1)
            b2 := ext(cons(dk, lgj1))
            n1p := n1 + 1
            cb0 := [(be.coeffs)(2..n1p) for be in b2]
            ncb := [lin_comb(bv, cb) for bv in cb0]
            cba := [be.ratpart for be in b2]
            nlba := [lin_comb(bv, lba) +
                      monomial(be.ratpart, j)$UP::RF +
                       monomial((be.coeffs)(1)/(j + 1)::F, j + 1)$UP::RF
                         for be in b2 for bv in cb0]
            cb := ncb
            lba := nlba
        nlba := [ba - lin_comb(bv, a1l) for bv in cb for ba in lba]
        [[ba, bv] for bv in cb for ba in nlba]


    expextint(der : UP -> UP, rde : (Z, List F) -> L_Param_F,
                 csolve : Matrix F -> List Vector F,
                 lg : List RF) : L_Param_Q ==
        empty?(lg) => []
        lghr := [HermiteIntegrate(g, der) for g in lg]
        lg1 := [ghr.logpart for ghr in lghr]
        cb := csolve_rf(csolve, lg1)
        a1l := [ghr.answer for ghr in lghr]
        lba : List(GP) := [0 for bv in cb]
        lg2 := [ghr.polypart::GP + RF_to_GP(ghr.specpart) for ghr in lghr]
        vg2 := vector([lg2])$Vector(GP)
        ldg : List(Z) := [degree(g2) for g2 in lg2]
        d := reduce(max, ldg)
        j := d
        repeat
            last_iter : Boolean := true
            lgj : List(F) := []
            for i in 1..#vg2 repeat
                gi := vg2(i)
                gij : F := 0
                if gi ~= 0 then
                    last_iter := false
                    if degree(gi) = j then
                        gij := leadingCoefficient(gi)
                        vg2(i) := reductum(gi)
                lgj := cons(gij, lgj)
            last_iter => break
            lgj := reverse!(lgj)
            lgj1 : List(F) := []
            for bv in cb repeat
                ff := lin_comb(bv, lgj)
                lgj1 := cons(ff, lgj1)
            lgj1 := reverse!(lgj1)
            b2 := rde(j, lgj1)
            empty?(b2) => return []
            ncb := [lin_comb(be.coeffs, cb) for be in b2]
            nlba := [lin_comb(be.coeffs, lba) + monomial(be.ratpart, j)$GP
                         for be in b2]
            cb := ncb
            lba := nlba
            j := j - 1
        lbar := [convert(ba)@RF - lin_comb(bv, a1l)
                  for bv in cb for ba in lba]
        [[bar, bv] for bv in cb for bar in lbar]

    diffextint1(trim : RF -> UP, ext : List UP -> L_Param_F,
                csolve : Matrix(F) -> List Vector(F),
                lg : List RF) : L_Param_F ==
        lup := [trim(g) for g in lg]
        lg1 := [g - up::RF for g in lg for up in lup]
        cb := csolve_rf(csolve, lg1)
        lup1 := [lin_comb(bv, lup) for bv in cb]
        res1 := ext(lup1)
        [[re.ratpart, lin_comb(re.coeffs, cb)] for re in res1]

    lin_part(f : RF) : UP ==
        p := numer(f) quo denom(f)
        monomial(coefficient(p, 1), 1)$UP + coefficient(p, 0)::UP

    diffextint(ext, csolve, lg) ==
        diffextint1((x : RF) : UP +-> lin_part(x), ext, csolve, lg)

    coeff0(f : RF) : UP ==
        p := numer(f) quo denom(f)
        coefficient(p, 0)::UP

    unkextint(ext, csolve, lg) ==
        ext1 := (lup : List UP) : L_Param_F +->
                lf := [retract(p)@F for p in lup]
                ext(lf)
        diffextint1((x : RF) : UP +-> coeff0(x), ext1, csolve, lg)


)abbrev package RDEAUX RDEaux
++ Description: This package contains special case for RDE solver.
RDEaux(F) : Exports == Implementation where
  F : Field
  Z ==> Integer
  UP  ==> SparseUnivariatePolynomial F
  RSOL ==> Record(ans : UP, remainder : UP)
  DSOL ==> Record(ans : List(UP), acoeff : UP, eegen : UP, bpar : UP,
                  lcpar : List UP, dpar : Z)
  USOL ==> Union(List(RSOL), DSOL)
  Exports ==> with

    multi_SPDE : (UP, UP, List(UP), Z, UP -> UP) -> USOL
      ++ multi_SPDE(a, b, lc, d, der)
    SPDE1 : (UP, UP, UP -> UP) -> RSOL
      ++ SPDE1(b, c, D) solves Q' + b Q = c and returns [Q, r] where
      ++ r = c - ( Q' + b Q).  That is when r is zero then Q is
      ++ true solution, otherwise r represents unsolved part of c.
      ++ Moreover def(r) < deg(bQ).  Note: SPDE1 assumes that
      ++ deg(Q') < deg(bQ) for all Q.

  Implementation ==> add

    EE_Rec ==> Record(coef1 : UP, coef2 : UP)

    multi_SPDE(a, b, lc, d, der) ==
        d <$Z 0 => [[0, c]$RSOL for c in lc]
        every?(zero?, lc) => [[0, 0]$RSOL for c in lc]
        ee := extendedEuclidean(a, b)
        ee.generator ~= 1 =>
            [[0 for c in lc], 1, ee.generator, b, lc, d]$DSOL
        lr : List(UP) := []
        lnc : List(UP) := []
        for c in lc repeat
            cc1 := ee.coef1*c
            cc2 := ee.coef2*c
            qr := divide(cc2, a)
            r := qr.remainder
            nc := cc1 + b*qr.quotient - der(r)
            lnc := cons(nc, lnc)
            lr := cons(r, lr)
        lr := reverse!(lr)
        res1 := multi_SPDE(a, b + der(a), reverse!(lnc), d - degree(a)$UP, der)
        res1 case DSOL =>
            dres := res1@DSOL
            [[a*s2 + r for s2 in dres.ans for r in lr], a*dres.acoeff,
             dres.eegen, dres.bpar, dres.lcpar, dres.dpar]$DSOL
        [[a*s1.ans + r, s1.remainder]$RSOL for s1 in res1::List(RSOL)
                                           for r in lr]

    SPDE1(b, c, der) ==
      q : UP := 0
      db := (degree b)::Z
      lb := leadingCoefficient b
      while c ~= 0 repeat
          (n := (degree c)::Z - db) < 0 => return [q, c]
          qq := monomial((leadingCoefficient c) / lb, n::NonNegativeInteger)
          c := c - b*qq - der(qq)
          q := q + qq
      [q, 0]


)abbrev package RDEPAR ParametricRischDE
++ Description: This package implements parametric RDE solver.  Only
++  simplest algebraic cases are implemented, the rest of algebraic
++  case is unimplemented.  The code throws errors on inimplmented
++  cases.
ParametricRischDE(R, F) : Exports == Implementation where
  R : Join(GcdDomain, Comparable, CharacteristicZero,
           RetractableTo Integer, LinearlyExplicitOver Integer)
  F :  Join(TranscendentalFunctionCategory, AlgebraicallyClosedField,
           FunctionSpace R)
  N   ==> NonNegativeInteger
  Z   ==> Integer
  Q   ==> Fraction(Integer)
  SY  ==> Symbol
  LF  ==> List F
  K   ==> Kernel F
  LK  ==> List K
  Param_Rec_F ==> Record(ratpart : F, coeffs : Vector F)
  L_Param_F ==> List Param_Rec_F
  Partial_F ==>  Union(Param_Rec_F, "failed")
  Both_F ==> Record(particular : Partial_F, basis : L_Param_F)
  UP ==> SparseUnivariatePolynomial F
  GP  ==> LaurentPolynomial(F, UP)
  Param_Rec_UP ==> Record(ratpart : UP, coeffs : Vector F)
  L_Param_UP ==> List Param_Rec_UP
  Param_Rec_QF ==> Record(logands : List F, basis : List Vector Q)


  Exports ==> with

    param_rde : (Z, F, LF, SY, LK, (LK, LF) -> L_Param_F,
                (LK, LF) -> Param_Rec_QF) -> L_Param_F
      ++ param_rde(n, f, lg, x, lk, ext, logi) finds basis of
      ++ solution to the equation
      ++ dy/dx + n df/dx y + c1 g1 + ... cn gn = 0  where
      ++ y is in field generated by lk and ci are
      ++ constants.
    param_rde : (Z, F, F, LF, SY, LK, (LK, LF) -> L_Param_F,
                (LK, LF) -> Param_Rec_QF) -> Both_F
      ++ param_rde(n, f, h, lg, x, lk, ext, logi) finds a particular
      ++ solution and basis of solutions to homogeneous
      ++ equation for  equation
      ++ dy/dx + n df/dx y + c1 g1 + ... cn gn = h where
      ++ y is in field generated by lk and ci are
      ++ constants.
    param_rde2 : (F, LF, SY, LK, (LK, LF) -> L_Param_F,
                    (LK, LF) -> Param_Rec_QF) -> L_Param_F
      ++ param_rde2(fp, lg, x, lk, ext, logi) finds basis of
      ++ solution to the equation
      ++ dy/dx + fp y + c1 g1 + ... cn gn = 0  where
      ++ y is in field generated by lk and ci are
      ++ constants.
    exp_lower_bound : (UP, GP, Z, Z, LK, F, (LK, LF) -> Param_Rec_QF) -> Z
      ++ exp_lower_bound(a, b, ob, nc0, lk, eta, logi) computes
      ++ lower degree bound for solution of \spad{a*D(y) + b*y = c}
      ++ in exponential case.  ob is order of b, nc0 is lower
      ++ bound on order of c, eta is derivative of the argument
      ++ of exponential.

  Implementation ==> add

    MET ==> MonomialExtensionTools(F, UP)
    RF ==> Fraction UP
    Param_Rec_Q ==> Record(ratpart : RF, coeffs : Vector F)
    L_Param_Q ==> List Param_Rec_Q
    RSOL ==> Record(ans : UP, remainder : UP)
    DSOL ==> Record(ans : List(UP), acoeff : UP, eegen : UP, bpar : UP,
                  lcpar : List UP, dpar : Z)
    P ==> SparseMultivariatePolynomial(R, K)

    import from Integer
    import from List(Integer)
    import from IntegrationTools(R, F)
    import from PolynomialCategoryQuotientFunctions(IndexedExponents K,
                                                             K, R, P, F)
    import from LinearCombinationUtilities(F, UP)

    ALGOP ==> '%alg
    PRIM ==> 'prim
    OPDIFF ==> '%diff

    do_spde1 : (UP, List(UP), Z, UP -> UP, Matrix(F) -> Matrix(F))
                 -> L_Param_UP

    do_param_rde : (F, Boolean, LF, SY, K, LK, (LK, LF) -> L_Param_F,
                    (LK, LF) -> Param_Rec_QF) -> L_Param_F

    do_alg_rde : (F, List F, SY, K, LK, (LK, LF) -> L_Param_F,
                  (LK, LF) -> Param_Rec_QF) -> L_Param_F

    do_diff_rde : (F, List F, SY, K, LK, (LK, LF) -> L_Param_F,
                  (LK, LF) -> Param_Rec_QF) -> L_Param_F

    get_denom(f : RF, lg : List RF, der : UP -> UP) : List(UP) ==
        d := normalDenom(f, der)$MET
        e0 := lcm [denom(g) for g in lg]$List(UP)
        (e, s) := split(e0, der)$MET
        gg := gcd(d, e)
        h := (gcd(e, differentiate e) exquo gcd(gg, differentiate gg))::UP
        [d, h]

    Frec ==> Record(fctr : UP, xpnt : Z)

    normalize(f : RF, der : UP -> UP) : List(Frec) ==
        d := normalDenom(f, der)$MET
        g := gcd(d, differentiate(d))
        d0 := (d exquo g)::UP
        dd := gcd(d0, g)
        d1 := (d0 exquo dd)::UP
        d2 := (denom(f) exquo d1)::UP
        eeu := extendedEuclidean(d2, d1, numer(f))
        (a, b) := eeu::Record(coef1 : UP, coef2 : UP)
        zk := kernel(new()$Symbol)$K
        dd1 := der(d1)
        r := resultant(a - zk::F*dd1, d1)
        rql := get_rational_roots(r, zk
                 )$FunctionSpaceRationalRoots(R, F)
        rl : List Frec := []
        for rq in rql repeat
            if (mu := retractIfCan(rq)@Union(Z, "failed")) case Z then
                m := mu@Z
                if m > 0 then
                    pi := gcd(a - m::F*dd1, d1)
                    rl := cons([pi, m], rl)
        rl

    RF_to_GP(f : RF) : GP == (numer(f)::GP exquo denom(f)::GP)::GP

    do_spde1(b : UP, lc : List(UP), der : UP -> UP,
             get_rs : Matrix(F) -> Matrix(F)) : L_Param_UP ==
        lar := [SPDE1(b, c, der)$RDEaux(F) for c in lc]
        la := [ar.ans for ar in lar]
        lrem := [ar.remainder for ar in lar]
        rs1 : Matrix(F) := reducedSystem(matrix([lrem]))
        rs2 := get_rs(rs1)
        lkv := nullSpace(rs2)
        [[lin_comb(kv, la), kv] for kv in lkv]

    param_SPDE(a : UP, b : UP, lc : List(UP), d : Z, der : UP -> UP,
               get_rs : Matrix(F) -> Matrix(F),
               do_degrad : (RF, List(RF)) -> L_Param_Q,
               x : SY) : L_Param_UP ==
        dt := der monomial(1, 1)
        degree(a) = 0 =>
            a ~= 1 => error "param_SPDE: degree(a) = 0 but a ~= 1"
            degt := degree(dt) - 1
            base_case := dt = 1
            (b ~= 0) and (base_case or degree(b) > max(0, degt)) =>
                do_spde1(b, lc, der, get_rs)
            lcr := [c::RF for c in lc]
            res1 := do_degrad(b::RF, lcr)
            [[retract(re.ratpart)@UP, re.coeffs] for re in res1]
        s1 := multi_SPDE(a, b, lc, d, der)$RDEaux(F)
        s1 case List(RSOL) =>
            lrs := s1@List(RSOL)
            m1 := matrix([[rsol.remainder for rsol in lrs]])$Matrix(UP)
            rs1 : Matrix(F) := reducedSystem(m1)
            rs2 := get_rs(rs1)
            lkv := nullSpace(rs2)
            a1l := [rsol.ans for rsol in lrs]
            [[lin_comb(kv, a1l), kv] for kv in lkv]
        dres := s1::DSOL
        g := dres.eegen
        a := (a exquo g)::UP
        b := (dres.bpar exquo g)::UP
        aa := dres.acoeff
        oans := dres.ans
        lq := [divide(c, g) for c in dres.lcpar]
        lr := [q.remainder for q in lq]
        rs1 : Matrix(F) := reducedSystem(matrix([lr])$Matrix(UP))
        rs2 := get_rs(rs1)
        lkv := nullSpace(rs2)
        empty?(lkv) => []
        lc := [q.quotient for q in lq]
        nlc : List(UP) := []
        for kv in lkv repeat
            nlc := cons(lin_comb(kv, lc), nlc)
        nlc := reverse!(nlc)
        s2 := param_SPDE(a, b, nlc, dres.dpar, der, get_rs, do_degrad, x)
        nres : L_Param_UP := []
        for be in s2 repeat
            bv := lin_comb(be.coeffs, lkv)
            ans1 := lin_comb(bv, oans) + aa*be.ratpart
            nres := cons([ans1, bv], nres)
        reverse!(nres)

    integer_vector(v : Vector(Q)) : Union(Vector(Integer), "failed") ==
        (nv, d) := splitDenominator(v)$CommonDenominator(Integer, Q, Vector(Q))
        d ~= 1 => "failed"
        nv(1) ~= 1 => "failed"
        vector([retract(nv(i))@Integer for i in 1..#nv])

    do_SPDE_prim0(b : F, lc : List(UP), lk : LK,
                 ext : (LK, LF) -> L_Param_F,
                 logi : (LK, LF) -> Param_Rec_QF, der : UP -> UP,
                 get_rs : Matrix(F) -> Matrix(F), x : SY
                ) :  L_Param_Q ==
        n := #lc
        vg2 := vector([lc])$Vector(UP)
        cb := [new(n, 0)$Vector(F) for i in 1..n]
        for i in 1..n for bv in cb repeat
            bv(i) := 1
        d := reduce(max, [degree(c) for c in lc], 0)
        dk := retract(der(monomial(1, 1)$UP))@F
        lba : List(RF) := [0 for bv in cb]
        cba := [0$F for bv in cb]
        for j in d..0 by -1 repeat
            lgj : List(F) := []
            for i in 1..n repeat
                gi := vg2(i)
                gij : F := 0
                if degree(gi) = j then
                    gij := leadingCoefficient(gi)
                    vg2(i) := reductum(gi)
                lgj := cons(-gij, lgj)
            lgj := reverse!(lgj)
            lgj1 : List(F) := []
            for bv in cb for aa in cba repeat
                ff := lin_comb(bv, lgj) + (j + 1)::F*dk*aa
                lgj1 := cons(ff, lgj1)
            lgj1 := reverse!(lgj1)
            s2f := param_rde2(b, lgj1, x, lk, ext, logi)
            ncb := [lin_comb(be.coeffs, cb) for be in s2f]
            cba := [be.ratpart for be in s2f]
            nlba := [lin_comb(be.coeffs, lba) +
                   monomial(be.ratpart, j::N)$UP::RF for be in s2f]
            cb := ncb
            lba := nlba
        [[ba, bv] for ba in lba for bv in cb]

    do_ext(ext : (LK, LF) -> L_Param_F, lcr : List RF, k : K,
           lk : LK) : L_Param_Q ==
        lc := [multivariate(cr, k) for cr in lcr]
        res1 := ext(lk, lc)
        [[univariate(be.ratpart, k), be.coeffs] for be in res1]


    do_SPDE_prim(a : UP, bbr : RF, is_der : Boolean,
                lcr : List RF, k: K, lk : LK,
                ext : (LK, LF) -> L_Param_F,
                logi : (LK, LF) -> Param_Rec_QF, der : UP -> UP,
                get_rs : Matrix(F) -> Matrix(F), x : SY
               ) : L_Param_Q ==
        fp := retract(der(monomial(1, 1)))@F
        base_case : Boolean := fp = 1
        b := retract(bbr)@UP
        lc : List(UP) := [retract(cr)@UP for cr in lcr]
        da := degree(a)
        db := degree(b)
        dc := reduce(max, [degree(c) for c in lc]$List(Z))
        not(base_case) and da = 0 and db = 0 =>
            b1 := retract(b)@F/retract(a)@F
            b1 = 0 => do_ext(ext, lcr, k, lk)
            if not(is_der) then
                (ll, bl) := logi(lk, [b1])
                if not(empty?(bl)) then
                    bv := first(bl)
                    bvu := integer_vector(bv)
                    if bvu case Vector(Integer) then
                             error "need transform and call ext"
            do_SPDE_prim0(b1, lc, lk, ext, logi, der, get_rs, x)
        n :=
            db > da => max(0, dc - db)
            max(0, dc - da + 1)
        if da = db + 1 then
            f0 := -leadingCoefficient(b)/leadingCoefficient(a)
            base_case =>
                if (mu := retractIfCan(f0)@Union(Z, "failed")) case Z then
                    n := max(n, mu@Z)
            r0 := dehomogenize(ext(lk, [-f0, fp])).particular
            if not(r0 case "failed") then
                mf : F := ((r0@Param_Rec_F).coeffs)(1)
                if (mu := retractIfCan(mf)@Union(Z, "failed")) case Z then
                    n := max(n, mu@Z)
        if not base_case and da = db then
            f0 := -leadingCoefficient(b)/leadingCoefficient(a)
            b1 := f0*a + b
            if degree(b1) + 1 = da then
                f1 := -leadingCoefficient(b1)/leadingCoefficient(a)
                r0 := dehomogenize(ext(lk, [-f1, fp])).particular
                if not(r0 case "failed") then
                    mf : F := ((r0@Param_Rec_F).coeffs)(1)
                    if (mu := retractIfCan(mf)@Union(Z, "failed")) case Z then
                        n := max(n, mu@Z)
        do_degrad := (bb : RF, lc1 : List(RF)) : L_Param_Q +->
            do_SPDE_prim(1, bb, is_der, lc1, k, lk, ext, logi, der, get_rs, x)
        res1 := param_SPDE(a, b, lc, n, der, get_rs, do_degrad, x)
        [[re.ratpart::RF, re.coeffs] for re in res1]

    do_SPDE_exp0(a : F, b : F, lcr : List(GP), lk : LK, eta : F,
                 ext : (LK, LF) -> L_Param_F,
                 logi : (LK, LF) -> Param_Rec_QF, x : SY
                ) : L_Param_Q ==
        n := #lcr
        vg2 := vector([lcr])$Vector(GP)
        cb := [new(n, 0)$Vector(F) for cr in lcr]
        for i in 1..n for bv in cb repeat
            bv(i) := 1
        lba : List(GP) := [0 for cr in lcr]
        d := reduce(max, [degree(cr) for cr in lcr])
        j := d
        f0 := b/a
        repeat
            last_iter : Boolean := true
            lgj : List(F) := []
            for i in 1..n repeat
                gi := vg2(i)
                gij : F := 0
                if gi ~= 0 then
                    last_iter := false
                    if degree(gi) = j then
                        gij := leadingCoefficient(gi)
                        vg2(i) := reductum(gi)
                lgj := cons(gij, lgj)
            last_iter => break
            lgj := reverse!(lgj)
            lgj1 : List(F) := []
            for bv in cb repeat
                ff := lin_comb(bv, lgj)
                lgj1 := cons(-ff, lgj1)
            lgj1 := reverse!(lgj1)
            s2f := param_rde2(f0 + j::F*eta, lgj1, x, lk, ext, logi)
            ncb := [lin_comb(be.coeffs, cb) for be in s2f]
            nlba := [lin_comb(be.coeffs, lba) +
                   monomial(be.ratpart, j)$GP for be in s2f]
            cb := ncb
            lba := nlba
            j := j - 1
        [[convert(re)@RF, bv] for re in lba for bv in cb]

    exp_lower_bound(a : UP, b : GP, ob : Z, nc0 : Z, lk : LK,
                   eta : F, logi : (LK, LF) -> Param_Rec_QF) : Z ==
        ob < 0 => min(0, nc0 - ob)
        n0 := min(0, nc0)
        0 < ob => n0
        c0 := coefficient(b, 0)/coefficient(a, 0)
        (ll, bl) := logi(lk, [c0, eta])
        empty?(bl) => n0
        bv := first(bl)
        nu := retractIfCan(bv(2)/bv(1))@Union(Integer, "failed")
        nu case "failed" => n0
        min(nu@Integer, n0)

    exp_upper_bound(a : UP, b : UP, nc1 : Z, lk : LK, eta : F,
                   logi : (LK, LF) -> Param_Rec_QF) : Z ==
        da := degree(a)
        db := degree(b)
        da < db => nc1 - db
        n0 := max(0, nc1 - da)
        db < da => n0
        c1 := leadingCoefficient(b)/leadingCoefficient(a)
        (ll, bl) := logi(lk, [c1, eta])
        empty?(bl) => n0
        bv := first(bl)
        nu := retractIfCan(bv(2)/bv(1))@Union(Integer, "failed")
        nu case "failed" => n0
        max(nu@Integer, n0)

    do_SPDE_exp(a : UP, bbr : RF, lcr : List RF, lk : LK,
                ext : (LK, LF) -> L_Param_F,
                logi : (LK, LF) -> Param_Rec_QF, der : UP -> UP,
                get_rs : Matrix(F) -> Matrix(F), x : SY) : L_Param_Q ==
        b := RF_to_GP(bbr)
        lc := [RF_to_GP(cr) for cr in lcr]
        nb0 := order(b)
        nc0 := reduce(min, [order(c) for c in lc])
        eta := retract((der(monomial(1, 1)) exquo monomial(1, 1))::UP)@F
        degree(a) = 0 and degree(b) = 0 and nb0 = 0 =>
            do_SPDE_exp0(retract(a), retract(b), lc, lk, eta, ext, logi, x)
        n0 := exp_lower_bound(a, b, nb0, nc0, lk, eta, logi)
        if n0 < 0 then
            b := b + (n0::F*eta)::GP*a::GP
        if nb0 < 0 then
            t1 := monomial(1, (-nb0)::N)$UP
            b := t1::GP*b
            a := t1*a
        bu := retract(b)@UP
        m0 := min(0, n0) + min(0, nb0)
        if m0 < 0 then
            t1 := monomial(1, (-m0)::N)$GP
            lc := [t1::GP*c for c in lc]
        lcu := [retract(c)@UP for c in lc]
        nc1 := reduce(max, [degree(cu) for cu in lcu])
        n1 := exp_upper_bound(a, bu, nc1, lk, eta, logi)
        do_degrad := (bb : RF, lc1 : List(RF)) : L_Param_Q +->
            do_SPDE_exp0(1, retract(numer(bb)), [RF_to_GP(c1) for c1 in lc1],
                         lk, eta, ext, logi, x)
        res1 := param_SPDE(a, bu, lcu, n1, der, get_rs, do_degrad, x)
        tt : RF :=
            n0 < 0 => (monomial(1, (-n0)::N)$UP)::RF
            1
        [[re.ratpart::RF/tt, re.coeffs] for re in res1]

    param_rde(m, f, g0, lg, x, lk, ext, logi) ==
        lg1 := cons(-g0, lg)
        res1 := param_rde(m, f, lg1, x, lk, ext, logi)
        dehomogenize(res1)

    param_rde2(fp, lg, x, lk, ext, logi) ==
        k := kmax(lk)
        lk := [k1 for k1 in lk | k1 ~= k]
        has?(operator k, ALGOP)$BasicOperator =>
            do_alg_rde(fp, lg, x, k, lk, ext, logi)
        is?(k, OPDIFF) =>
            do_diff_rde(fp, lg, x, k, lk, ext, logi)
        dku := univariate(differentiate(k::F, x), k)
        denom(dku) ~= 1 =>
            []
        dk := numer(dku)
        fpu := univariate(fp, k)
        der1 : UP -> UP := z1 +-> differentiate(z1,
               (z2 : F) : F +-> differentiate(z2, x), dk)
        rl := normalize(fpu, der1)
        p : UP := 1
        for re in rl repeat
            (pii, ni) := re
            fpu := fpu - ni::F*der1(pii)/pii
            p := pii^(ni::NonNegativeInteger)*p
        fp := multivariate(fpu, k)
        pf := multivariate(p::RF, k)
        lg1 := [pf*g for g in lg]
        res1 := do_param_rde(fp, false, lg1, x, k, lk, ext, logi)
        [[rs.ratpart/pf, rs.coeffs] for rs in res1]

    csolve1(m : Matrix F, d1 : F -> F) : List Vector(F) ==
        nullSpaceOverConstants(m, [d1])$ConstantLinearDependence(R, F)

    do_diff_rde1(lg : List UP, fp0 : F, fp1 : F, x : SY, k : K, lk : LK,
                ext : (LK, LF) -> L_Param_F,
                logi : (LK, LF) -> Param_Rec_QF) : L_Param_F ==
        args := argument(k)
        #args ~= 3 => error "internal error, k is not a diff"
        arg3 := args(3)
        (da3 := differentiate(arg3, x)) = 0 => []
        lg0 := [coefficient(up, 0) for up in lg]
        lg1 := [coefficient(up, 1) for up in lg]
        k1 := eval(args(1), retract(args(2))@K, arg3)
        dv := new()$Symbol
        dvf := dv::F
        lg2 := [eval(g/da3, k1, dvf) for g in lg1]
        fp2 := eval(fp1/da3, k1, dvf)
        lek := [eval(ki::F, k1, dvf) for ki in lk]
        lk1 := varselect(tower(cons(dvf, append(lg2, lek))), dv)
        ext1 := (x4 : List K, x3 : List F) : L_Param_F +->
                 extendedint(dv, x4, x3
                            )$ParametricIntegration(R, F)
        logi1 := (x2 : List K, x3 : List F) : Param_Rec_QF +->
                  logextint(dv, x2, x3
                           )$ParametricIntegration(R, F)
        kk1 := kmax(lk1)
        lk2 := [ki for ki in lk1 | ki ~= kk1]
        res1 : L_Param_F :=
            fp2 = 0 => ext1(lk1, lg2)
            do_param_rde(fp2, true, lg2, dv, kk1, lk2,  ext1, logi1)
        empty?(res1) => []
        cb0 := [be.coeffs for be in res1]
        d1 := (x1 : F) : F +-> differentiate(x1, x)
        (m2, cb) := constant_subspace(cb0, [d1]
                                      )$ConstantLinearDependence(R, F)
        empty?(cb) => []
        v2 := vector([be.ratpart for be in res1])$Vector(F)
        v3 := m2*v2
        lca := entries(v3)
        lg3 := [lin_comb(bv, lg1) for bv in cb]
        nlg0 := [lin_comb(bv, lg0) for bv in cb]
        lca := map((x1 : F) : F+->eval(x1, kernel(dv), k1::F), lca)
        nlg : List(F) := []
        for ca in lca for g1 in lg3 for g0 in nlg0 repeat
            du := univariate(differentiate(ca, x), k)
            nu := numer(du)
            denom(du) ~= 1 or degree(nu) > 1 => return []
            g1 + fp1*ca + coefficient(nu, 1) ~= 0 => return []
            ng := g0 + fp0*ca + coefficient(nu, 0)
            nlg := cons(ng, nlg)
        nlg := reverse!(nlg)
        cb1 : List(Vector(F))
        elca : List(F)
        if fp1 ~= 0 then
            m3 := matrix([nlg])$Matrix(F)
            cb1 := csolve1(m3, d1)
            elca := [0 for bv in cb1]
        else
            kk3 := kmax(lk)
            res2 := do_param_rde(fp0, true, nlg, x, kk3, lk1, ext, logi)
            cb1 := [be.coeffs for be in res2]
            elca := [be.ratpart for be in res2]
        ncb := [lin_comb(bv, cb) for bv in cb1]
        nlca := [ca + lin_comb(bv, lca) for bv in cb1 for ca in elca]
        [[ba, bv] for ba in nlca for bv in ncb]

    do_diff_rde(fp : F, lg : List F, x : SY, k : K, lk : LK,
                ext : (LK, LF) -> L_Param_F,
                logi : (LK, LF) -> Param_Rec_QF) : L_Param_F ==
        -- FIXME check that fp contains no extra kernels
        fpu := univariate(fp, k)
        denom(fpu) ~= 1 or degree(nfpu := numer(fpu)) > 1 => []
        fp1 := coefficient(nfpu, 1)
        fp0 := coefficient(nfpu, 0)
        d1 := (x1 : F) : F +-> differentiate(x1, x)
        cs1 := (x4 : Matrix F) : List Vector F +->
                      csolve1(x4, d1)
        diff_rde1 := (x1 : List UP) : L_Param_F +->
                 do_diff_rde1(x1, fp0, fp1, x, k, lk, ext, logi)
        diffextint(diff_rde1, cs1, [univariate(u, k) for u in lg]
                  )$ParametricTranscendentalIntegration(F, UP)

    do_alg_rde0(fp : F, lg : List F, x : SY, k : K, lk : LK,
                ext : (LK, LF) -> L_Param_F,
                logi : (LK, LF) -> Param_Rec_QF) : L_Param_F ==
        ak := argument(k)
        ak2 := ak(2)
        n := retract(ak2)@Integer
        ak1 := ak(1)
        dlk := D(ak1, x)/(ak2*ak1)
        kf := k::F
        kfi : F := 1
        llv := vector([alg_split_root0(g, k, n)$RootFSSplit(R, F)
                        for g in lg])$Vector(List(F))
        m := #lg
        cb := [new(m, 0)$Vector(F) for i in 1..m]
        for i in 1..m for bv in cb repeat
            bv(i) := 1
        lba : List(F) := [0 for bv in cb]
        nlba : List(F)
        for i in 0..(n-1) repeat
            lgi : List F := []
            for j in 1..m repeat
                lgi := cons(first(llv(j)), lgi)
                llv(j) := rest(llv(j))
            lgi := reverse!(lgi)
            lgi1 := [lin_comb(bv, lgi) for bv in cb]
            s1 := param_rde2(fp + i::F*dlk, lgi1, x, lk, ext, logi)
            ncb := [lin_comb(be.coeffs, cb) for be in s1]
            nlba := [lin_comb(be.coeffs, lba) + be.ratpart*kfi for be in s1]
            cb := ncb
            lba := nlba
            kfi := kf*kfi
        [[ba, bv] for ba in lba for bv in cb]

    do_alg_rde(fp : F, lg : List F, x : SY, k : K, lk : LK,
               ext : (LK, LF) -> L_Param_F,
               logi : (LK, LF) -> Param_Rec_QF) : L_Param_F ==
        if #lg = 1 then
            cc := lg(1)/fp
            if D(cc, x) = 0 then
                return [[-cc, [1]]]
        is?(k, 'nthRoot) and not(member?(k, kernels(fp))) =>
            do_alg_rde0(fp, lg, x, k, lk, ext, logi)
        k1 := kmax(lk)
        symbolIfCan(k1) case SY =>
            res1 := param_RDE(fp, lg, k1, k)$PureAlgebraicIntegration(R, F, F)
            n := #lg
            part1 : L_Param_F := [[-be.ratpart, be.coeffs]
                                    for be in res1.particular]
            part2 : L_Param_F := [[f, new(n, 0)$Vector(F)] for f in res1.basis]
            concat(part1, part2)
        has?(operator k1, ALGOP) =>
            rec := primitiveElement(k1::F, k::F
                    )$FunctionSpacePrimitiveElement(R, F)
            y   := rootOf(rec.prim)
            ky := retract(y)@K
            fp1 := eval(fp, [k1, k], [(rec.pol1) y, (rec.pol2) y])
            lg1 := [eval(g, [k1, k], [(rec.pol1) y, (rec.pol2) y]) for g in lg]
            res1 := do_alg_rde(fp1, lg1, x, ky, [kk for kk in lk | kk ~= k1],
                               ext, logi)
            [[eval(be.ratpart, ky, rec.primelt), be.coeffs] for be in res1]
        error "do_alg_rde: unimplemented kernel"

    param_rde(m, f, lg, x, lk, ext, logi) ==
        (fp := D(m*f, x)) = 0 => ext(lk, lg)
        k := kmax(lk)
        lk := [k1 for k1 in lk | k1 ~= k]
        do_param_rde(fp, true, lg, x, k, lk, ext, logi)

    -- assumes fp is weakly normalized
    do_param_rde(fp, is_der, lg, x, k, lk, ext, logi) ==
        has?(operator k, ALGOP)$BasicOperator =>
            do_alg_rde(fp, lg, x, k, lk, ext, logi)
        is?(k, OPDIFF) =>
            do_diff_rde(fp, lg, x, k, lk, ext, logi)
        -- below we assume that main kernel k
        -- is a monomial
        dku := univariate(differentiate(k::F, x), k)
        denom(dku) ~= 1 => []
        dk := numer(dku)
        fpu := univariate(fp, k)
        lgu := [univariate(g, k) for g in lg]
        der1 : UP -> UP := z1 +-> differentiate(z1,
               (z2 : F) : F +-> differentiate(z2, x), dk)
        (d, h) := get_denom(fpu, lgu, der1)
        aa := d*h
        bbr := aa*fpu - (d*der1(h))::RF
        aa1 := aa*h
        lgu := [aa1*gu for gu in lgu]
        lgd := [decompose(gu, der1)$MET for gu in lgu]
        lnor1 := [dr.normal for dr in lgd]
        rs1 : Matrix(UP) := reducedSystem(matrix([lnor1])$Matrix(RF))
        rs2 : Matrix(F) := reducedSystem(rs1)
        get_rs := (m : Matrix(F)) : Matrix(F) +->
              reducedSystem(m, [(ff : F) : F +-> differentiate(ff, x)]
                           )$ConstantLinearDependence(R, F)
        rs3 := get_rs(rs2)
        lker := nullSpace(rs3)
        empty?(lker) => []
        lgu := [dr.poly::RF + dr.special for dr in lgd]
        lgu1 : List(RF) := []
        for kv in lker repeat
            lgu1 := cons(lin_comb(kv, lgu), lgu1)
        lgu1 := reverse!(lgu1)
        res1 :=
            symbolIfCan(k) case SY or is?(k, 'log)
              or has?(operator k, PRIM)$BasicOperator =>
                do_SPDE_prim(aa, bbr, is_der, lgu1, k, lk, ext,
                             logi, der1, get_rs, x)
            is?(k, 'exp) =>
                do_SPDE_exp(aa, bbr, lgu1, lk, ext, logi, der1, get_rs, x)
            return []
        res2 : L_Param_F := []
        for re in res1 repeat
            bv := lin_comb(re.coeffs, lker)
            ans1 : RF := -re.ratpart/h::RF
            anf : F := multivariate(ans1, k)
            res2 := cons([anf, bv], res2)
        reverse!(res2)


)abbrev package INTALG2 AlgebraicIntegrate2
++ Description: This package implements parametric integration
++  in algebraic case.  Some cases remain unimplemented and the
++  code throws errors when they appear as the input.
AlgebraicIntegrate2(R0, F, UP, UPUP, R) : Exports == Implementation where
  R0   : Join(Comparable, IntegralDomain, RetractableTo Integer)
  F    : Join(AlgebraicallyClosedField, FunctionSpace R0)
  UP   : UnivariatePolynomialCategory F
  UPUP : UnivariatePolynomialCategory Fraction UP
  R    : FunctionFieldCategory(F, UP, UPUP)

  QF  ==> Fraction UP
  Param_Rec_F ==> Record(ratpart : F, coeffs : Vector(F))
  L_Param_F ==> List Param_Rec_F
  Param_Rec_Q ==> Record(ratpart : QF, coeffs : Vector(F))
  L_Param_Q ==> List Param_Rec_Q
  Param_Rec_R ==> Record(ratpart : R, coeffs : Vector(F))
  L_Param_R ==> List Param_Rec_R
  Exports ==> with
      algextint : (UP -> UP, List(QF) -> L_Param_Q,
                   (QF, List QF) -> L_Param_Q,
                   Matrix F -> List Vector F, List(R)) -> L_Param_R
        ++ algextint(der, ext, rde, csolve, [g1, ..., gn]) returns
        ++ a basis of solutions of the homogeneous system
        ++ \spad{h' + c1*g1 + ... + cn*gn = 0}.
        ++ Argument ext is an extended integration function on F,
        ++ rde is RDE solver, csolve is linear solver over constants.
      algextint_base : (UP -> UP,
                   Matrix F -> List Vector F, List(R)) -> L_Param_R
        ++ algextint_base(der,  csolve, [g1, ..., gn]) is like
        ++ algextint(der, ext, rde, csolve, [g1, ..., gn]), but assumes
        ++ that field is algebraic extension of rational functions and
        ++ that gi-s have no poles at infinity.

  Implementation ==> add

      GP  ==> LaurentPolynomial(F, UP)
      AHR ==> AlgebraicHermiteIntegration(F, UP, UPUP, R)
      HER_Rec ==> Record(answer : R, logpart : R, polypart : R)
      Param_Rec_UP ==> Record(ratpart : UP, coeffs : Vector(F))
      L_Param_UP ==> List Param_Rec_UP
      RSOL ==> Record(ans : UP, remainder : UP)

      import from LiftLinearDependence(F, F, UP)

      algprimextint : (UP -> UP, List(QF) -> L_Param_Q,
                      (QF, List QF) -> L_Param_Q,
                       Matrix F -> List Vector F, List(R)) -> L_Param_R
      algexpextint : (UP -> UP, List(QF) -> L_Param_Q,
                     (QF, List QF) -> L_Param_Q,
                      Matrix F -> List Vector F, List(R)) -> L_Param_R

      exp_hermite1(f : R, der : UP -> UP) : HER_Rec ==
          d := (c := integralCoordinates f).den
          v := c.num
          vp : Vector(QF) := new(n := #v, 0)
          vf : Vector(QF) := new(n, 0)
          for i in minIndex v .. maxIndex v repeat
              r := separate(qelt(v, i) / d)$GP
              qsetelt!(vf, i, r.fracPart)
              qsetelt!(vp, i, convert(r.polyPart)@QF)
          ff := represents(vf, w := integralBasis())
          fp := represents(vp, w)
          h := HermiteIntegrate(ff, der)$AHR
          [h.answer, h.logpart, fp]

      prim_hermite1(f : R, der : UP -> UP) : HER_Rec ==
          h := HermiteIntegrate(f, der)$AHR
          zero?(hh := h.logpart) => [h.answer, 0, 0]
          d := (c := integralCoordinates(hh)).den
          v := c.num
          vp : Vector(QF) := new(n := #v, 0)
          vf : Vector(QF) := new(n, 0)
          for i in minIndex v .. maxIndex v repeat
              r := divide(qelt(v, i), d)$UP
              qsetelt!(vf, i, (r.remainder)/d)
              qsetelt!(vp, i, (r.quotient)::QF)
          ff := represents(vf, w := integralBasis())
          fp := represents(vp, w)
          [h.answer, ff, fp]

      list_hermite(lf : List(R), hermite1 : R -> HER_Rec) : List(HER_Rec) ==
          [hermite1(f) for f in lf]

      import from LinearCombinationUtilities(F, UP)

      lin_comb2(v : Vector F, lr : List(R)) : R ==
          res : R := 0
          for i in 1..#v for r in lr repeat
              res := res + v(i)::UP::QF*r
          res

      split_logpart(p : QF, lg : QF, dden : UP
                   ) : Record(polypart : QF, logpart : QF) ==
          d0 := denom(lg)
          g := gcd(dden, d0)
          ground?(g) => [p, lg]
          d1 := (d0 exquo g)::UP
          ground?(d1) => [p + lg, 0]
          eeu := extendedEuclidean(g, d1, numer(lg))
          (a, b) := eeu::Record(coef1 : UP, coef2 : UP)
          [p + a/d1, b/g]

      split_logparts(lup : List QF, llog : List QF, dden : UP
                    ) : Record(polypart : List QF, logpart : List QF) ==
          pres : List QF := []
          lres : List QF := []
          for p1 in lup for lg1 in llog repeat
              (p2, lg2) := split_logpart(p1, lg1, dden)
              lres := cons(lg2, lres)
              pres := cons(p2, pres)
          pres := reverse!(pres)
          lres := reverse!(lres)
          [pres, lres]

      diagextint(dden : UP, dm : Matrix(UP), w : Vector(R),
                 lpv : List Vector QF, lgv : List Vector QF,
                 ca0 : List R,
                 ext : List QF -> L_Param_Q,
                 rde : (QF, List QF) -> L_Param_Q,
                 csolve : Matrix F -> List Vector F) : L_Param_R ==
          lrf := [pv(1) + gv(1) for pv in lpv for gv in lgv]
          res0 := ext(lrf)
          cb := [be0.coeffs for be0 in res0]
          wi := w(1)
          ca : List(R) := [be0.ratpart*wi for be0 in res0]
          for i in 2..#w repeat
              dmi := dm(i, i)/dden
              lup0 := [pv(i) for pv in lpv]
              llog0 := [gv(i) for gv in lgv]
              (lup1, llog1) := split_logparts(lup0, llog0, denom(dmi))
              llog2 := [lin_comb(bv, llog1) for bv in cb]
              res1 := csolve_rf(csolve, llog2)
              ncb0 := [lin_comb(bv, cb) for bv in res1]
              nca0 := [lin_comb2(bv, ca) for bv in res1]
              cb := ncb0
              ca := nca0
              lup2 := [lin_comb(bv, lup1) for bv in cb]
              res2 := rde(dmi, lup2)
              ncb1 := [lin_comb(be.coeffs, cb) for be in res2]
              wi := w(i)
              nca1 := [be.ratpart*wi + lin_comb2(be.coeffs, ca)
                       for be in res2]
              cb := ncb1
              ca := nca1
          [[ai - lin_comb2(bv, ca0), bv] for ai in ca for bv in cb]

      R_to_VQF(p : R) : Vector(QF) ==
          c := integralCoordinates(p)
          numv := c.num
          n := #numv
          res := new(n, 0)$Vector(QF)
          cden := c.den
          for i in 1..n repeat
              res(i) := numv(i)/cden
          res

      algprimextint(der, ext, rde, csolve, lg) ==
          hermite1 : R -> HER_Rec := g +-> prim_hermite1(g, der)
          lh := list_hermite(lg, hermite1)
          lpv : List Vector(QF) := []
          lgv : List Vector(QF) := []
          for h in lh repeat
              lpv := cons(R_to_VQF(h.polypart), lpv)
              lgv := cons(R_to_VQF(h.logpart), lgv)
          lpv := reverse!(lpv)
          lgv := reverse!(lgv)
          w := integralBasis()$R
          dm := integralDerivationMatrix(der)$R
          dden := dm.den
          ca0 := [h.answer for h in lh]
          w(1) = 1 and diagonal?(dm.num) =>
              diagextint(dden, dm.num, w, lpv, lgv, ca0, ext, rde, csolve)
          error "algprimextint: non-root case unimplemented"

      algexpextint(der, ext, rde, csolve, lg) ==
          hermite1 : R -> HER_Rec := g +-> exp_hermite1(g, der)
          lh := list_hermite(lg, hermite1)
          lpv : List Vector(QF) := []
          lgv : List Vector(QF) := []
          w := integralBasis()$R
          for h in lh repeat
              lpv := cons(R_to_VQF(h.polypart), lpv)
              lgv := cons(R_to_VQF( h.logpart),lgv)
          lpv := reverse!(lpv)
          lgv := reverse!(lgv)
          dm := integralDerivationMatrix(der)$R
          dden := dm.den
          ca0 := [h.answer for h in lh]
          w(1) = 1 and diagonal?(dm.num) =>
              diagextint(dden, dm.num, w, lpv, lgv, ca0, ext, rde, csolve)
          error "algexpextint: non-root case unimplemented"

      algextint_base(der, csolve, lg) ==
          hermite1 : R -> HER_Rec := g +-> prim_hermite1(g, der)
          lh := list_hermite(lg, hermite1)
          lg1 := [h.logpart + h.polypart for h in lh]
          rs1 : Matrix(QF) := reducedSystem(matrix([lg1]))
          res1 := csolve_rmat(csolve, rs1)
          ca0 := [h.answer for h in lh]
          [[-lin_comb2(bv, ca0), bv] for bv in res1]

      algextint(der, ext, rde, csolve, lg) ==
          x' := der(x := monomial(1, 1)$UP)
          zero? degree(x') =>
              algprimextint(der, ext, rde, csolve, lg)
          ((xx := x' exquo x) case UP) and
            (retractIfCan(xx@UP)@Union(F, "failed") case F) =>
              algexpextint(der, ext, rde, csolve, lg)
          error "algextint: unhandled case"

)abbrev package INTPAR2 ParametricIntegration
++ Description: This package implements general parametric integration.
++  Most work is delegated to other packages.
ParametricIntegration(R, F) : Exports == Implementation where
  R : Join(GcdDomain, Comparable, CharacteristicZero,
           RetractableTo Integer, LinearlyExplicitOver Integer)
  F : Join(AlgebraicallyClosedField, TranscendentalFunctionCategory,
           FunctionSpace R)

  N   ==> NonNegativeInteger
  Q   ==> Fraction(Integer)
  SY  ==> Symbol
  K   ==> Kernel F
  P   ==> SparseMultivariatePolynomial(R, K)
  UP  ==> SparseUnivariatePolynomial F
  RF  ==> Fraction UP
  OPDIFF ==> '%diff
  Partial_C ==>  Union(Vector F, "failed")
  Both_C ==> Record(particular : Partial_C, basis : List Vector F)
  Param_Rec_F ==> Record(ratpart : F, coeffs : Vector F)
  L_Param_F ==> List Param_Rec_F
  Partial_F ==>  Union(Param_Rec_F, "failed")
  Both_F ==> Record(particular : Partial_F, basis : L_Param_F)
  Param_Rec_Q ==> Record(ratpart : RF, coeffs : Vector F)
  L_Param_Q ==> List Param_Rec_Q
  Param_Rec_QF ==> Record(logands : List F, basis : List Vector Q)
  Param_Rec_Q2 ==> Record(logands : List RF, basis : List Vector Q)
  PC_Rec ==> Record(ratpart : F,  coeff : F, prim : F)
  UFS ==> Union(PC_Rec, "failed")

  Exports ==> with
    extendedint : (SY, List K, List F) -> L_Param_F
      ++ extendedint(x, [k1, ..., kn], [g1, ..., gn]) returns
      ++ a basis of the homogeneous system
      ++ \spad{dh/dx + c1*g1 + ... + cn*gn = 0}.  Solutions are
      ++ in the field generated by k1, ..., kn.
    extendedint : (F, SY, List K, List F) -> Both_F
      ++ extendedint(f, x, [k1, ..., kn], [g1, ..., gn]) is like
      ++ extendedint(f, [k1, ..., kn], [g1, ..., gn]) but looks for
      ++ solutions in the field generated by k1, ..., kn.
    polylog_int : (F, SY, K, N, List K, F) -> UFS
      ++ polylog_int(f, x, k0, [k1, ..., kn], g)
    extendedint : (F, SY, List F) -> Both_F
      ++ extendedint(f, x, [g1, ..., gn]) returns
      ++ solution of the system  \spad{f = dh/dx + c1*g1 + ... + cn*gn} and
      ++ and a basis of the associated homogeneous system
      ++ \spad{dh/dx + c1*g1 + ... + cn*gn = 0}.  Solutions are
      ++ in the field generated by kernels of f and g1, ..., gn.
    logextint : (SY, List K, List F) -> Param_Rec_QF
      ++ logextint(x, lk, lg) returns [[u1, ..., um], bas] giving
      ++ basis of solution of
      ++ the homogeneous systym
      ++ \spad{c1*g1 + ... + cn*gn + c_{n+1}u1'/u1 + ... c_{n+m}um'/um  = 0}

  Implementation ==> add
    import from IntegrationTools(R, F)
    import from AlgebraicManipulations(R, F)
    import from FunctionSpacePrimitiveElement(R, F)
    import from PolynomialCategoryQuotientFunctions(IndexedExponents K,
                                                             K, R, P, F)
    import from LiftLinearDependence(F, F, UP)

    PRIM := 'prim
    ALGOP := '%alg

    algextint : (SY, K, List K, List F) -> L_Param_F
    primextint : (SY, K, List K, List F) -> L_Param_F
    expextint : (SY, K, List K, List F) -> L_Param_F
    diffextint : (SY, K,  List K, List F) -> L_Param_F
    unkextint : (SY, K,  List K, List F) -> L_Param_F

    alglfint    : (F, K, List K, SY) -> IR
    algprimint  : (F, K, K, SY) -> IR
    algexpint   : (F, K, K, SY) -> IR
    primint     : (F, SY, K) -> IR
    expint      : (F, SY, K) -> IR
    lambint     : (F, SY, K) -> IR
    prim?       : (K, SY)  -> Boolean
    isx?        : (F, SY)  -> Boolean
    addx        : (IR, F) -> IR
    cfind       : (F, LLG) -> F
    lfintegrate0 : (F, SY) -> IR

    prim?(k, x)      == is?(k, 'log) or has?(operator k, PRIM)

    csolve2(m : Matrix(F)) : List Vector Q ==
        n := nrows(m)
        v := new(n, 0)$Vector(F)
        (solveLinearlyOverQ(m, v)$IntegerLinearDependence(F)).basis

    EFACT ==> ExpressionFactorPolynomial(R, F)

    primlogextint(x : SY, k : K, l : List(K), lg : List F) : Param_Rec_QF ==
        rec1 := (lg1 : List F) : Param_Rec_QF +->
                logextint(x, l, lg1)
        rec := (lg2 : List UP) : Param_Rec_Q2 +->
                monologextint(lg2, csolve2, rec1
                              )$ParametricTranscendentalIntegration(F, UP)
        d1 := (x1 : F) : F +-> differentiate(x1, x)
        der := (x1 : UP) : UP+->differentiate(x1, d1,
                differentiate(k::F, x)::UP)
        uf : UP -> Factored(UP) := factorPolynomial$EFACT
        (ll, bl) := logextint(der, uf, csolve2,
                      rec, [univariate(g, k) for g in lg]
                      )$ParametricTranscendentalIntegration(F, UP)
        [[multivariate(le, k) for le in ll], bl]

    explogextint1(lg : List(UP), eta : F, rec1 : List F -> Param_Rec_QF
                 ) : Param_Rec_Q2 ==
        lg1 := concat(lg, eta::UP)
        (ll, bl) := monologextint(lg1, csolve2, rec1
                           )$ParametricTranscendentalIntegration(F, UP)
        ll1 := cons(monomial(1, 1)$UP::RF, ll)
        [ll1, bl]

    explogextint(x : SY, k : K, l : List(K), lg : List F) : Param_Rec_QF ==
        eta := differentiate(first(argument(k)), x)
        d1 := (x1 : F) : F +-> differentiate(x1, x)
        der := (x1 : UP) : UP +-> differentiate(x1, d1,
                 monomial(eta, 1)$UP)
        rec1 := (lg1 : List F) : Param_Rec_QF +->
                logextint(x, l, lg1)
        rec := (lg2 : List UP) : Param_Rec_Q2 +->
            explogextint1(lg2, eta, rec1)
        uf : UP -> Factored(UP) := factorPolynomial$EFACT
        (ll, bl) := logextint(der, uf, csolve2,
                      rec, [univariate(g, k) for g in lg]
                      )$ParametricTranscendentalIntegration(F, UP)
        [[multivariate(le, k) for le in ll], bl]

    alglogextint(x : SY, k : K, l : List(K), lg : List F) : Param_Rec_QF ==
        every?((g : F) : Boolean +-> not(member?(k, kernels(g))), lg) =>
            logextint(x, l, lg)
        error "alglogextint: unimplemented"

    logextint(x, l, lg) ==
        empty?(l) =>
            cb := csolve2(matrix([lg])$Matrix(F))
            [[], cb]
        k := kmax(l)
        l := [k1 for k1 in l | k1 ~= k]
        symbolIfCan(k) case SY or prim?(k, x) =>
            primlogextint(x, k, l, lg)
        is?(k, 'exp) => explogextint(x, k, l, lg)
        has?(operator k, ALGOP)$BasicOperator => alglogextint(x, k, l, lg)
        error "logextint: unhandled kernel"

    extendedint(f : F, x : SY, lg : List F) ==
        l := varselect(tower(cons(x::F, cons(f, lg))), x)
        extendedint(f, x, l, lg)

    extendedint(x : SY, l : List K, lg : List F) ==
        empty?(l) =>
            cb := nullSpace(matrix([lg])$Matrix(F))
            [[0, kv] for kv in cb]
        k := kmax(l)
        l := [k1 for k1 in l | k1 ~= k]
        symbolIfCan(k) case SY or prim?(k, x) =>
            primextint(x, k, l, lg)
        is?(k, 'exp) =>
            expextint(x, k, l, lg)
        has?(operator k, ALGOP) =>
            algextint(x, k, l, lg)
        is?(k, OPDIFF) =>
            diffextint(x, k, l, lg)
        unkextint(x, k, l, lg)

    extendedint(f, x, l, lg) ==
        dehomogenize(extendedint(x, l, cons(-f, lg))
                    )$LinearCombinationUtilities(F, UP)

    extendedint0(f : F, x : SY, l : List K, g : F) : UFS ==
        r1 := extendedint(f, x, l, [g]).particular
        r1 case "failed" => "failed"
        rf := r1@Param_Rec_F
        [rf.ratpart, (rf.coeffs)(1), 0]$PC_Rec

    import from TranscendentalHermiteIntegration(F, UP)

    her_REC ==> Record(answer : F, rest : F)

    hermite_integrate(lf : List(F), x : SY, k : K) : List(her_REC) ==
        lfu := [univariate(f, k) for f in lf]
        d1 := (x1 : F) : F +-> differentiate(x1, x)
        der : UP -> UP :=
            symbolIfCan(k) case SY or prim?(k, x) =>
                (x1 : UP) : UP +-> differentiate(x1, d1,
                                     differentiate(k::F, x)::UP)
            eta := first argument k
            (x1 : UP) : UP+->differentiate(x1, d1,
                monomial(differentiate(eta, x), 1))
        lher := [HermiteIntegrate(fu, der) for fu in lfu]
        [[multivariate(h1.answer, k), multivariate(h1.logpart
            + h1.specpart + h1.polypart::RF, k)]$her_REC for h1 in lher]

    if F has SpecialFunctionCategory then

      gen_polylog(d : N, v : F, k : F) : F ==
          d = 1 => polylog(2::F, 1 - v)
          res : F := polylog((d+1)::F, v)
          lv := k
          s := -lv*log(1 - v)
          for j in 2..d repeat
              s := lv*(polylog(j::F, v) - s/(d - j + 2)::F)
          nn := (-1)^d*factorial(d)
          nn::F*(res - s)

      polylog_int(f, x, k0, d, l, g) ==
        res2 := extendedint0(f, x, l, g)
        res2 case PC_Rec =>
            [res2.ratpart, res2.coeff, res2.prim]
        if d > 0 and is?(k0, 'log) then
            k := kmax(l)
            ans1 : F := 0
            if symbolIfCan(k) case SY or prim?(k, x) or is?(k, 'exp) then
                res1 := first(hermite_integrate([f], x, k))
                f := res1.rest
                ans1 := res1.answer
            v := first(argument(k0))
            dv := differentiate(v, x)
            v1 := 1 - v
            c0 := (f*v1)/dv
            if differentiate(c0, x) = 0 then
                res := c0*gen_polylog(d, v, k0::F)
                return [ans1, 0, res]$PC_Rec
        "failed"
    else
      polylog_int(f, x, k0, d, l, g) == extendedint0(f, x, l, g)

    csolve1(m : Matrix F, d1 : F -> F) : List Vector(F) ==
        nullSpaceOverConstants(m, [d1])$ConstantLinearDependence(R, F)

    wrapfn(fn : List F -> L_Param_F, k : K) : List RF -> L_Param_Q ==
        (lrf : List RF) : L_Param_Q +->
            lf := [multivariate(rf, k) for rf in lrf]
            r1 := fn(lf)
            la := [univariate(be.ratpart, k) for be in r1]
            [[a, be.coeffs] for a in la for be in r1]

    algextint(x, k, l, lg) ==
        import from LinearCombinationUtilities(F, UP)
        k1 := kmax(l)
        l := [k2 for k2 in l | k2 ~= k1]
        symbolIfCan(k1) case SY or prim?(k1, x) or is?(k1, 'exp) =>
            d1 := (x1 : F) : F +-> differentiate(x1, x)
            cs1 := (x2 : Matrix F) : List Vector(F) +-> csolve1(x2, d1)
            dk : UP :=
                is?(k1, 'exp) =>
                   monomial(differentiate(first argument k1, x), 1)
                differentiate(k1::F, x)::UP
            der1 := (x1 : UP) : UP+->differentiate(x1, d1, dk)
            symbolIfCan(k1) case SY =>
                algextint_base(k1, k, der1, cs1, lg
                              )$AlgebraicIntegration(R, F)
            ext1 := (x3 : List F) : L_Param_F +->
                      extendedint(x, cons(k1, l), x3)
            ext2 := (x4 : List K, x3 : List F) : L_Param_F +->
                      extendedint(x, x4, x3)
            logi := (x2 : List K, x3 : List F) : Param_Rec_QF +->
                      logextint(x, x2, x3)
            rde1 := (x6 : F, x3 : List F) : L_Param_F +->
                param_rde2(x6, x3, x, cons(k1, l), ext2, logi
                          )$ParametricRischDE(R, F)
            rde2 := (x5 : RF, x4 : List RF) : L_Param_Q +->
                wrapfn((x3 : List F) : L_Param_F +->
                    rde1(multivariate(x5, k1), x3), k1)(x4)
            algextint(k1, k, der1, wrapfn(ext1, k1), rde2, cs1, lg
                     )$AlgebraicIntegration(R, F)
        has?(operator k1, ALGOP) =>
            is?(operator k, 'nthRoot) and is?(operator k1, 'nthRoot) and
              not(member?(k1, tower(k::F))) =>
                l := [k2 for k2 in l | k2 ~= k1]
                al :=  alg_split_roots(lg, k, k1
                         )$RootFSSplit(R, F)
                n := #lg
                ca := [0$F for i in 1..n]
                cb := [new(n, 0)$Vector(F) for i in 1..n]
                for i in 1..n for bv in cb repeat
                    bv(i) := 1
                for rec in al repeat
                    lg1 := [lin_comb(bv, rec.funs) for bv in cb]
                    res1 : L_Param_F
                    if rec.npow1 + rec.npow2 > 0 then
                        nrr := retract(rec.nroot)@K
                        res1 := extendedint(x, cons(nrr, l), lg1)
                        oroot := (k::F)^rec.npow1*(k1::F)^rec.npow2
                        na1 := [eval(be.ratpart, nrr, oroot)
                                 for be in res1]
                    else
                        res1 := extendedint(x, l, lg1)
                        na1 := [be.ratpart for be in res1]
                    nca := [lin_comb(be.coeffs, ca) + a1 for be in res1
                              for a1 in na1]
                    ca := nca
                    ncb := [lin_comb(be.coeffs, cb) for be in res1]
                    cb := ncb
                [[a1, bv] for a1 in ca for bv in cb]
            rec := primitiveElement(k1::F, k::F)
            y   := rootOf(rec.prim)
            yk  := retract(y)@K
            nk1 := (rec.pol1) y
            nk  := (rec.pol2) y
            lg1 := [eval(g, [k1, k], [nk1, nk]) for g in lg]
            res1 := algextint(x, yk, l, lg1)
            [[eval(be.ratpart, yk, rec.primelt), be.coeffs] for be in res1]
        error "algextint unimplemented kernel"

    primextint(x, k, l, lu) ==
        d1 := (x1 : F) : F +-> differentiate(x1, x)
        der := (x1 : UP) : UP+->differentiate(x1, d1,
                differentiate(k::F, x)::UP)
        ext := (x3 : List F) : L_Param_F +->
                      extendedint(x, l, x3)
        cs1 := (x4 : Matrix F) : List Vector F +->
                      csolve1(x4, d1)
        res1 := primextint(der, ext, cs1,
                  [univariate(u, k) for u in lu]
                 )$ParametricTranscendentalIntegration(F, UP)
        [[multivariate(si.ratpart, k), si.coeffs]
           for si in res1]

    expextint(x, k, l, lu) ==
        eta := first argument k
        d1 := (x1 : F) : F +-> differentiate(x1, x)
        der := (x1 : UP) : UP+->differentiate(x1, d1,
                monomial(differentiate(eta, x), 1))
        ext := (x2 : List K, x3 : List F) : L_Param_F +->
                      extendedint(x, x2, x3)
        logi := (x2 : List K, x3 : List F) : Param_Rec_QF +->
                      logextint(x, x2, x3)
        rde := (x1 : Integer, x3 : List F) : L_Param_F +->
                 param_rde(x1, eta, x3, x, l, ext, logi
                          )$ParametricRischDE(R, F)
        cs1 := (x4 : Matrix F) : List Vector F +->
                      csolve1(x4, d1)
        res1 := expextint(der, rde, cs1,
                  [univariate(u, k) for u in lu]
                  )$ParametricTranscendentalIntegration(F, UP)
        [[multivariate(si.ratpart, k), si.coeffs]
           for si in res1]

    diffextint1(lup : List UP, x : SY, k : K, lk : List K,
                  csolve : Matrix(F) -> List Vector(F)) : L_Param_F ==
        import from LinearCombinationUtilities(F, UP)
        args := argument(k)
        #args ~= 3 => error "internal error, k is not a diff"
        arg3 := args(3)
        (da3 := differentiate(arg3, x)) = 0 =>
            b0 := csolve_pol(csolve, lup)
            [[0, bv] for bv in b0]
        lg0 := [coefficient(up, 0) for up in lup]
        lg1 := [coefficient(up, 1) for up in lup]
        k1 := eval(args(1), retract(args(2))@K, arg3)
        dv := new()$Symbol
        dvf := dv::F
        lg2 := [eval(g/da3, k1, dvf) for g in lg1]
        lek := [eval(ki::F, k1, dvf) for ki in lk]
        lk1 := varselect(tower(cons(dvf, append(lg2, lek))), dv)
        res1 := extendedint(dv, lk1, lg2)
        empty?(res1) => []
        cb0 := [be.coeffs for be in res1]
        d1 := (x1 : F) : F +-> differentiate(x1, x)
        (m2, cb) := constant_subspace(cb0, [d1]
                                     )$ConstantLinearDependence(R, F)
        empty?(cb) => []
        v2 := vector([be.ratpart for be in res1])$Vector(F)
        v3 := m2*v2
        lca := entries(v3)
        lg3 := [lin_comb(bv, lg1) for bv in cb]
        nlg0 := [lin_comb(bv, lg0) for bv in cb]
        lca := map((x1 : F) : F+->eval(x1, kernel(dv), k1::F), lca)
        nlg : List(F) := []
        for ca in lca for g1 in lg3 for g0 in nlg0 repeat
            du := univariate(differentiate(ca, x), k)
            nu := numer(du)
            denom(du) ~= 1 or degree(nu) > 1 => return []
            g1 + coefficient(nu, 1) ~= 0 => return []
            ng := g0 + coefficient(nu, 0)
            nlg := cons(ng, nlg)
        nlg := reverse!(nlg)
        res2 := extendedint(x, lk, nlg)
        empty?(res2) => []
        cb1 := [be.coeffs for be in res2]
        nlca := [be.ratpart for be in res2]
        ncb := [lin_comb(bv, cb) for bv in cb1]
        nlca := [be.ratpart + lin_comb(bv, lca) for bv in cb1 for be in res2]
        [[ba, bv] for ba in nlca for bv in ncb]

    diffextint(x, k, l, lg) ==
        d1 := (x1 : F) : F +-> differentiate(x1, x)
        cs1 := (x4 : Matrix F) : List Vector F +->
                      csolve1(x4, d1)
        diffi1 := (x1 : List UP) : L_Param_F +->
                 diffextint1(x1, x, k, l, cs1)
        diffextint(diffi1, cs1, [univariate(u, k) for u in lg]
                  )$ParametricTranscendentalIntegration(F, UP)

    unkextint(x, k, l, lg) ==
        d1 := (x1 : F) : F +-> differentiate(x1, x)
        cs1 := (x4 : Matrix F) : List Vector F +->
                      csolve1(x4, d1)
        ext := (x3 : List F) : L_Param_F +->
                      extendedint(x, l, x3)
        unkextint(ext, cs1, [univariate(u, k) for u in lg]
                 )$ParametricTranscendentalIntegration(F, UP)
