)abbrev package PEVALUT PolynomialEvaluationUtilities
++ Description: This package implements evaluation functions
++  useful for modular algorithms.  Computations work
++  on integer polynomials, but most is done modulo a prime
++  which is provided via parameters, either explicitly or
++  through a state parameter (state also caches needed buffers).
++  Some functions work on fractions.  To avoid useless GCD
++  computations during evaluation fractions may be represented
++  as a record.
PolynomialEvaluationUtilities : Exports == Implementation where
  MP ==> Polynomial Integer
  FrP ==> Record(numer : MP, denom : MP)
  PA ==> U32Vector
  PSS ==> Record(prime : Integer, eval1coeffbuf : PA,
                 eval1expbuf : SortedExponentVector)
  Exports ==> with
    eval1a : (MP, Integer, PSS) -> Integer
      ++ eval1a(pol, pt, pss) evaluates polynomial pol at
      ++ point pt using global state form pss.  Computations are
      ++ done modulo a prime contained in pss.  Note: pol must
      ++ have at most one variable.
    eval1 : (MP, Symbol, Integer, PSS) -> MP
      ++ eval1(pol, v, pt, pss) evaluates pol in variable v at pt,
      ++ using global state form pss.  Computations are
      ++ done modulo a prime contained in pss.
    eval1 : (FrP, Symbol, Integer, PSS) -> Union(FrP, "failed")
      ++ eval1(pq, v, pt, pss) evaluates fraction of polynomial pq
      ++ in variable v at pt, using global state form pss.  Computations
      ++ are done modulo a prime contained in pss.
    modpreduction : (MP, Integer) -> MP
      ++ modpreduction(pol, p) reduces polynomial pol modulo
      ++ prime p.
    modpreduction : (Fraction(MP), Integer) -> Union(FrP, "failed")
      ++ modpreduction(r, p) reduces a rational function r modulo
      ++ prime p.
    modpeval : (MP, List Symbol, List Integer, Integer) -> Integer
      ++ modpeval(pol, lv, lpt, p) evaluates polynomial pol in
      ++ variables form lv at point from lpt modulo a prime p
  Implementation ==> add

    import from U32VectorPolynomialOperations

    SmpTerm ==> Record(k : NonNegativeInteger, c : MP)
    VPoly ==>  Record(v : Symbol, ts : List SmpTerm)
    SmpRep ==>  Union(Integer, VPoly)

    Qmul ==> QSMULMOD32$Lisp
    Qmuladd ==> QSMULADDMOD64_32$Lisp

    eval1a(pol : MP, pt : Integer, pss : PSS) : Integer ==
        p := pss.prime
        polr := pol pretend SmpRep
        polr case Integer =>
            return polr
        polu : List SmpTerm := polr.ts
        i : SingleInteger := 0
        coeffs := pss.eval1coeffbuf
        exps := pss.eval1expbuf
        n := #coeffs
        ns := qconvert(n)@SingleInteger
        for t0 in polu repeat
            if not(i < ns) then
                nn := 2*n
                ncoeffs := new(nn, 0)$PA
                copy_first(ncoeffs, coeffs, n)
                coeffs := ncoeffs
                pss.eval1coeffbuf := coeffs
                nexps := new(nn, 0)$SortedExponentVector
                copy_first(nexps pretend PA, exps pretend PA, n)
                exps := nexps
                pss.eval1expbuf := exps
                n := nn
                ns := qconvert(n)@SingleInteger
            t1 := t0.c pretend SmpRep
            exps(i) := t0.k
            if t1 case Integer then
                coeffs(i) := t1
            else
                error "More than one variable in eval1a"
            i := i + 1
        res : Integer := 0
        ptk : Integer := 1
        pk : SingleInteger := 0
        for j in (i - 1)..0 by -1 repeat
            ki := qconvert(exps(j))@SingleInteger
            while pk < ki repeat
                ptk := Qmul(ptk, pt, p)
                pk := pk + 1
            res := Qmuladd(ptk, coeffs(j), res, p)
        res

    eval1(pol : MP, vv : Symbol, pt : Integer, pss : PSS) : MP ==
        polr := pol pretend SmpRep
        polr case Integer => return pol
        vx : Symbol := polr.v
        vx = vv => return eval1a(pol, pt, pss)::MP
        xu : List SmpTerm := polr.ts
        yu : List SmpTerm := []
        c1 : MP
        for t0 in xu repeat
            t1 := t0.c pretend SmpRep
            t1 case Integer => yu := cons([t0.k, t0.c], yu)
            c1 := eval1(t0.c, vv, pt, pss)
            c1 = 0 => 0
            yu := cons([t0.k, c1], yu)
        xr : SmpRep :=
            yu = [] => 0
            [vx, reverse! yu]
        xr pretend MP

    eval1(pol : FrP, vv : Symbol, pt : Integer, pss : PSS
         ) : Union(FrP, "failed") ==
        d := eval1(pol.denom, vv, pt, pss)
        d = 0 => "failed"
        [eval1(pol.numer, vv, pt, pss), d]

    modpreduction(x : MP, p : Integer) : MP ==
      xr : SmpRep := x pretend SmpRep
      c0 : Integer
      xr case Integer =>
         c0 := positiveRemainder(xr, p)
         xr := c0
         xr pretend MP
      vx : Symbol := xr.v
      xu : List SmpTerm := xr.ts
      yu : List SmpTerm := []
      c1 : MP
      for t0 in xu repeat
        t1 := t0.c pretend SmpRep
        t1 case Integer =>
          c0 := positiveRemainder(t1, p)
          c0 = 0 => 0
          xr := c0
          yu := cons([t0.k, xr pretend MP], yu)
        c1 := modpreduction(t0.c, p)
        c1 = 0 => 0
        yu := cons([t0.k, c1], yu)
      xr :=
         yu = [] => 0
         [vx, reverse! yu]
      xr pretend MP

    modpreduction(x : Fraction(MP), p : Integer
                 ) : Union(FrP, "failed") ==
        d := modpreduction(denom(x), p)
        d = 0 => "failed"
        [modpreduction(numer(x), p), d]

    modpeval(x : MP, vars : List Symbol, pts : List Integer, _
             p : Integer) : Integer ==
        xr : SmpRep := x pretend SmpRep
        xr case Integer =>
            return positiveRemainder(xr, p)
        vx : Symbol := xr.v
        vx ~= first(vars) =>
            return modpeval(x, rest vars, rest pts, p)
        vxval := first pts
        vars := rest vars
        pts := rest pts
        xu : List SmpTerm := xr.ts
        yu : List SmpTerm := []
        ptk : Integer := 1
        kk : Integer := 0
        res : Integer := 0
        xu := reverse(xu)
        for t0 in xu repeat
            t1 := t0.c pretend SmpRep
            kk1 := t0.k
            while kk < kk1 repeat
                  ptk := Qmul(vxval, ptk, p)
                  kk := kk + 1
            c0 :=
                  t1 case Integer => positiveRemainder(t1, p)
                  modpeval(t0.c, vars, pts, p)
            res := Qmuladd(ptk, c0, res, p)
        res

)abbrev category MEVCAT ModularEvaluationCategory
++ Description: ModularEvaluationCategory(PT, MP) defines interface
++  to evaluation functions for ModularAlgebraicGcd2.
ModularEvaluationCategory(PT : Type, MP : Type) : Category == Exports where

  PA ==> U32Vector
  PSS ==> Record(prime : Integer, eval1coeffbuf : PA,
                 eval1expbuf : SortedExponentVector)
  Exports ==> with
    degree : (MP, Symbol) -> NonNegativeInteger
      ++ degree(p, v) computes degree of p with respect to v.
    ldegree : (PT, Symbol) -> NonNegativeInteger
      ++ ldegree(p, v) computes degree of p with respect to v.  v must
      ++ be one of auxiliary variables and must be lexicographically
      ++ first variable which appears in p.  Moreover, p must be
      ++ a polynomial in v (not a rational function).
    eval1a : (MP, Integer, PSS) -> Integer
      ++ eval1a(p, r, pss) evaluates p at r.  p must be polynomial
      ++ in single variable.  pss is global state.
    eval1 : (MP, Symbol, Integer, PSS) -> MP
      ++ eval1(p, v, r, pss) evaluates p with respect to single
      ++ variable v at r.  pss is global state.
    modpreduction : (MP, Integer) -> MP
      ++ modpreduction(p, q) reduces all coefficients of p modulo q.
    subst_vars : (PT, List Symbol, List Symbol) -> MP
      ++ subst_vars(p, lv1, lv2) substitutes variables from list lv2
      ++ for corresponding variables from lv1.
    trial_division : (MP, Polynomial(Integer), List(MP),
                      Symbol, List(Symbol)) -> Boolean
      ++ trial_division(p, q, lm, v, lz) checks if p is divisible
      ++ by q.  lm is a list of defining equations for algebraic
      ++ parameters, v is main variable, lz is the list of algebraic
      ++ parameters.


)abbrev package MEVAL1 ModularEvaluation1
ModularEvaluation1() : Exports == Implementation where
  MP ==> Polynomial(Integer)
  Exports ==> ModularEvaluationCategory(MP, MP)
  Implementation ==> add

    PE ==> PolynomialEvaluationUtilities

    degree(p, s) == degree(p, s)$MP
    ldegree(p, s) == degree(p, s)$MP
    eval1a(p, pt, s) == eval1a(p, pt, s)$PE
    eval1(p, v, pt, s) == eval1(p, v, pt, s)$PE
    modpreduction(p, q) == modpreduction(p, q)$PE

    subst_vars(p, ls1, ls2) ==
        lm := [monomial(1, v, 1) for v in ls2]
        eval(p, ls1, lm)

    SMPI ==> SparseMultivariatePolynomial(Integer, Symbol)

    trial_division(p, g, lm, v, ls) ==
        alg_trial_division(p pretend SMPI, g pretend SMPI,
                  [m pretend SMPI for m in lm], [v], ls
                 )$PrimGCD


)abbrev domain FAKEPOL FakePolynomial
++ Description: FakePolynomial is a domain of univariate polynomials
++  with coefficients being fractions of multivariate integer
++  polynomials.  Coefficients are kept in unsimplified form.
++  This domain exists to avoid cost of recursive GCD calls
++  during polynomial evaluation.
FakePolynomial : Exports == Implementation where
  MP ==> Polynomial(Integer)
  MPU ==> SparseUnivariatePolynomial(MP)
  RF ==> Fraction(MP)
  UP ==> SparseUnivariatePolynomial(RF)
  PT ==> Record(var : Symbol, coef : UP)
  FrP ==> Record(numer : MP, denom : MP)

  Exports ==> CoercibleTo(OutputForm) with
      degree : (%, Symbol) -> NonNegativeInteger
      ground : % -> FrP
      map : (MP -> MP, %) -> %
      map : (MP -> MP, PT) -> %
      map : (FrP -> Union(MP, "failed"), %) -> Union(MPU, "failed")
      subst_var : (%, List(Symbol), List(Symbol)) -> %
      to_UP : % -> UP

  Implementation ==> add

      Node ==> Record(deg : NonNegativeInteger, coef : FrP)
      Rep := Record(var : Symbol, coef : List Node)

      frac_out(fr : FrP) : OutputForm ==
          (fr.numer)::OutputForm / (fr.denom::OutputForm)

      mon_out(mon : Node, v : Symbol) : OutputForm ==
          (d := mon.deg) = 0 => frac_out(mon.coef)
          vo := v::OutputForm
          pw :=
              d = 1 => vo
              vo ^ d::OutputForm
          frac_out(mon.coef) * pw

      coerce(p : %) : OutputForm ==
          pr1 := p::Rep
          cl := pr1.coef
          empty?(cl) => (0$Integer)::OutputForm
          ol := [mon_out(mon, pr1.var) for mon in pr1.coef]
          reduce(_+, ol)

      ground(p : %) : FrP ==
          pr1 := p::Rep
          pr := pr1.coef
          empty?(pr) => [0, 1]
          r1 := first(pr)
          not(r1.deg = 0) => error "ground: not(r1.deg = 0)"
          r1.coef

      map(f : MP -> MP, p : %) : % ==
          pr1 := p::Rep
          pr := pr1.coef
          res0 : List Node := [[0, [0, 0]]]
          res1 := res0
          repeat
              empty?(pr) =>
                  return [pr1.var, rest(res0)]
              r1 := first(pr)
              pr := rest(pr)
              c1 := r1.coef
              n1 := f(c1.numer)
              n1 = 0 => "iterate"
              res1 := qsetrest!(res1, [[r1.deg, [n1, f(c1.denom)]]])

      map(f : MP -> MP, p : PT) : % ==
          pr := p.coef
          res0 : List Node := [[0, [0, 0]]]
          res1 := res0
          repeat
              pr = 0 => return [p.var, rest(res0)]
              d := degree(pr)
              c1 := leadingCoefficient(pr)
              pr := reductum(pr)
              n1 := f(numer(c1))
              n1 = 0 => "iterate"
              res1 := qsetrest!(res1, [[d, [n1, f(denom(c1))]]])

      map(f : FrP -> Union(MP, "failed"), p : %) : Union(MPU, "failed") ==
          pr1 := p::Rep
          pr := pr1.coef
          res0 : MPU := 0
          while not(empty?(pr)) repeat
              r1 := first(pr)
              pr := rest(pr)
              c1u := f(r1.coef)
              c1u case "failed" => "failed"
              res0 := res0 + monomial(c1u::MP, r1.deg)$MPU
          res0

      degree(p, s) ==
          pr1 := p::Rep
          pr := pr1.coef
          empty?(pr) => 0
          pr1.var = s => first(pr).deg
          res := 0
          for r1 in pr repeat
              c1 := r1.coef
              degree(c1.denom, s) > 0 =>
                  error "degree: not a polynomial in given variable"
              res := max(res, degree(c1.numer, s))
          res

      to_UP(p) ==
          pr1 := p::Rep
          pr := pr1.coef
          res0 : UP := 0
          while not(empty?(pr)) repeat
              r1 := first(pr)
              pr := rest(pr)
              c1 := r1.coef
              n1 := c1.numer
              n1 = 0 => "iterate"
              cr : RF := n1/c1.denom
              res0 := res0 + monomial(cr, r1.deg)$UP
          res0

      subst_var(p, ls1, ls2) ==
          pr1 := p::Rep
          v1 := pr1.var
          for s1 in ls1 for s2 in ls2 repeat
              if v1 = s1 then return [s2, pr1.coef]
          p


)abbrev package MEVAL2 ModularEvaluation2
ModularEvaluation2() : Exports == Implementation where
  MP ==> Polynomial(Integer)
  RF ==> Fraction(MP)
  UP ==> SparseUnivariatePolynomial(RF)
  PT ==> Record(var : Symbol, coef : UP)
  FP ==> FakePolynomial
  Exports ==> ModularEvaluationCategory(PT, FP)
  Implementation ==> add

    PE ==> PolynomialEvaluationUtilities

    degree(p : FP, s : Symbol) == degree(p, s)$FP
    ldegree(p : PT, s : Symbol) ==
        s = p.var => error "ldegree: s = p.var"
        p1 := p.coef
        degree(p1) > 0 => error "ldegree: degree(p1) > 0"
        p2 : RF := ground(p1)
        np2 : MP := numer(p2)$RF
        dp2 : MP := denom(p2)$RF
        degree(dp2, s) > 0 =>
            error "ldegree: degree(dp2, s) > 0"
        degree(np2, s)$MP

    eval1(p, v, pt, s) ==
        map((c : MP) : MP +-> eval1(c, v, pt, s)$PE, p)$FP

    modpreduction(p, q) ==
        map((c : MP) : MP +-> modpreduction(c, q)$PE, p)$FP

    subst_vars(p, ls1, ls2) ==
        lm := [monomial(1$MP, v, 1) for v in ls2]
        res1 := map((c : MP) : MP +-> eval(c, ls1, lm), p)
        subst_var(res1, ls1, ls2)

    Qfun ==> PolynomialCategoryQuotientFunctions(IndexedExponents Symbol,
               Symbol, Integer, MP, RF)

    sas := create()$SingletonAsOrderedSet

    -- remove algebraics from denominator
    m_reduc(x1 : RF, lmu : List(UP), ls : List(Symbol)) : RF ==
        for s in ls for m in lmu repeat
            q := univariate(x1, s, m)$Qfun
            x1 := retract(eval(q, sas, s::MP::RF::UP))@RF
        x1

    trial_division(p, g, lm, v, ls) ==
        gu1 := univariate(g, v)
        gu := map((c : MP) : RF +-> c::RF, gu1
                 )$SparseUnivariatePolynomialFunctions2(MP, RF)
        pu := to_UP(p)
        lcg := leadingCoefficient(gu)
        dg := degree(gu)
        rgu := reductum(gu)
        lmu := [numer(univariate(ground(to_UP(m)$FP), s)$Qfun)
                 for m in lm for s in ls]
        while not((dp := degree(pu)) < dg or pu = 0) repeat
            lcp := leadingCoefficient(pu)
            c1 := m_reduc(lcp/lcg, lmu, ls)
            pu := reductum(pu) -
                    monomial(c1, (dp - dg)::NonNegativeInteger)*rgu
        while not(pu = 0) repeat
            lcp := leadingCoefficient(pu)
            c1 := m_reduc(lcp, lmu, ls)
            not(c1 = 0) => return false
            pu := reductum(pu)
        true
