# **************************************************************************
# *       T O P   L E V E L   R A T L O D E   I N T E R F A C E            *
# **************************************************************************
#
# Copyright, Manuel Bronstein, January 1993, bronstei@inf.ethz.ch
#
# ratlode(eq, z [,'basis'])
# INPUT: eq -- a linear differential equation with rational coefficients
#	 z  -- an expression of the form f(x) (the unknown)
#	 'basis' -- optional flag
# OUTPUT:
#	  - without 'basis':
#		The generic form of the rational solutions.
#		The arbitrary constants are named _Cn, _C{n+1}, etc...
#	  - with 'basis':
#		- for homogeneous equations: a basis for the rational solutions
#		- for inhomogeneous equations: a particular solution and a
#				             basis for the homogeneous equation.
#
# ratlode := proc(eq:equation, z:anyfunc(name))
ratlode := proc(eq, z)
	local g, f, x, a3;

if not type(eq,'equation') and not type(eq,'algebraic') then
ERROR(`1st argument must be an (ordinary differential) equation`,eq) fi;
if not type(z,'anyfunc(name)') then
ERROR(`2nd argument must be a function of the form y(x)`,z) fi;

	f := diffeq_coeffs(eq, z, `g`);
	x := op(1, z);
	if nargs = 2 then RETURN(`dsolve/ratlode/solve`(f, g, x)); fi;
	if nargs = 3 then
		a3 := args[3];
		if a3 = 'basis' then RETURN(`dsolve/ratlode/basis`(f, g, x));fi;
		ERROR(`rat_dsolve: improper 3rd argument`);
	fi;
	end:

# isderivative(z, y)
# INPUT: z  --  an expression
#	 y  --  an expression of the form f(x)
# OUTPUT: z if z is a derivative of y (including the zero'th), NULL otherwise.
#
isderivative := proc(z, y)
	if (z = y) or (type(z, function) and op(0, z) = 'diff') then z; fi
	end:

# get_diff_coeff(n, cc, tt, y, x, lc)
# INPUT: n  --  a nonnegative integer
#	 cc --  the coefficients of the differential equation
#	 tt --  the terms of the differential equation
#	 y  --  an expression of the form f(x) (the unknown)
#	 x  --  a variable
# OUTPUT: the coefficient of y^(n) is the normalized differential equation
#
get_diff_coeff := proc(n, cc, tt, y, x)
	local dy, m;

	if n = 0 then dy := y; else dy := diff(y, x$n); fi;
	if member(dy, tt, m) then cc[m]; else 0; fi;
	end:

# diffeq_coeffs(eq, y, g)
# INPUT: eq -- a linear differential equation with rational coefficients
#	 y  -- an expression of the form f(x) (the unknown)
#	 g  -- a name
# OUTPUT: the list of coefficients of the polynomial differential equation,
#	  g is set to the right-hand-side
#
diffeq_coeffs := proc(eq, y, g)
	local neq, diffvars, x, cc, tt, m, i, t, h;

	# tt := 'tt';
	x := op(1, y);
	if type(eq, `=`) then neq := lhs(eq) - rhs(eq); else neq := eq; fi;
	diffvars := map(isderivative, indets(neq), y);
	if not(type(neq, linear(diffvars))) then
		ERROR(`diffeq_coeffs: not a linear ode`); fi;
	h := - subs({seq(t = 0, t = diffvars)}, neq);
	neq := normal(neq - h);
	g := normal(denom(neq) * h);
	neq := numer(neq);
	cc := [coeffs(collect(neq, diffvars), diffvars, tt)];
	tt := [tt];
	m := nops(diffvars) - 1;
	[seq(get_diff_coeff(i, cc, tt, y, x), i = 0..m)];
	end:

# `dsolve/ratlode/solve`([p0,...,p_n], g, x)
# INPUT: [p0,...,p_n] -- list of polynomials in x
#	 g  --  a fraction in x
#        x  --  a variable
# OUTPUT: [y, {v1,...,vm}] where y is a generic solution of
#	  sum_{i=0}^n p_i y^(i) = g
#	  and v1,...,vm are the arbitrary parameters
#
`dsolve/ratlode/solve` := proc(p, g, x)
	local d, b, vars, y, yy, ly, i, n, sol;

        n := nops(p);
        if (p[n] = 0) then ERROR(`solve: improper differential equation`); fi;
	d := `dsolve/ratlode/denom`(p, g, x);
	if d = 0 then RETURN(NULL); fi;
	b := `dsolve/ratlode/bound`(p, g, x) + degree(d, x);
        assign('_C','_C');
        vars := [seq(_C[i],i=0..b)];
	y := convert([seq(_C[i]*x^i,i=0..b)],`+`) / d;
	yy := y;
	ly := 0;
	for i to n do
		ly := ly + p[i] * yy;
		yy := diff(yy, x);
	od;
	n := expand(numer(normal(ly - g)));
	sol := solve({coeffs(n, x)}, {op(vars)});
	if sol = NULL then sol;
	else [subs(sol, y), indets(map(rhs, sol))]; fi
end:

# balfact(a, b1,..., bn, x)
# INPUT: a -- polynomial in x
#        b1,...,bn -- polynomials in x
#        x  --  a variable
# OUTPUT: a list [c, [[a1, i1],...,[am, im]]] such that a = c a1^i1 ... am^im
#         is a balanced factorisation of a w.r.t. b1,...,bn and c is the
#         content of a.
#
`dsolve/ratlode/balfact` := proc(a)
	local l, lf, f, x;

        if nargs < 3 then ERROR(`balfact: expecting at least 3 arguments`) fi;
        x := args[nargs];
	l := readlib(sqrfree)(a);
	lf := [args[2..nargs-1]];
	[l[1], [seq(op(`dsolve/ratlode/balmklist`(f[1], lf, x, f[2])),
			f = l[2])]];
end:

# balmklist(a, [b1,...,bn], x, q)
# INPUT: a -- monic squarefree polynomial in x
#        [b1,...,bn] -- list of polynomials in x
#        x  --  a variable
#        q  --  a positive integer
# OUTPUT: a list [[a1, q],..., [am, q]] such that a = a1 ... am
#         is a balanced factorisation of a w.r.t. b1,...,bn
#
`dsolve/ratlode/balmklist` := proc(a, b, x, q)
	local l, i;

	l := `dsolve/ratlode/balsqfr`(a, b, x);
	[seq([l[i], q], i = 1..nops(l))];
end:

# balsqfr(a, [b1,..., bn], x)
# INPUT: a -- monic squarefree polynomial in x
#        [b1,...,bn] -- list of polynomials in x
#        x  --  a variable
# OUTPUT: a list [a1,..., am] such that a = a1 ... am
#         is a balanced factorisation of a w.r.t. b1,...,bn
#
`dsolve/ratlode/balsqfr` := proc(a, b, x)
	local n, b1, l, i;

	n := nops(b);
	b1 := b[1];
	if n = 1 then `dsolve/ratlode/balsqfr1`(a, b1, x);
	else
		l := `dsolve/ratlode/balsqfr`(a, [b[2..n]], x);
		[seq(op(`dsolve/ratlode/balsqfr1`(l[i], b1, x)),
			 i = 1..nops(l))]
	fi;
end:

# balsqfr1(a, b, x)
# INPUT: a -- monic squarefree polynomial in x
#        b -- polynomial in x
#        x  --  a variable
# OUTPUT: a list [a1,...,an] such that a = a1 ... an
#         is a balanced factorisation of a w.r.t. b
#
`dsolve/ratlode/balsqfr1` := proc(a, b, x)
	local g, bbar, abar, l;

	g := gcdex(a, b, x);
	if b = 0 or degree(g, x) = 0 then [a];
	else
		bbar := `dsolve/ratlode/divide_out`(g, b, x);
		abar := quo(a, g, x);
		l := `dsolve/ratlode/balsqfr1`(g, bbar, x);
		if degree(abar, x) = 0 then l; else [abar, op(l)]; fi;
	fi;
end:

# `dsolve/ratlode/basis`([p0,...,p_n], g, x)
# INPUT: [p0,...,p_n] -- list of polynomials in x, p_n <> 0
#	 g  --  a fraction in x
#        x  --  a variable
# OUTPUT:
#	- for homogeneous equations: a basis for the rational solutions
#	- for inhomogeneous equations: a particular solution and a
#			             basis for the homogeneous equation.
#
`dsolve/ratlode/basis` := proc(p, g, x)
	local c, y, yp, gens, yh, sol;

	sol := `dsolve/ratlode/solve`(p, g, x);
	if sol = NULL then RETURN({}); fi;
	y := sol[1];
	gens := sol[2];
	yp := `dsolve/ratlode/zerosubs`(y, gens);
	y := simplify(y - yp);
	yh := {seq(`dsolve/ratlode/get_basis`(y, gens, c), c = gens)};
	if yp = 0 then
		if yh = {} then {0}; else yh; fi;
	else [yp, yh];
	fi
end:

# `dsolve/ratlode/bound`([p_0,...,p_n], g, x)
# INPUT: [p0,...,p_n] -- list of polynomials in x
#	 g  --  a fraction in x
#        x  --  a variable
# OUTPUT: a bound on the degree of any solution of
#	  sum_{i=0}^{n-1} p_i y^(i) = g

`dsolve/ratlode/bound` := proc(p, g, x)
	local n, mu, lam, eq, z, beta, dd, rh;

	n := nops(p);
	mu := `dsolve/ratlode/inf_mulam`(p, x, 'lam');
	eq := `dsolve/ratlode/inf_ind_eq`(p, x, lam, 'z');
	beta := `dsolve/ratlode/boundzero`(eq, z);
	if beta < - n then dd := - beta; else dd := n; fi;
	if g = 0 then dd;
	else
		rh := degree(numer(g), x) - degree(denom(g), x)
			+ degree(p[n], x) - mu;
		if rh > dd then rh; else dd; fi
	fi
end:

# boundzero(p, x)
# INPUT: p  --  a polynomial in x
#        x  --  a variable
# OUTPUT: either 0 if p has no negative integer roots, or its smallest
#	  negative integer root.
#
`dsolve/ratlode/boundzero` := proc(p, x)
	local l, z;

	l := {0};
	for z in `dsolve/ratlode/pot_zeros`(p, x) do
		if denom(z) = 1 and z < 0 and subs(x = z, p) = 0 then
			l := l union {z}; fi;
	od;
	min(op(l));
end:

# `dsolve/ratlode/dbound`(c, [p0,...,p_n], d, e, x)
# INPUT: c  -- squarefree polynomial in x balanced wrt f
#        [p0,...,p_n] -- list of polynomials in x
#	 e  --  a polynomial in x, maybe 0
#        x  --  a variable
# OUTPUT: a bound for the power of c which can appear in the denominator
#	  of any solution of sum_{i=0}^n p_i y^(i) = .../e  or = 0 (if e = 0)
#
`dsolve/ratlode/dbound` := proc(c, p, e, x)
	local mu, lam, eq, z, beta, dd, rh;

	if degree(c, x) = 0 then 1;
	else
		mu := `dsolve/ratlode/mulambda`(c, p, x, 'lam');
		eq := `dsolve/ratlode/ind_eq`(c, p, x, lam, 'z');
		beta := `dsolve/ratlode/boundzero`(eq, z);
		if beta < 0 then dd := - beta; else dd := 0; fi;
		if e = 0 then dd;
		else
			rh := `dsolve/ratlode/poly_order`(c, e, x) - mu;
			if rh > dd then rh; else dd; fi
		fi
	fi
end:

# `dsolve/ratlode/denom`([p0,...,p_n], g, x)
# INPUT: [p0,...,p_n] -- list of polynomials in x
#        g  --  a fraction in x
#        x  --  a variable
# OUTPUT: the denominator of any solution of
#	  sum_{i=0}^n p_i y^(i) = g

`dsolve/ratlode/denom` := proc(p, g, x)
	local n, d, e, G, h, bl, t, i;

	n := nops(p) - 1;			# order of the equation
	d := p[n+1];
	e := denom(g);
	G := `dsolve/ratlode/sqrfree_part`(e, x);
	h := quo(G, gcd(G, `dsolve/ratlode/sqrfree_part`(d, x)), x);
# MBM h := quo(G, gcdex(G, `dsolve/ratlode/sqrfree_part`(d, x),x), x);
	if rem(e, h^(n+1), x) <> 0 then 0;	# no particular solution here
	else
		t := 1;
		if (g = 0) then e := 0;
		else
			bl := op(2, `dsolve/ratlode/balfact`(h, e, x));
			for i to nops(bl) do
				t := t * bl[i][1]^
					`dsolve/ratlode/qbound`(bl[i][1],e,n,x);
			od;
		fi;
		bl := op(2, `dsolve/ratlode/balfact`(d, op(p), x));
		for i to nops(bl) do
			t := t * bl[i][1]^
				`dsolve/ratlode/dbound`(bl[i][1], p, e, x);
		od;
		t;
	fi;
end:

# divide_out(p, q, x)
# INPUT: p, q -- polynomials in x
#        x  --  a variable
# OUTPUT: a polynomial r such that q = p^n r, and p does not divide r
#
`dsolve/ratlode/divide_out` := proc(p, q, x)
	local qot, r;

	if degree(p, x) = 0 then q;
	else
		r := rem(q, p, x, 'qot');
		if r <> 0 then q;
		else procname(p, qot, x);
		fi;
	fi;
end:

# `dsolve/ratlode/get_basis`(y, {c1,...,cm}, c)
# INPUT: y  --  a expression
#	 {c1,...,cm}  --  list of symbols
# 	 c  --  one of the ci's
# OUTPUT: y with every ci replaced by 0 except c which is replaced by 1
#
`dsolve/ratlode/get_basis` := proc(y, gens, c)
	`dsolve/ratlode/zerosubs`(subs(c = 1, y), gens minus {c});
end:

# good_subst(a, p)
# INPUT: a -- variables
# OUTPUT: p with a replaced by an integer such that p is non-zero
`dsolve/ratlode/good_subst` := proc(a, p)
	local q, m, local_random;

	q := subs(a = 0, p);
	m := 10;
	while q = 0 do
		local_random := rand(-m..m);
		to m do
			q := subs(a = local_random(), p);
			if q <> 0 then RETURN(q); fi
		od;
		m := 10 * m;
	od;
	q;
end:

# ind_eq(c, [p_0,...,p_n], x, lam, z)
# INPUT: c -- a squarefree polynomial in x
#        [p_0,...,p_n] -- list of polynomials in x
#        x  --  a variable
#	 lam  --  the leading set of L at c
#	 z  --  a new variable
# OUTPUT: the indicial equation at c of L = sum_{i=0}^n p_i y^(i)
#
`dsolve/ratlode/ind_eq` := proc(c, p, x, lam, z)
	local i, j, s;

	s := 0;
	for i in lam do
		s := s + `dsolve/ratlode/tau_rem`(i, c, p[i+1], x) *
						product(z - j, j = 0..i-1);
	od;
	primpart(resultant(c, s, x), z);
end:

# inf_ind_eq([p_0,...,p_n], x, lam, z)
# INPUT: [p0,...,p_n] -- list of polynomials in x
#        x    --  a variable
#	 lam  --  the leading set of L at infinity
#	 z    --  a new variable
# OUTPUT: the indicial equation at infinity of
#	   L = sum_{i=0}^n p_i y^(i)
#
`dsolve/ratlode/inf_ind_eq` := proc(p, x, lam, z)
	local i, j, s;

	s := 0;
	for i in lam do
		s := s + (-1)^i * lcoeff(p[i+1], x) * product(z+j, j = 0..i-1);
	od;
	primpart(s, z);
end:

# inf_mulam([p_0,...,p_n], x, lam)
# INPUT: [p0,...,p_n] -- list of polynomials in x
#        x    --  a variable
#	 lam  --  a new variable name
# OUTPUT: the order drop (result) and leading set (lam) at infinity of
#         L = sum_{i=0}^n p_i y^(i)
#
`dsolve/ratlode/inf_mulam` := proc(p, x, lam)
	local n, m, i, mu, lb;

	i := 1;
	while p[i] = 0 do i := i + 1; od;
	mu := degree(p[i], x);
	lb := {i - 1};
	n := nops(p);
	while i < n do
		i := i + 1;
		if p[i] <> 0 then
			m := degree(p[i], x) - i + 1;
			if m > mu then
				mu := m;
				lb := {i - 1};
			elif m = mu then
				lb := lb union {i - 1};
			fi
		fi
	od;
	lam := lb;
	mu;
end:

# mulambda(c, [p_0,...,p_n], x, lam)
# INPUT: c -- squarefree polynomial in x
#        [p_0,...,p_n] -- list of polynomials in x
#        x  --  a variable
#	 lam  --  a new variable name
# OUTPUT: the order drop (result) and leading set (lam) at c of
#         L = sum_{i=0}^n p_i y^(i)
#
`dsolve/ratlode/mulambda` := proc(c, p, x, lam)
	local n, m, i, mu, lb;

	i := 1;
	while p[i] = 0 do i := i + 1; od;
	mu := - `dsolve/ratlode/poly_order`(c, p[i], x);
	lb := {i - 1};
	n := nops(p);
	while i < n do
		i := i + 1;
		if p[i] <> 0 then
			m := i - 1 - `dsolve/ratlode/poly_order`(c, p[i], x);
			if m > mu then
				mu := m;
				lb := {i - 1};
			elif m = mu then
				lb := lb union {i - 1};
			fi
		fi
	od;
	lam := lb;
	mu;
end:

# poly_order(p, q, x)
# INPUT: p  -- monic polynomial in x
#	 q  -- polynomial in x
#        x  --  a variable
# OUTPUT: an integer n such that p^n divides q and p^(n+1) does not divide q
#
`dsolve/ratlode/poly_order` := proc(p, q, x)
	local qot, r, n;

	n := 0;
	if degree(p, x) = 0 then
	ERROR(`poly_order: first polynomial must be of positive degree`);
	else
		r := rem(q, p, x, 'qot');
		if r <> 0 then n;
		else 1 + procname(p, qot, x);
		fi;
	fi;
end:

# pot_zeros(p, x)
# INPUT: p  --  a polynomial in x
#        x  --  a variable
# OUTPUT: [a1,...,an] the potential rational zeros of p(x)
`dsolve/ratlode/pot_zeros` := proc(p, x)
	local s, q, i, r;

	if degree(p, x) = 0 then RETURN([]); fi;
	q := primpart(expand(p), x);
	s := frontend(indets, [q]) minus {x};
	for i to nops(s) do
		q := `dsolve/ratlode/good_subst`(s[i], q);
		if degree(q, x) = 0 then RETURN([]); fi
	od;
	q := `dsolve/ratlode/sqrfree_part`(q, x);
	[seq(r[1], r = roots(q))];
end:

# `dsolve/ratlode/qbound`(h, e, n, x)
# INPUT: h  --  squarefree polynomial in x balanced wrt e
#	 e  --  a polynomial in x
#	 n  --  the order of the equation
#        x  --  a variable
# OUTPUT: a bound for the power of h which can appear in the denominator
#	  of any solution of sum_{i=0}^n p_i y^(i) = g
#
`dsolve/ratlode/qbound` := proc(h, e, n, x)
	local q;

	if degree(h, x) = 0 then 1;
	else
		q := `dsolve/ratlode/poly_order`(h, e, x) - n;
		if q > 0 then q; else 0; fi
	fi
end:

# sqrfree_part(p, x)
# INPUT: p  --  a polynomial in x
#        x  --  a variable
# OUTPUT: The square free part of p in x
#
`dsolve/ratlode/sqrfree_part` := proc(p, x)

	quo(p, gcdex(p, diff(p, x), x), x);
end:

# tau_rem(n, c, p, x)
# INPUT: c  -- monic polynomial in x
#        p  -- polynomial in x
#        n  -- a nonnegative integer
#        x  -- a variable
# OUTPUT: n_tau_c(p)
#
`dsolve/ratlode/tau_rem` := proc(n, c, p, x)
	rem(diff(c, x)^n *
		quo(p, c^`dsolve/ratlode/poly_order`(c, p, x), x), c, x);
end:

# `dsolve/ratlode/zerosubs`(y, {c1,...,cm})
# INPUT: y  --  an expression
#	 {c1,...,cm}  --  list of symbols
# OUTPUT: y with every ci replaced by 0
#
`dsolve/ratlode/zerosubs` := proc(y, gens)
	local z, g;

	z := y;
	for g in gens do z := subs(g = 0, z); od;
	z;
end:

`help/text/ratlode` := TEXT(
`FUNCTION: ratlode - finds the rational solutions of a linear o.d.e.`,
`      `,
`CALLING SEQUENCE:`,
`   ratlode(eq,z)`,
`   ratlode(eq,z,basis)`,
`      `,
`PARAMETERS:`,
`   eq    - a linear ordinary equation with rational function coefficients`,
`   z     - the unknown function to solve for, must be of the form f(x)`,
`   basis - (optional) the name 'basis'`,
`      `,
`SYNOPSIS:   `,
`- The ratlode function is used to find all the rational functions solutions`,
`  of the linear ordinary differential equation eq.`,
`      `,
`- The equation eq must be linear in z and its derivatives, and its coefficient`,
`  must be rational functions in the dependent variable x.`,
`      `,
`- The unknown function z must be of the form f(x) where x is the dependent`,
`  variable.`,
`      `,
`- If ratlode is called with only 2 arguments, it returns a generic rational`,
`  solution with arbitrary constants named _C[i] for some i's, and the`,
`  list of those arbitrary constants.`,
`   `,
`- If the name 'basis' is passed as 3rd argument, ratlode returns:`,
`	. a basis of the rational solutions of eq if eq is homogeneous,`,
`	. a particular solution of eq and a basis for the corresponding`,
`	  homogeneous equation if eq is inhomogeneous.`,
`      `,
`EXAMPLES:   `,
`> eq := (x^9 + x^3) * diff(y(x), x$3) + 18 * x^8 * diff(y(x), x$2)`,
`>       - 90 * x * diff(y(x), x) - 30 * (11 * x^6 - 3) * y(x);`,
`   `,
`                      /   3      \\         /   2      \\`,
`              9    3  |  d       |       8 |  d       |        /  d      \\`,
`      eq := (x  + x ) |----- y(x)| + 18 x  |----- y(x)| - 90 x |---- y(x)|`,
`                      |   3      |         |   2      |        \\ dx      /`,
`                      \\ dx       /         \\ dx       /`,
`   `,
`                     6`,
`           - 30 (11 x  - 3) y(x)`,
`   `,
`> ratlode(eq, y(x));`,
`                                _C[1] x`,
`                               [-------, {_C[1]}]`,
`                                  6`,
`                                 x  + 1`,
`   `,
`> ratlode(eq, y(x), basis);`,
`                                        x`,
`                                    {------}`,
`                                      6`,
`                                     x  + 1`,
`   `,
`> eq := diff(v(x),x$2) + 6*x^2/(x^3+y^2) * diff(v(x),x) + 6*x/(x^3+y^2) * v(x);`,
`                                       2 /  d      \\`,
`                     /   2      \\     x  |---- v(x)|`,
`                     |  d       |        \\ dx      /      x v(x)`,
`               eq := |----- v(x)| + 6 -------------- + 6 -------`,
`                     |   2      |          3    2         3    2`,
`                     \\ dx       /         x  + y         x  + y`,
`   `,
`> ratlode(eq, v(x));`,
`                        _C[0] + _C[1] x`,
`                       [---------------, {_C[0], _C[1]}]`,
`                             3    2`,
`                            x  + y`,
`   `,
`> ratlode(eq, v(x), basis);`,
`                                   1        x`,
`                               {-------, -------}`,
`                                 3    2   3    2`,
`                                x  + y   x  + y`,
`   `,
`>    `,
`> eq := t^3 * diff(x(t), t$3) + t^2 * diff(x(t), t$2) - 2 * t * diff(x(t), t)`,
`>       + 2 * x(t) = 2 * t^4;`,
`            /   3      \\      /   2      \\`,
`          3 |  d       |    2 |  d       |       /  d      \\               4`,
`   eq := t  |----- x(t)| + t  |----- x(t)| - 2 t |---- x(t)| + 2 x(t) = 2 t`,
`            |   3      |      |   2      |       \\ dt      /`,
`            \\ dt       /      \\ dt       /`,
`   `,
`> ratlode(eq, x(t));`,
`                         2          3         5`,
`          _C[0] + _C[2] t  + _C[3] t  + 1/15 t`,
`         [-------------------------------------, {_C[0], _C[2], _C[3]}]`,
`                            t`,
`   `,
`> ratlode(eq, x(t), basis);`,
`                                   4       2`,
`                            [1/15 t , {t, t , 1/t}]`,
`   `,
`   `,
`SEE ALSO:  dsolve`
):
#save `ratlode.m`;
#quit
