odeef.spad

)abbrev package ODESYS SystemODESolver
++ Author: Manuel Bronstein
++ Date Created: 11 June 1991
++ Description: SystemODESolver provides tools for triangulating
++ and solving some systems of linear ordinary differential equations.
++ Keywords: differential equation, ODE, system
SystemODESolver(F, LO) : Exports == Implementation where
  F : Field
  LO : LinearOrdinaryDifferentialOperatorCategory F

  N   ==> NonNegativeInteger
  Z   ==> Integer
  MF  ==> Matrix F
  M   ==> Matrix LO
  V   ==> Vector F
  UF  ==> Union(F, "failed")
  UV  ==> Union(V, "failed")
  REC ==> Record(mat : M, vec : V)
  FSL ==> Record(particular : UF, basis : List F)
  VSL ==> Record(particular : UV, basis : List V)
  SOL ==> Record(particular : F, basis : List F)
  USL ==> Union(SOL, "failed")
  ER  ==> Record(C : MF, g : V, eq : LO, rh : F)
  ER2 ==> Record(C : MF, lg : List V, eq : LO, lrh : List F)
  Param_Rec_F ==> Record(ratpart : F, coeffs : Vector F)
  Param_Rec_V ==> Record(ratpart : V, coeffs : Vector F)
  FPL ==> Record(particular : List Param_Rec_F, basis : List F)
  VPL ==> Record(particular : List Param_Rec_V, basis : List V)

  Exports ==> with
    triangulate : (MF, V) -> Record(A : MF, eqs : List ER)
      ++ triangulate(M, v) returns
      ++ \spad{A, [[C_1, g_1, L_1, h_1], ..., [C_k, g_k, L_k, h_k]]}
      ++ such that under the change of variable \spad{y = A z}, the first
      ++ order linear system \spad{D y = M y + v} is uncoupled as
      ++ \spad{D z_i = C_i z_i + g_i} and each \spad{C_i} is a companion
      ++ matrix corresponding to the scalar equation \spad{L_i z_j = h_i}.
    triangulate : (MF, List V) ->  Record(A : MF, eqs : List ER2)
      ++ triangulate(A, lv) is a parametric version of triangulate(A, v).
    triangulate : (M, V) -> REC
      ++ triangulate(m, v) returns \spad{[m_0, v_0]} such that \spad{m_0}
      ++ is upper triangular and the system \spad{m_0 x = v_0} is equivalent
      ++ to \spad{m x = v}.
    triangulate : (M, List V) -> Record(mat : M, vecs : List V)
      ++ triangulate(m, [v1, ..., vn]) returns  \spad{[m_0, [w1, ..., wn]]}
      ++ such that for any constant \spad{c1, ..., cn} the system
      ++ \spad{m_0 x = c1*w1 + ... + cn*wn} is equivalent to
      ++ to \spad{m x = c1*v1 + ... + cn*vn}
    solve : (MF,V,(LO,F)->USL) -> Union(Record(particular:V, basis:MF), "failed")
      ++ solve(m, v, solve) returns \spad{[v_p, bm]} such that
      ++ the solutions in \spad{F} of the system \spad{D x = m x + 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} are columns of \spad{bm} and
      ++ form a basis for the solutions of \spad{D x = m x}.
      ++ Argument \spad{solve} is a function for solving a single linear
      ++ ordinary differential equation in \spad{F}.
    solve : (MF, List V, (LO, List F) -> FPL) -> VPL
      ++ solve(m, lv, solve) is a parametric version of
      ++ solve(m, v, solve)
    solveInField : (M, V, (LO, F) -> FSL) -> VSL
      ++ solveInField(m, v, solve) returns \spad{[[v_1, ..., v_m], v_p]} such that
      ++ the solutions in \spad{F} of the system \spad{m x = 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{m x = 0}.
      ++ Argument \spad{solve} is a function for solving a single linear
      ++ ordinary differential equation in \spad{F}.
    solveInField : (M, List V, (LO, List F) -> FPL) -> VPL
      ++ solveInField(m, lv, solve) is a parametric version of
      ++ solveInField(m, v, solve)

  Implementation ==> add
    import from PseudoLinearNormalForm F
    import from LinearCombinationUtilities(F, SparseUnivariatePolynomial(F))

    M2F         : M -> Union(MF, "failed")

    diff := D()$LO

    solve(mm : MF, lv : List V, solf : (LO, List F) -> FPL) ==
        rec  := triangulate(mm, lv)
        nv := #lv
        mA := rec.A
        n := ncols(mA)
        k : N := 0             -- sum of sizes of visited companionblocks
        i : N := 0             -- number of companionblocks
        cb : List V := [new(nv, 0)$V for v in lv]
        pl : List V := [new(n, 0)$V for v in lv]
        base_vecs : List V := []
        l : Integer
        for i in 1..nv for bv in cb repeat
            bv(i) := 1
        for e in rec.eqs repeat
            crh := [lin_comb(bv, e.lrh) for bv in cb]
            u := solf(e.eq, crh)
            np1 := u.particular
            ncb := [lin_comb(be.coeffs, cb) for be in np1]
            nn := nrows(e.C) -- size of active companionblock
            for s in u.basis repeat
                base_vec : V := new(n, 0)
                base_vec(k + 1) := s
                for l in 2..nn repeat
                    base_vec(k + l) := diff base_vec(k + l - 1)
                base_vecs := cons(base_vec, base_vecs)
            npl := [lin_comb(be.coeffs, pl) for be in np1]
            for be in np1 for np in npl for bv in ncb repeat
                g1 := lin_comb(bv, e.lg)
                np(k + 1) := be.ratpart
                for l in 2..nn repeat
                    np(k + l) := diff np(k + l - 1) - g1(l - 1)
            k := k + nn
            pl := npl
            cb := ncb
        base_vecs := reverse!(base_vecs)
        [[[mA*np, bv] for np in pl for bv in cb],
         [mA*bvec for bvec in base_vecs]]

    USL_to_FPL(u : USL) : FPL ==
        u case "failed" => [[], []]
        us := u@SOL
        [[[us.particular, new(1, 1)]], us.basis]

    solve(mm : MF, v : V, solf : (LO,F)->USL) ==
        res1 := solve(mm, [v], (lo, lf) +-> USL_to_FPL(solf(lo, first(lf))))
        part := res1.particular
        empty?(part) => "failed"
        part1 := first(part)
        c1inv := inv((part1.coeffs)(1))
        s1 := c1inv*part1.ratpart
        bm := matrix([entries(bv) for bv in res1.basis])
        [s1, transpose(bm)]

    triangulate(m : MF, lv : List V) ==
      k : N := 0       -- sum of companion-dimensions
      rat := normalForm(m, 1, (f1 : F) : F +-> - diff f1)
      l   := companionBlocks(rat.R, [rat.Ainv * v for v in lv])
      ler : List(ER2) := []
      for er in l repeat
        n := nrows(er.C)         -- dimension of this companion vectorspace
        op : LO := 0               -- compute homogeneous equation
        for j in 0..n-1 repeat op := op + monomial((er.C)(n, j + 1), j)
        op := monomial(1, n) - op
        lh : List F := []
        for g in er.lg repeat
            sum : V := new(n::N, 0)    -- compute inhomogen Vector (25)
            for j in 1..n-1 repeat sum(j+1) := diff(sum(j)) + g(j)
            h0 : F := 0                 -- compute inhomogeneity (26)
            for j in 1..n repeat h0 := h0 - (er.C)(n, j) * sum j
            h0 := h0 + diff(sum(n)) + g(n)
            lh := cons(h0, lh)
        lh := reverse!(lh)
        ler := concat([er.C, er.lg, op, lh], ler)
        k := k + n
      [rat.A, ler]

    triangulate(m : MF, v : V) ==
        res1 := triangulate(m, [v])
        ler : List(ER) := []
        for er2 in res1.eqs repeat
            ler := cons([er2.C, first(er2.lg), er2.eq, first(er2.lrh)], ler)
        ler := reverse!(ler)
        [res1.A, ler]

    import from OrePolynomialMatrixOperations(F, LO)

    solveInField(m : M, lv : List V, solf : (LO, List F) -> FPL) ==
      ((n := nrows m) = ncols m) and
         ((u := M2F(diagonalMatrix [diff for i in 1..n] - m)) case MF) =>
             solve(u@MF, lv, solf)
      rec := solve(m, 0, lv, solf)
      rec case "failed" => error "solveInField: system is underdeterminded"
      rec::VPL

    M2F m ==
        mf : MF := new(nrows m, ncols m, 0)
        for i in minRowIndex m .. maxRowIndex m repeat
            for j in minColIndex m .. maxColIndex m repeat
                (u := retractIfCan(m(i, j))@Union(F, "failed")) case "failed" =>
                     return "failed"
                mf(i, j) := u@F
        mf

    triangulate(m : M, lv : List V) == rowEchelon(m, 0, lv)

    triangulate(m : M, v : V) ==
        res1 := triangulate(m, [v])
        [res1.mat, first(res1.vecs)]

)abbrev package ODERED ReduceLODE
++ Author: Manuel Bronstein
++ Date Created: 19 August 1991
++ Description: Elimination of an algebraic from the coefficients
++ of a linear ordinary differential equation.
ReduceLODE(F, L, UP, A, LO) : Exports == Implementation where
  F : Field
  L : LinearOrdinaryDifferentialOperatorCategory F
  UP : UnivariatePolynomialCategory F
  A : MonogenicAlgebra(F, UP)
  LO : LinearOrdinaryDifferentialOperatorCategory A

  V ==> Vector F
  M ==> Matrix L

  Exports ==> with
    reduceLODE : (LO, A) -> Record(mat : M, vec : V)
      ++ reduceLODE(op, g) returns \spad{[m, v]} such that
      ++ any solution in \spad{A} of \spad{op z = g}
      ++ is of the form \spad{z = (z_1, ..., z_m) . (b_1, ..., b_m)} where
      ++ the \spad{b_i's} are the basis of \spad{A} over \spad{F} returned
      ++ by \spadfun{basis}() from \spad{A}, and the \spad{z_i's} satisfy the
      ++ differential system \spad{M.z = v}.
    reduceLODE : (LO, List A) -> Record(mat : M, vecs : List V)
      ++ reduceLODE(op, [g1, ..., gn]) returns \spad{[m, [v1, ..., vn]]}
      ++ such that any solution in \spad{A} of
      ++ \spad{op z = c1*g1 + ... + cn*gn} where ci are constants
      ++ satisfy the differential system \spad{M.z = c1*v1 + ... + cn*vn}

  Implementation ==> add
    matF2L : Matrix F -> M

    diff := D()$L

-- coerces a matrix of elements of F into a matrix of (order 0) L.O.D.O's
    matF2L m ==
      map((f1 : F) : L +-> f1::L, m)$MatrixCategoryFunctions2(F, V, V, Matrix F,
                                                L, Vector L, Vector L, M)

-- This follows the algorithm and notation of
--  "The Risch Differential Equation on an Algebraic Curve", M. Bronstein,
-- in 'Proceedings of ISSAC '91', Bonn, BRD, ACM Press, pp.241-246, July 1991.
    get_sys(l : LO) : M ==
-- md is the basic differential matrix (D x I + Dy)
      md := matF2L transpose derivationCoordinates(basis(), (f1 : F) : F +-> diff f1)
      for i in minRowIndex md .. maxRowIndex md
        for j in minColIndex md .. maxColIndex md repeat
          md(i, j) := diff + md(i, j)
-- mdi will go through the successive powers of md
      mdi := copy md
      sys := matF2L(regularRepresentation coefficient(l, 0))
      for i in 1..degree l repeat
        sys := sys +
                matF2L(regularRepresentation coefficient(l, i)) * mdi
        mdi := md * mdi
      sys

    reduceLODE(l : LO, g : A) ==
        [get_sys(l), coordinates g]

    reduceLODE(l : LO, lg : List(A)) ==
        [get_sys(l), [coordinates g for g in lg]]

)abbrev package ODEPAL PureAlgebraicLODE
++ Author: Manuel Bronstein
++ Date Created: 21 August 1991
++ Description: In-field solution of an linear ordinary differential equation,
++ pure algebraic case.
PureAlgebraicLODE(F, UP, UPUP, R) : Exports == Implementation where
  F   : Join(Field, CharacteristicZero,
             RetractableTo Integer, RetractableTo Fraction Integer)
  UP  : UnivariatePolynomialCategory F
  UPUP : UnivariatePolynomialCategory Fraction UP
  R   : FunctionFieldCategory(F, UP, UPUP)

  RF  ==> Fraction UP
  V   ==> Vector RF
  U   ==> Union(R, "failed")
  REC ==> Record(particular: Union(RF, "failed"), basis: List RF)
  L   ==> LinearOrdinaryDifferentialOperator1 R
  LQ  ==> LinearOrdinaryDifferentialOperator1 RF
  Param_Rec_R ==> Record(ratpart : R, coeffs : Vector(F))
  L_Param_R ==> List Param_Rec_R

  Exports ==> with
    algDsolve : (L, R) -> Record(particular : U, basis : List R)
      ++ algDsolve(op, g) returns \spad{["failed", []]} if the equation
      ++ \spad{op y = g} has no solution in \spad{R}. Otherwise, it returns
      ++ \spad{[f, [y1, ..., ym]]} where \spad{f} is a particular rational
      ++ solution and the \spad{y_i's} form a basis for the solutions in
      ++ \spad{R} of the homogeneous equation.
    algDsolve : (L, List R) -> Record(particular : L_Param_R, basis : List R)
      ++ algDsolve(op, lg) is a parametric version of
      ++ algDsolve(op, g)

  Implementation ==> add
    import from RationalLODE(F, UP)
    import from SystemODESolver(RF, LQ)
    import from ReduceLODE(RF, LQ, UPUP, R, L)

    Param_Rec_F ==> Record(ratpart : RF, coeffs : Vector RF)
    FPL ==> Record(particular : List Param_Rec_F, basis : List RF)

    rat_solve(l : LQ, lf : List RF) : FPL ==
        sol := ratDsolve(l, lf)
        bas := sol.basis
        ker := nullSpace(sol.mat)
        empty?(ker) => [[], []]
        nn := #lf
        nb := #bas
        if nb ~= ncols(sol.mat) then
            error "rat_solve: nb ~= ncols(sol.mat)"
        m1 := matrix([entries(kv) for kv in ker]$List(List(F)))
        nn := #lf
        nc := ncols(m1)
        m3 := rowEchelon(m1)
        nr := nrows(m3)
        j : Integer := 1
        i0 : Integer := nr + 1
        sl : List Param_Rec_F := []
        for i in 1..nr repeat
            while j <= nn and m3(i, j) = 0 repeat j := j + 1
            if j > nn then
                i0 := i
                break
            cv := new(nn, 0)$V
            for k in 1..nn repeat
                cv(k) := m3(i, k)::UP::RF
            s : RF := 0
            for k in 1..nc for bf in bas repeat
                s := s + m3(i, k)::UP*bf
            sl := cons([s, cv], sl)
        bl : List RF := []
        for i in i0..nr repeat
            s : RF := 0
            for k in 1..nc for bf in bas repeat
                s := s + m3(i, k)::UP*bf
            bl := cons(s, bl)
        [sl, bl]

    RF_to_F(rf : RF) : F == ground(retract(rf)@UP)

    V_to_VF(v : V) : Vector(F) ==
        map(RF_to_F, v)$VectorFunctions2(RF, F)

    algDsolve(l : L, lg : List R) ==
        rec := reduceLODE(l, lg)
        sol := solveInField(rec.mat, rec.vecs, rat_solve)
        bas : List(R) := [represents v for v in sol.basis]
        part : L_Param_R := [[represents(be.ratpart), V_to_VF(be.coeffs)]
                              for be in sol.particular]
        [part, bas]

    algDsolve(l : L, g : R) ==
        rec1 := algDsolve(l, [g])
        bas := rec1.basis
        empty?(rec1.particular) => ["failed", bas]
        part1 : Param_Rec_R := first(rec1.particular)
        c1inv := inv((part1.coeffs)(1))
        s0 : R := part1.ratpart
        s1 := c1inv::UP::RF*s0
        [s1, bas]

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

)abbrev package NODE1 NonLinearFirstOrderODESolver
++ Author: Manuel Bronstein
++ Date Created: 2 September 1991
++ Description: NonLinearFirstOrderODESolver provides a function
++ for finding closed form first integrals of nonlinear ordinary
++ differential equations of order 1.
++ Keywords: differential equation, ODE
NonLinearFirstOrderODESolver(R, F) : Exports == Implementation where
  R : Join(Comparable, PolynomialFactorizationExplicit, RetractableTo Integer,
          LinearlyExplicitOver Integer, CharacteristicZero)
  F : Join(AlgebraicallyClosedFunctionSpace R, TranscendentalFunctionCategory,
          PrimitiveFunctionCategory)

  N   ==> NonNegativeInteger
  Q   ==> Fraction Integer
  UQ  ==> Union(Q, "failed")
  OP  ==> BasicOperator
  SY  ==> Symbol
  K   ==> Kernel F
  U   ==> Union(F, "failed")
  P   ==> SparseMultivariatePolynomial(R, K)
  REC ==> Record(coef : Q, logand : F)
  SOL ==> Record(particular : F, basis : List F)
  BER ==> Record(coef1 : F, coefn : F, exponent : N)

  Exports ==> with
    solve : (F, F, OP, SY) -> U
      ++ solve(M(x, y), N(x, y), y, x) returns \spad{F(x, y)} such that
      ++ \spad{F(x, y) = c} for a constant \spad{c} is a first integral
      ++ of the equation \spad{M(x, y) dx + N(x, y) dy  = 0}, or
      ++ "failed" if no first-integral can be found.

  Implementation ==> add
    import from ODEIntegration(R, F)
    import from ElementaryFunctionODESolver(R, F)    -- recursive dependency!

    checkBernoulli   : (F, F, K) -> Union(BER, "failed")
    solveBernoulli   : (BER, OP, SY, F) -> Union(F, "failed")
    checkRiccati     : (F, F, K) -> Union(List F, "failed")
    solveRiccati     : (List F, OP, SY, F) -> Union(F, "failed")
    partSolRiccati   : (List F, OP, SY, F) -> Union(F, "failed")
    integratingFactor : (F, F, F, SY, SY) -> U

    unk    := new()$SY
    kunk : K := kernel unk

    solve(m, n, y, x) ==
-- first replace the operator y(x) by a new symbol z in m(x, y) and n(x, y)
      lk : List(K) := [retract(yx := y(x::F))@K]
      lv : List(F) := [kunk::F]
      mm := eval(m, lk, lv)
      nn := eval(n, lk, lv)
-- put over a common denominator (to balance m and n)
      d := lcm(denom mm, denom nn)::F
      mm := d * mm
      nn := d * nn
-- look for an integrating factor mu
      (u := integratingFactor(mm, nn, d, unk, x)) case F =>
        mu := u@F
        mm := mm * mu
        nn := nn * mu
        eval(int(mm, x) + int(nn-int(differentiate(mm, unk), x), unk), [kunk], [yx])
-- check for Bernoulli equation
      (w := checkBernoulli(m, n, k1 := first lk)) case BER =>
        solveBernoulli(w@BER, y, x, yx)
-- check for Riccati equation
      (v := checkRiccati(m, n, k1)) case List(F) =>
        solveRiccati(v@List(F), y, x, yx)
      "failed"

-- look for an integrating factor
    integratingFactor(m, n, den, y, x) ==
-- check first for exactness
      zero?(d := differentiate(m, y) - differentiate(n, x)) => 1
      zero?(differentiate(m/den, y) - differentiate(n/den, x)) => 1/den
-- look for an integrating factor involving x only
      not member?(y, variables(f := d / n)) => expint(f, x)
-- look for an integrating factor involving y only
      not member?(x, variables(f := - d / m)) => expint(f, y)
-- room for more techniques later on (e.g. Prelle-Singer etc...)
      "failed"

-- check whether the equation is of the form
--    dy/dx + p(x)y + q(x)y^N = 0   with N > 1
-- i.e. whether m/n is of the form  p(x) y + q(x) y^N
-- returns [p, q, N] if the equation is in that form
    checkBernoulli(m, n, ky) ==
      r := denom(f := m / n)::F
      (not freeOf?(r, y := ky::F))
          or (d := degree(p := univariate(numer f, ky))) < 2
            or degree(pp := reductum p) ~= 1 or reductum(pp) ~= 0
              or (not freeOf?(a := (leadingCoefficient(pp)::F), y))
                or (not freeOf?(b := (leadingCoefficient(p)::F), y)) => "failed"
      [a / r, b / r, d]

-- solves the equation dy/dx + rec.coef1 y + rec.coefn y^rec.exponent = 0
-- the change of variable v = y^{1-n} transforms the above equation to
--  dv/dx + (1 - n) p v + (1 - n) q = 0
    solveBernoulli(rec, y, x, yx) ==
      n1 := 1 - rec.exponent::Integer
      deq := differentiate(yx, x) + n1 * rec.coef1 * yx + n1 * rec.coefn
      sol := solve(deq, y, x)::SOL          -- can always solve for order 1
-- if v = vp + c v0 is the general solution of the linear equation, then
-- the general first integral for the Bernoulli equation is
-- (y^{1-n} - vp) / v0  =   c   for any constant c
      (yx^n1 - sol.particular) / first(sol.basis)

-- check whether the equation is of the form
--    dy/dx + q0(x) + q1(x)y + q2(x)y^2 = 0
-- i.e. whether m/n is a quadratic polynomial in y.
-- returns the list [q0, q1, q2] if the equation is in that form
    checkRiccati(m, n, ky) ==
      q := denom(f := m / n)::F
      (not freeOf?(q, y := ky::F)) or degree(p := univariate(numer f, ky)) > 2
         or (not freeOf?(a0 := (coefficient(p, 0)::F), y))
           or (not freeOf?(a1 := (coefficient(p, 1)::F), y))
             or (not freeOf?(a2 := (coefficient(p, 2)::F), y)) => "failed"
      [a0 / q, a1 / q, a2 / q]

-- solves the equation dy/dx + l.1 + l.2 y + l.3 y^2 = 0
    solveRiccati(l, y, x, yx) ==
-- get first a particular solution
      (u := partSolRiccati(l, y, x, yx)) case "failed" => "failed"
-- once a particular solution yp is known, the general solution is of the
-- form  y = yp + 1/v  where v satisfies the linear 1st order equation
-- v' - (l.2 + 2 l.3 yp) v = l.3
      deq := differentiate(yx, x) - (l.2 + 2 * l.3 * u@F) * yx - l.3
      gsol := solve(deq, y, x)::SOL         -- can always solve for order 1
-- if v = vp + c v0 is the general solution of the above equation, then
-- the general first integral for the Riccati equation is
--  (1/(y - yp) - vp) / v0  =   c   for any constant c
      (inv(yx - u::F) - gsol.particular) / first(gsol.basis)

-- looks for a particular solution of dy/dx + l.1 + l.2 y + l.3 y^2 = 0
    partSolRiccati(l, y, x, yx) ==
-- we first do the change of variable y = z / l.3, which transforms
-- the equation into  dz/dx + l.1 l.3 + (l.2 - l.3'/l.3) z + z^2 = 0
      q0 := l.1 * (l3 := l.3)
      q1 := l.2 - differentiate(l3, x) / l3
-- the equation dz/dx + q0 + q1 z + z^2 = 0 is transformed by the change
-- of variable z = w'/w into the linear equation w'' + q1 w' + q0 w = 0
      lineq := differentiate(yx, x, 2) + q1 * differentiate(yx, x) + q0 * yx
-- should be made faster by requesting a particular nonzero solution only
      (not((gsol := solve(lineq, y, x)) case SOL))
                              or empty?(bas := (gsol@SOL).basis) => "failed"
      differentiate(first bas, x) / (l3 * first bas)

)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