)abbrev package REDORDER ReductionOfOrder
++ Author: Manuel Bronstein
++ Date Created: 4 November 1991
++ Description:
++ \spadtype{ReductionOfOrder} provides
++ functions for reducing the order of linear ordinary differential equations
++ once some solutions are known.
++ Keywords: differential equation, ODE
ReductionOfOrder(F, L) : Exports == Impl where
  F : Field
  L : LinearOrdinaryDifferentialOperatorCategory F

  Z ==> Integer
  A ==> PrimitiveArray F

  Exports ==> with
    ReduceOrder : (L, F) -> L
      ++ ReduceOrder(op, s) returns \spad{op1} such that for any solution
      ++ \spad{z} of \spad{op1 z = 0}, \spad{y = s \int z} is a solution of
      ++ \spad{op y = 0}. \spad{s} must satisfy \spad{op s = 0}.
    ReduceOrder : (L, List F) -> Record(eq : L, op : List F)
      ++ ReduceOrder(op, [f1, ..., fk]) returns \spad{[op1, [g1, ..., gk]]} such that
      ++ for any solution \spad{z} of \spad{op1 z = 0},
      ++ \spad{y = gk \int(g_{k-1} \int(... \int(g1 \int z)...))} is a solution
      ++ of \spad{op y = 0}. Each \spad{fi} must satisfy \spad{op fi = 0}.

  Impl ==> add
    ithcoef   : (L, Z, A) -> F
    locals    : (A, Z, Z) -> F
    localbinom : (Z, Z) -> Z

    diff := D()$L

    localbinom(j, i) == (j > i => binomial(j, i+1); 0)
    locals(s, j, i)  == (j > i => qelt(s, j - i - 1); 0)

    ReduceOrder(l : L, sols : List F) ==
      empty? sols => [l, empty()]
      neweq := ReduceOrder(l, sol := first sols)
      rec := ReduceOrder(neweq, [diff(s / sol) for s in rest sols])
      [rec.eq, concat!(rec.op, sol)]

    ithcoef(eq, i, s) ==
      ans : F := 0
      while eq ~= 0 repeat
          j   := degree eq
          ans := ans + localbinom(j, i) * locals(s, j, i) * leadingCoefficient eq
          eq  := reductum eq
      ans

    ReduceOrder(eq : L, sol : F) ==
      s : A := new(n := degree eq, 0)         -- will contain derivatives of sol
      si := sol                             -- will run through the derivatives
      qsetelt!(s, 0, si)
      for i in 1..(n-1)::NonNegativeInteger repeat
          qsetelt!(s, i, si := diff si)
      ans : L := 0
      for i in 0..(n-1)::NonNegativeInteger repeat
          ans := ans + monomial(ithcoef(eq, i, s), i)
      ans

)abbrev package LODEEF ElementaryFunctionLODESolver
++ Author: Manuel Bronstein
++ Date Created: 3 February 1994
++ Description:
++ \spad{ElementaryFunctionLODESolver} provides the top-level
++ functions for finding closed form solutions of linear ordinary
++ differential equations and initial value problems.
++ Keywords: differential equation, ODE
ElementaryFunctionLODESolver(R, F, L) : Exports == Implementation where
  R : Join(Comparable, PolynomialFactorizationExplicit, RetractableTo Integer,
          LinearlyExplicitOver Integer, CharacteristicZero)
  F : Join(AlgebraicallyClosedFunctionSpace R, TranscendentalFunctionCategory,
          PrimitiveFunctionCategory)
  L : LinearOrdinaryDifferentialOperatorCategory F

  SY  ==> Symbol
  N   ==> NonNegativeInteger
  K   ==> Kernel F
  V   ==> Vector F
  M   ==> Matrix F
  UP  ==> SparseUnivariatePolynomial F
  RF  ==> Fraction UP
  UPUP==> SparseUnivariatePolynomial RF
  P   ==> SparseMultivariatePolynomial(R, K)
  P2  ==> SparseMultivariatePolynomial(P, K)
  LQ  ==> LinearOrdinaryDifferentialOperator1 RF
  REC ==> Record(particular : F, basis : List F)
  U   ==> Union(REC, "failed")

  Exports ==> with
    solve : (L, F, SY) -> U
      ++ solve(op, g, x) returns either a solution of the ordinary differential
      ++ equation \spad{op y = g} or "failed" if no non-trivial solution can be
      ++ found; When found, the solution is returned in the form
      ++ \spad{[h, [b1, ..., bm]]} where \spad{h} is a particular solution and
      ++ and \spad{[b1, ...bm]} are linearly independent solutions of the
      ++ associated homogenuous equation \spad{op y = 0}.
      ++ A full basis for the solutions of the homogenuous equation
      ++ is not always returned, only the solutions which were found;
      ++ \spad{x} is the dependent variable.
    solve : (L, F, SY, F, List F) -> Union(F, "failed")
      ++ solve(op, g, x, a, [y0, ..., ym]) returns either the solution
      ++ of the initial value problem \spad{op y = g, y(a) = y0, y'(a) = y1, ...}
      ++ or "failed" if the solution cannot be found;
      ++ \spad{x} is the dependent variable.

  Implementation ==> add
    import from Kovacic(F, UP)
    import from ODETools(F, L)
    import from RationalLODE(F, UP)
    import from RationalRicDE(F, UP)
    import from ODEIntegration(R, F)
    import from ConstantLODE(R, F, L)
    import from IntegrationTools(R, F)
    import from ReductionOfOrder(F, L)
    import from ReductionOfOrder(RF, LQ)
    import from PureAlgebraicIntegration(R, F, L)
    import from FunctionSpacePrimitiveElement(R, F)
    import from LinearSystemMatrixPackage(F, V, V, M)
    import from SparseUnivariatePolynomialFunctions2(RF, F)
    import from LinearOrdinaryDifferentialOperatorFactorizer(F, UP)
    import from PolynomialCategoryQuotientFunctions(IndexedExponents K,
                                                             K, R, P, F)

    ALGOP  := '%alg

    upmp       : (P, List K) -> P2
    downmp     : (P2, List K, List P) -> P
    xpart      : (F, SY) -> F
    smpxpart   : (P, SY, List K, List P) -> P
    multint    : (F, List F, SY) -> F
    ulodo      : (L, K) -> LQ
    firstOrder : (F, F, F, SY) -> REC
    rfSolve    : (L, F, K, SY) -> U
    ratlogsol  : (LQ, List RF, K, SY) -> List F
    expsols    : (LQ, K, SY) -> List F
    homosolve  : (L, LQ, List RF, K, SY) -> List F
    homosolve1 : (L, List F, K, SY) -> List F
    norf1      : (L, K, SY, N) -> List F
    kovode     : (LQ, K, SY) -> List F
    doVarParams : (L, F, List F, SY) -> U
    localmap   : (F -> F, L) -> L
    algSolve   : (L, F, K, List K, SY) -> U
    palgSolve  : (L, F, K, K, SY) -> U
    lastChance : (L, F, SY) -> U

    diff := D()$L

    simp_roots(f : F, la : List(F)) : F ==
        tf := tower(f)
        ta := tower(la)
        for k in setDifference(tf, ta) repeat
            if is?(k, 'nthRoot) then
                k1 := rootSimp(k::F)$AlgebraicManipulations(R, F)
                f := subst(f, [k], [k1])
        f

    smpxpart(p, x, l, lp) == downmp(primitivePart upmp(p, l), l, lp)
    downmp(p, l, lp)      == ground eval(p, l, lp)
    homosolve(lf, op, sols, k, x) == homosolve1(lf, ratlogsol(op, sols, k, x), k, x)

-- left hand side has algebraic (not necessarily pure) coefficients
    algSolve(op, g, k, l, x) ==
      symbolIfCan(kx := ksec(k, l, x)) case SY => palgSolve(op, g, kx, k, x)
      has?(operator kx, ALGOP) =>
        rec := primitiveElement(kx::F, k::F)
        z   := rootOf(rec.prim)
        lk : List K := [kx, k]
        lv : List F := [(rec.pol1) z, (rec.pol2) z]
        (u := solve(localmap((f1 : F) : F +-> eval(f1, lk, lv), op), eval(g, lk, lv), x))
            case "failed" => "failed"
        rc := u::REC
        kz := retract(z)@K
        [eval(rc.particular, kz, rec.primelt),
            [eval(f, kz, rec.primelt) for f in rc.basis]]
      lastChance(op, g, x)

    doVarParams(eq, g, bas, x) ==
      (u := particularSolution(eq, g, bas, (f1: F): F +-> int(f1, x))) case "failed" =>
         lastChance(eq, g, x)
      [u::F, bas]

    lastChance(op, g, x) ==
      (degree op) = 1 => firstOrder(coefficient(op, 0), leadingCoefficient op, g, x)
      "failed"

-- solves a0 y + a1 y' = g
-- does not check whether there is a solution in the field generated by
-- a0, a1 and g
    firstOrder(a0, a1, g, x) ==
      h := xpart(expint(- a0 / a1, x), x)
      [h * int((g / h) / a1, x), [h]]

-- xpart(f, x) removes any constant not involving x from f
    xpart(f, x) ==
      l  := reverse! varselect(tower f, x)
      lp := [k::P for k in l]
      smpxpart(numer f, x, l, lp) / smpxpart(denom f, x, l, lp)

    upmp(p, l) ==
      empty? l => p::P2
      up := univariate(p, k := first l)
      l := rest l
      ans : P2 := 0
      while up ~= 0 repeat
        ans := ans + monomial(upmp(leadingCoefficient up, l), k, degree up)
        up  := reductum up
      ans

-- multint(a, [g1, ..., gk], x) returns gk \int(g(k-1) \int(....g1 \int(a))...)
    multint(a, l, x) ==
       for g in l repeat a := g * xpart(int(a, x), x)
       a

    expsols(op, k, x) ==
      (degree op) = 1 =>
          firstOrder(multivariate(coefficient(op, 0), k),
                     multivariate(leadingCoefficient op, k), 0, x).basis
      ffactor ==> factorPolynomial$ExpressionFactorPolynomial(R, F)
      [xpart(expint(multivariate(h, k), x), x) for h in ricDsolve(op, ffactor)]

-- Finds solutions with rational logarithmic derivative
    ratlogsol(oper, sols, k, x) ==
      bas := [xpart(multivariate(h, k), x) for h in sols]
      degree(oper) = #bas => bas            -- all solutions are found already
      rec := ReduceOrder(oper, sols)
      le := expsols(rec.eq, k, x)
      int : List(F) := [xpart(multivariate(h, k), x) for h in rec.op]
      concat!([xpart(multivariate(h, k), x) for h in sols],
               [multint(e, int, x) for e in le])

    homosolve1(oper, sols, k, x) ==
      zero?(n := (degree(oper) - #sols)::N) => sols   -- all solutions found
      rec := ReduceOrder(oper, sols)
      int : List(F) := [xpart(h, x) for h in rec.op]
      concat!(sols, [multint(e, int, x) for e in norf1(rec.eq, k, x, n::N)])

-- if the coefficients are rational functions, then the equation does not
-- not have a proper 1st-order right factor over the rational functions
    norf1(op, k, x, n) ==
      (n = 1) => firstOrder(coefficient(op, 0), leadingCoefficient op, 0, x).basis
-- for order > 2, we check that the coeffs are still rational functions
      symbolIfCan(kmax vark(coefficients op, x)) case SY =>
        eq := ulodo(op, k)
        n = 2 => kovode(eq, k, x)
        eq := last factor1 eq        -- eq cannot have order 1
        degree(eq) = 2 =>
          empty?(bas := kovode(eq, k, x)) => empty()
          homosolve1(op, bas, k, x)
        empty()
      empty()

    kovode(op, k, x) ==
        b := coefficient(op, 1)
        a := coefficient(op, 2)
        c := coefficient(op, 0)
        ffactor ==> factorPolynomial$ExpressionFactorPolynomial(R, F)
        (u := kovacic(c, b, a, ffactor)) case "failed" => empty()
        p := map(z1 +-> multivariate(z1, k), u::UPUP)
        ba := multivariate(- b / a, k)
        -- if p has degree 2 (case 2), then it must be squarefree since the
        -- ode is irreducible over the rational functions, so the 2 roots of p
        -- are distinct and must yield 2 independent solutions.
        lcrf : List(RF) := [a, b, c]
        lc : List(F) := [multivariate(crf, k) for crf in lcrf]
        degree(p) = 2 =>
            zp := zerosOf p
            [simp_roots(xpart(expint(ba/(2::F) + e, x), x), lc) for e in zp]
        -- otherwise take 1 root of p and find the 2nd solution by
        -- reduction of order
        y1 := simp_roots(xpart(expint(ba / (2::F) + zeroOf p, x), x), lc)
        y2 := simp_roots(xpart(int(expint(ba, x) / y1^2, x), x), cons(y1, lc))
        [y1, y1*y2]

    solve(op : L, g : F, x : SY) ==
      empty?(l := vark(coefficients op, x)) => constDsolve(op, g, x)
      symbolIfCan(k := kmax l) case SY => rfSolve(op, g, k, x)
      has?(operator k, ALGOP) => algSolve(op, g, k, l, x)
      lastChance(op, g, x)

    ulodo(eq, k) ==
        op : LQ := 0
        while eq ~= 0 repeat
            op := op + monomial(univariate(leadingCoefficient eq, k), degree eq)
            eq := reductum eq
        op

-- left hand side has rational coefficients
    rfSolve(eq, g, k, x) ==
      op := ulodo(eq, k)
      empty? remove!(k, varselect(kernels g, x)) =>  -- i.e. rhs is rational
        rc := ratDsolve(op, univariate(g, k))
        rc.particular case "failed" =>                -- this implies g ~= 0
          doVarParams(eq, g, homosolve(eq, op, rc.basis, k, x), x)
        [multivariate(rc.particular::RF, k), homosolve(eq, op, rc.basis, k, x)]
      doVarParams(eq, g, homosolve(eq, op, ratDsolve(op, 0).basis, k, x), x)

    solve(op, g, x, a, y0) ==
      (u := solve(op, g, x)) case "failed" => "failed"
      hp := h := (u::REC).particular
      b := (u::REC).basis
      v : V := new(n := #y0, 0)
      kx : K := kernel x
      for i in minIndex v .. maxIndex v for yy in y0 repeat
        v.i := yy - eval(h, kx, a)
        h := diff h
      (sol := particularSolution(map!((f1 : F) : F +-> eval(f1, kx, a), wronskianMatrix(b, n)), v))
         case "failed" => "failed"
      for f in b for i in minIndex(s := sol::V) .. repeat
        hp := hp + s.i * f
      hp

    localmap(f, op) ==
        ans : L := 0
        while op ~= 0 repeat
            ans := ans + monomial(f leadingCoefficient op, degree op)
            op  := reductum op
        ans

-- left hand side has pure algebraic coefficients
    palgSolve(op, g, kx, k, x) ==
      rec := palgLODE(op, g, kx, k, x)   -- finds solutions in the coef. field
      rec.particular case "failed" =>
        doVarParams(op, g, homosolve1(op, rec.basis, k, x), x)
      [(rec.particular)::F, homosolve1(op, rec.basis, k, x)]

)abbrev package ODEEF ElementaryFunctionODESolver
++ Author: Manuel Bronstein
++ Date Created: 18 March 1991
++ Description:
++ \spad{ElementaryFunctionODESolver} provides the top-level
++ functions for finding closed form solutions of ordinary
++ differential equations and initial value problems.
++ Keywords: differential equation, ODE
ElementaryFunctionODESolver(R, F) : Exports == Implementation where
  R : Join(Comparable, PolynomialFactorizationExplicit, RetractableTo Integer,
          LinearlyExplicitOver Integer, CharacteristicZero)
  F : Join(AlgebraicallyClosedFunctionSpace R, TranscendentalFunctionCategory,
          PrimitiveFunctionCategory)

  N   ==> NonNegativeInteger
  OP  ==> BasicOperator
  SY  ==> Symbol
  K   ==> Kernel F
  EQ  ==> Equation F
  V   ==> Vector F
  M   ==> Matrix F
  UP  ==> SparseUnivariatePolynomial F
  P   ==> SparseMultivariatePolynomial(R, K)
  LEQ ==> Record(left : UP, right : F)
  NLQ ==> Record(dx : F, dy : F)
  REC ==> Record(particular : F, basis : List F)
  VEC ==> Record(particular : V, basis : List V)
  ROW ==> Record(index : Integer, row : V, rh : F)
  SYS ==> Record(mat : M, vec : V)
  U   ==> Union(REC, F, "failed")
  UU  ==> Union(F, "failed")
  OPDIFF ==> '%diff

  Exports ==> with
    solve : (M, V, SY) -> Union(VEC, "failed")
      ++ solve(m, v, x) returns \spad{[v_p, [v_1, ..., v_m]]} such that
      ++ the solutions of the system \spad{D y = m y + v} are
      ++ \spad{v_p + c_1 v_1 + ... + c_m v_m} where the \spad{c_i's} are
      ++ constants, and the \spad{v_i's} form a basis for the solutions of
      ++ \spad{D y = m y}.
      ++ \spad{x} is the dependent variable.
    solve : (M, SY) -> Union(List V, "failed")
      ++ solve(m, x) returns a basis for the solutions of \spad{D y = m y}.
      ++ \spad{x} is the dependent variable.
    solve : (List EQ, List OP, SY) -> Union(VEC, "failed")
      ++ solve([eq_1,...,eq_n], [y_1,...,y_n], x) returns either "failed"
      ++ or, if the equations form a fist order linear system, a solution
      ++ of the form \spad{[y_p, [b_1, ..., b_n]]} where \spad{h_p} is a
      ++ particular solution and \spad{[b_1, ...b_m]} are linearly independent
      ++ solutions of the associated homogenuous system.
      ++ error if the equations do not form a first order linear system
    solve : (List F, List OP, SY) -> Union(VEC, "failed")
      ++ solve([eq_1,...,eq_n], [y_1,...,y_n], x) returns either "failed"
      ++ or, if the equations form a fist order linear system, a solution
      ++ of the form \spad{[y_p, [b_1, ..., b_n]]} where \spad{h_p} is a
      ++ particular solution and \spad{[b_1, ...b_m]} are linearly independent
      ++ solutions of the associated homogenuous system.
      ++ error if the equations do not form a first order linear system
    solve : (EQ, OP, SY) -> U
      ++ solve(eq, y, x) returns either a solution of the ordinary differential
      ++ equation \spad{eq} or "failed" if no non-trivial solution can be found;
      ++ If the equation is linear ordinary, a solution is of the form
      ++ \spad{[h, [b1, ..., bm]]} where \spad{h} is a particular solution
      ++ and \spad{[b1, ...bm]} are linearly independent solutions of the
      ++ associated homogenuous equation \spad{f(x, y) = 0};
      ++ A full basis for the solutions of the homogenuous equation
      ++ is not always returned, only the solutions which were found;
      ++ If the equation is of the form {dy/dx = f(x, y)}, a solution is of
      ++ the form \spad{h(x, y)} where \spad{h(x, y) = c} is a first integral
      ++ of the equation for any constant \spad{c};
      ++ error if the equation is not one of those 2 forms;
    solve : (F, OP, SY) -> U
      ++ solve(eq, y, x) returns either a solution of the ordinary differential
      ++ equation \spad{eq} or "failed" if no non-trivial solution can be found;
      ++ If the equation is linear ordinary, a solution is of the form
      ++ \spad{[h, [b1, ..., bm]]} where \spad{h} is a particular solution and
      ++ and \spad{[b1, ...bm]} are linearly independent solutions of the
      ++ associated homogenuous equation \spad{f(x, y) = 0};
      ++ A full basis for the solutions of the homogenuous equation
      ++ is not always returned, only the solutions which were found;
      ++ If the equation is of the form {dy/dx = f(x, y)}, a solution is of
      ++ the form \spad{h(x, y)} where \spad{h(x, y) = c} is a first integral
      ++ of the equation for any constant \spad{c};
    solve : (EQ, OP, EQ, List F) -> UU
      ++ solve(eq, y, x = a, [y0, ..., ym]) returns either the solution
      ++ of the initial value problem \spad{eq, y(a) = y0, y'(a) = y1, ...}
      ++ or "failed" if the solution cannot be found;
      ++ error if the equation is not one linear ordinary or of the form
      ++ \spad{dy/dx = f(x, y)};
    solve : (F, OP, EQ, List F) -> UU
      ++ solve(eq, y, x = a, [y0, ..., ym]) returns either the solution
      ++ of the initial value problem \spad{eq, y(a) = y0, y'(a) = y1, ...}
      ++ or "failed" if the solution cannot be found;
      ++ error if the equation is not one linear ordinary or of the form
      ++ \spad{dy/dx = f(x, y)};

  Implementation ==> add
    import from ODEIntegration(R, F)
    import from IntegrationTools(R, F)
    import from NonLinearFirstOrderODESolver(R, F)

    getfreelincoeff : (F, K, SY) -> F
    getfreelincoeff1 : (F, K, List F) -> F
    getlincoeff     : (F, K) -> F
    getcoeff        : (F, K) -> UU
    parseODE        : (F, OP, SY) -> Union(LEQ, NLQ)
    parseLODE       : (F, List K, UP, SY) -> LEQ
    parseSYS        : (List F, List OP, SY) -> Union(SYS, "failed")
    parseSYSeq      : (F, List K, List K, List F, SY) -> Union(ROW, "failed")

    solve(diffeq : EQ, y : OP, x : SY) == solve(lhs diffeq - rhs diffeq, y, x)

    solve(leq : List EQ, lop : List OP, x : SY) ==
        solve([lhs eq - rhs eq for eq in leq], lop, x)

    solve(diffeq : EQ, y : OP, center : EQ, y0 : List F) ==
      solve(lhs diffeq - rhs diffeq, y, center, y0)

    solve(m : M, x : SY) ==
        (u := solve(m, new(nrows m, 0), x)) case "failed" => "failed"
        u.basis

    solve(m : M, v : V, x : SY) ==
        Lx := LinearOrdinaryDifferentialOperator(F, diff x)
        uu := solve(m, v, (z1, z2) +-> solve(z1, z2,
               x)$ElementaryFunctionLODESolver(R, F, Lx))$SystemODESolver(F, Lx)
        uu case "failed" => "failed"
        rec := uu::Record(particular : V, basis : M)
        [rec.particular, [column(rec.basis, i) for i in 1..ncols(rec.basis)]]

    solve(diffeq : F, y : OP, center : EQ, y0 : List F) ==
      a := rhs center
      kx : K := kernel(x := retract(lhs(center))@SY)
      (ur := parseODE(diffeq, y, x)) case NLQ =>
        not ((#y0) = 1) => error "solve: more than one initial condition!"
        rc := ur::NLQ
        (u := solve(rc.dx, rc.dy, y, x)) case "failed" => "failed"
        u::F - eval(u::F,  [kx, retract(y(x::F))@K], [a, first y0])
      rec := ur::LEQ
      p := rec.left
      Lx := LinearOrdinaryDifferentialOperator(F, diff x)
      op : Lx := 0
      while p ~= 0 repeat
        op := op + monomial(leadingCoefficient p, degree p)
        p  := reductum p
      solve(op, rec.right, x, a, y0)$ElementaryFunctionLODESolver(R, F, Lx)

    solve(leq : List F, lop : List OP, x : SY) ==
        (u := parseSYS(leq, lop, x)) case SYS =>
            rec := u::SYS
            solve(rec.mat, rec.vec, x)
        error "solve: not a first order linear system"

    solve(diffeq : F, y : OP, x : SY) ==
      (u := parseODE(diffeq, y, x)) case NLQ =>
        rc := u::NLQ
        (uu := solve(rc.dx, rc.dy, y, x)) case "failed" => "failed"
        uu::F
      rec := u::LEQ
      p := rec.left
      Lx := LinearOrdinaryDifferentialOperator(F, diff x)
      op : Lx := 0
      while p ~= 0 repeat
        op := op + monomial(leadingCoefficient p, degree p)
        p  := reductum p
      (uuu := solve(op, rec.right, x)$ElementaryFunctionLODESolver(R, F, Lx))
         case "failed" => "failed"
      uuu::REC

-- returns [M, v] s.t. the equations are D x = M x + v
    parseSYS(eqs, ly, x) ==
      (n := #eqs) ~= #ly => "failed"
      m : M := new(n, n, 0)
      v : V := new(n, 0)
      xx := x::F
      lf := [y xx for y in ly]
      lk0 : List(K) := [retract(f)@K for f in lf]
      lk1 : List(K) := [retract(differentiate(f, x))@K for f in lf]
      for eq in eqs repeat
          (u := parseSYSeq(eq,lk0,lk1,lf,x)) case "failed" => return "failed"
          rec := u::ROW
          setRow!(m, rec.index, rec.row)
          v(rec.index) := rec.rh
      [m, v]

    parseSYSeq(eq, l0, l1, lf, x) ==
      l := [k for k in varselect(kernels eq, x) | is?(k, OPDIFF)]
      empty? l or not empty? rest l or zero?(n := position(k := first l, l1)) =>
         "failed"
      c := getfreelincoeff1(eq, k, lf)
      eq := eq - c * k::F
      v : V := new(#l0, 0)
      for y in l0 for i in 1.. repeat
          ci := getfreelincoeff1(eq, y, lf)
          v.i := - ci / c
          eq := eq - ci * y::F
      [n, v, -eq]

-- returns either [p, g] where the equation (diffeq) is of the form p(D)(y) = g
-- or [p, q] such that the equation (diffeq) is of the form p dx + q dy = 0
    parseODE(diffeq, y, x) ==
      f := y(x::F)
      l : List(K) := [retract(f)@K]
      n : N := 2
      for k in varselect(kernels diffeq, x) | is?(k, OPDIFF) repeat
        if (m := height k) > n then n := m
      n := (n - 2)::N
-- build a list of kernels in the order [y^(n)(x), ..., y''(x), y'(x), y(x)]
      for i in 1..n repeat
        l := concat(retract(f := differentiate(f, x))@K, l)
      k : K   -- #$^#& compiler requires this line and the next one too...
      c : F
      while not(empty? l) and zero?(c := getlincoeff(diffeq, k := first l))
        repeat l := rest l
      empty? l or empty? rest l => error "parseODE: equation has order 0"
      diffeq := diffeq - c * (k::F)
      ny := name y
      l := rest l
      height(k) > 3 => parseLODE(diffeq, l, monomial(c, #l), ny)
      (u := getcoeff(diffeq, k := first l)) case "failed" => [diffeq, c]
      eqrhs := (d := u::F) * (k::F) - diffeq
      freeOf?(eqrhs, ny) and freeOf?(c, ny) and freeOf?(d, ny) =>
        [monomial(c, 1) + d::UP, eqrhs]
      [diffeq, c]

-- returns [p, g] where the equation (diffeq) is of the form p(D)(y) = g
    parseLODE(diffeq, l, p, y) ==
      not freeOf?(leadingCoefficient p, y) =>
        error "parseLODE: not a linear ordinary differential equation"
      d := degree(p)::Integer - 1
      for k in l repeat
        p := p + monomial(c := getfreelincoeff(diffeq, k, y), d::N)
        d := d - 1
        diffeq := diffeq - c * (k::F)
      freeOf?(diffeq, y) => [p, - diffeq]
      error "parseLODE: not a linear ordinary differential equation"

    getfreelincoeff(f, k, y) ==
      freeOf?(c := getlincoeff(f, k), y) => c
      error "getfreelincoeff: not a linear ordinary differential equation"

    getfreelincoeff1(f, k, ly) ==
      c := getlincoeff(f, k)
      for y in ly repeat
         not freeOf?(c, y) =>
            error "getfreelincoeff: not a linear ordinary differential equation"
      c

    getlincoeff(f, k) ==
      (u := getcoeff(f, k)) case "failed" =>
        error "getlincoeff: not an appropriate ordinary differential equation"
      u::F

    getcoeff(f, k) ==
      (r := retractIfCan(univariate(denom f, k))@Union(P, "failed"))
        case "failed" or degree(p := univariate(numer f, k)) > 1 => "failed"
      coefficient(p, 1) / (r::P)

--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--All rights reserved.
--
--Redistribution and use in source and binary forms, with or without
--modification, are permitted provided that the following conditions are
--met:
--
--    - Redistributions of source code must retain the above copyright
--      notice, this list of conditions and the following disclaimer.
--
--    - Redistributions in binary form must reproduce the above copyright
--      notice, this list of conditions and the following disclaimer in
--      the documentation and/or other materials provided with the
--      distribution.
--
--    - Neither the name of The Numerical ALgorithms Group Ltd. nor the
--      names of its contributors may be used to endorse or promote products
--      derived from this software without specific prior written permission.
--
--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

-- Compile order for the differential equation solver:
-- oderf.spad  odealg.spad  nlode.spad  nlinsol.spad  riccati.spad
-- kovacic.spad  lodof.spad  odeef.spad
