# Desingularize the trailing coefficient as much as possible.
#
#
#  Mark van Hoeij, August 2004.

desing_trailing := proc(L, domain)
	local EXPAND,tau,x,d,ds,c,i,j,l,s,vars,zero,a0,A0;
	tau,x := op(domain);
	if not type(L, polynom(anything,domain)) or coeff(L,tau,0)=0 then
		error "wrong input"
	fi;

	d := indets(L,{algext,radical});
	if (indets(L) union d) minus {x,tau}={} then
		EXPAND := proc(A) expand(A) end
	else
		if d={} then Normalizer:=normal else Normalizer:=evala fi;
		# This to make sure that expanding products works OK if
		# there are parameters or algebraic numbers.
		EXPAND := proc(A,B) collect(A,B,Normalizer) end
	fi;

	a0 := tcoeff(L,tau);
	d := LREtools[dispersion](lcoeff(L,tau),a0,x,'maximal');
	if not type(d,integer) then d:=0 fi;
	A0[0] := a0;
	j := max(seq(i[2],i=sqrfree(a0,x)[2]));
	for i to d do
		A0[i] := A0[i-1]*gcd(subs(x=x+i,a0),a0^j)
	od;
	ds := add( add(c[i,j]*x^i, i=0..degree(A0[j],x)-1)
	 * Normalizer(A0[d]/A0[j]) * tau^j, j=0..d);
	vars := indets(ds) minus indets([args,x,tau]);
	zero := collect(rem(collect(mult(ds,L,domain),x),A0[d],x),
	 domain,distributed);
	ds := subs( solve({coeffs(zero,{tau,x})},vars), ds);
	if ds=0 then return 1 fi;
	do
		l := lcoeff(coeff(ds,tau,0),x);
		s := EXPAND(subs(solve(l, vars), ds),domain);
		if coeff(s,tau,0)=0 then
			ds := EXPAND(subs(solve(l-1,vars), ds),domain);
			break
		fi;
		ds := s
	od;
	for i from d to 1 by -1 do
	 for j from degree(coeff(ds,tau,i),x) to 0 by -1 do
		l := coeff(coeff(ds,tau,i),x,j);
		if has(l,vars) then
			ds := EXPAND(subs(solve(l,vars), ds),domain)
		fi
	 od
	od;
	ds := sort(collect(evala(Primpart(ds,tau,'i')),tau),tau);
	Normalizer( i/A0[d]*lcoeff(A0[d]/a0,x) )*ds
end;


# Multiplication in the ring C(x)[tau] where
#       tau * f(x) = f(x+1) * tau.
#
mult := proc(L1,L2,domain)
	local i,tau,x;
	tau,x := op(domain);
	sort(collect(add(coeff(L1,tau,i)*
	 subs(x=x+i,L2)*tau^i,i=ldegree(L1,tau)..degree(L1,tau))
	 ,tau,Normalizer),tau)
end;




# Desingularize the leading coefficient as much as possible.
#
desing_leading := proc(L, domain)
	local tau,x,n,L2,L3;
	tau,x := op(domain);
	if not type(L, polynom(anything,domain)) or coeff(L,tau,0)=0 then
		error "wrong input"
	fi;
	n := degree(L,tau);
	# Apply the automorphism s: C[x,tau,1/tau] --> C[x,tau,1/tau]
	# given by s(x)=-x and s(tau) = 1/tau.
	# Then multiply by tau^n to get rid of the 1/tau.
	# So L2 = s(L) * tau^n
	L2 := collect(subs(tau=1/tau,x=-x,L) * tau^n,tau);
	L3 := desing_trailing(L2, domain);
	# Now we have L3 * s(L) * tau^n
	# s(L3) * L * (1/tau^n)
	Normalizer := evala;
	mult(tau^degree(L3,tau),subs(x=-x,tau=1/tau,L3),domain)
end;


# Desingularize both trailing and leading coefficients as much as possible.
#
desing_both := proc(L, domain)
	local tau,x,n,L2,L3;
	tau,x := op(domain);
	L2 := desing_trailing(args);
	L3 := desing_leading(args);
	if normal(L2-L3)=0 then return L2 fi;
	while coeff(L3,tau,0)<>0 or degree(L3,tau) <= degree(L2,tau) do
		L3 := mult(tau, L3, domain)
	od;
	collect(L2 + L3, tau, evala)
end;