>
Useful functions
The following function makes repeated substitutions until the function does not change.
>
rsub:=proc(l,f,n) local tmp1,tmp2,count,i;
tmp1:=simplify(subs(l,f));
#print(tmp1);
count:=0;
while (count<n) do;
tmp2:=simplify(subs(l,tmp1));
if (tmp1=tmp2) then
#print("done with");
RETURN(tmp1) else
count:=count+1;tmp1:=tmp2;
#print(tmp1);
fi;
od;
if (count=n) then print(count);fi;
tmp1;end:
>
First some functions for Puiseux expansions.
>
infrm:=proc(f,x) local tmp,n;
tmp:=collect(simplify(f),x);
n:=ldegree(tmp,x);
coeff(tmp,x,n)*x^n;
end:
try:=proc(f,l,x) infrm(subs(l,f),x);end:
tr:=f->try(f,lis,t):
wtfrm:=proc(f,x,w) local lis,tmp,ans,i,t,n;
lis:=[seq(x[i]=x[i]*t^w[i],i=1..nops(x))];
tmp:=subs(lis,f);
n:=degree(tmp,t);
ans:=[n,coeff(tmp,t,n)];
end:
dsc:=proc(f,x) simplify(resultant(f,diff(f,x),x));
end:
tp:=f->wtfrm(f,[x,y],[1,1]):
The original idea of using a substitution list was too cumbersome to update. So here is a better one:
>
mklis:=proc(l,x,t) local tmp,i;
tmp:=[x=sum(l[i][1]*t^l[i][2],i=1..nops(l))];end:
>
mkclis:=proc(l,sol,z) local tmp;
tmp:=subs(sol,l);[op(tmp),[z,l[nops(l)][2]+1]];end:
Specialized stuff for hyperbolas
Next routines check monicness of a polynomial, make it monic if needed (in y) and finally check if it is a hyperbola by the discriminant criterion.
>
>
ismonic:=proc(f,y) local tmp,n,ans;
tmp:=collect(f,y);n:=degree(tmp,y);
degree(coeff(tmp,y,n),x);
end:
mkmonic:=proc(f) local tmp;
tmp:=collect(f,y);
while(ismonic(tmp,y)>0) do;
tmp:=collect(subs(x=x+y,tmp),y);
od;
tmp;end:
chhyper:=proc(f) local tmp,discrim;
tmp:=mkmonic(f);
discrim:=dsc(tmp,y);
[degree(tmp,y),degree(discrim,x)];
end:
Now approximate roots stuff
> with(linalg):jac:=(f,g)->det(jacobian([f,g],[x,y])):
>
app:=proc(f,d,x) local tmp,tmp1,tmp2,n,m,a,b;
tmp:=collect(expand(f),x);
n:=degree(tmp,x);
tmp:=collect(tmp/coeff(tmp,x,n),x);
if irem(n,d)=0 then m:=n/d else RETURN(`undefined approot`);fi;
if d=1 then RETURN(f);fi;
tmp1:=x^m;
tmp2:=collect(tmp-tmp1^d,x);
b:=degree(tmp2,x);a:=coeff(tmp2,x,b);
while b>=n-m do;
#print(tmp1,tmp2);
tmp1:=tmp1+(a/d)*x^(b+m-n);
tmp2:=collect(tmp-tmp1^d,x);
b:=degree(tmp2,x);a:=coeff(tmp2,x,b);
od;
tmp1;
end:
>
adic:=proc(f,g,x) local tmp,tmp1,tmp2,q,ans;
ans:=[];tmp:=collect(expand(f),x);
tmp1:=collect(expand(g),x);
while tmp<>0 do;
tmp2:=rem(tmp,tmp1,x,q);
ans:=[tmp2,op(ans)];
tmp:=q;q:='q';
od;
ans;end:
>
adicx:=proc(f,g,x,z) local tmp,ans,i,n;
tmp:=adic(f,g,x);
n:=nops(tmp);
ans:=collect(sum(z^(n-i+1)*tmp[i],i=1..n),z);end:
>
tcof:=f->coeff(coeff(f,h,degree(f,h)),t):
smp:=proc(f) local tmp;
tmp:=collect(rem(f,f2,t),h);
print(degree(tmp,h),coeff(tmp,h,degree(tmp,h)));
print(tcof(tmp));
tmp:end:
6,8 case 1
> f:=h^3+(t+c)*h+d*t;f2:=t^2+a-h;
> ff:=rem(f^4,f2,t):
> g1:=app(ff,3,h):g1:=rem(g1,t^2+a-h,t);
> collect(g1,h);
> g2:=app(rem(f^2,f2,t),3,h);
> g3:=app(rem(f,f2,t),3,h);
> gg1:=subs(h=t^2+a,g1);gg2:=subs(h=t^2+a,g2);app(gg1,2,t);
> collect(gg2,t);
> gg:=g1+p*g2+q*g3;
> ans:=smp(gg^3-f^4-3*p*gg*f^2-3*q*f^3-32/3*d*gg^2):
>
> sol1:=solve(coeff(coeff(ans,h,7),t),{q});
> gg:=subs(sol1,gg):
> ans:=subs(sol1,ans):
> smp(ans):
> ans1:=smp(ans-coeff(ans,h,7)*gg*f):
> sol2:=solve(tcof(ans1),{a});
> ans1:=subs(sol2,ans1):f2:=subs(sol2,f2):gg:=subs(sol2,gg):f:=subs(sol2,f):
>
> ans1:=smp(ans1):
> ans2:=smp(ans1-coeff(ans1,h,6)*f^2):
>
> sol3:=solve(tcof(ans2),{p});
> f:=subs(sol3,f):f2:=subs(sol3,f2):gg:=subs(sol3,gg):ans2:=subs(sol3,ans2):
>
> smp(ans2):
> sol4:=solve(tcof(ans2),{c});
> ans2:=subs(sol4,ans2):gg:=subs(sol4,gg):f:=subs(sol4,f):f2:=subs(sol4,f2):
> smp(ans2):
> ans3:=smp(ans2-coeff(ans2,h,4)*gg):
This forces d=0 for further reduction, which is inconsistent with previous subs.
6,8 case 2
Try d=0 directly.
> f:=h^3+(t+c)*h;f2:=t^2+a-h;
> ff:=rem(f^4,f2,t):
> g1:=app(ff,3,h):g1:=rem(g1,t^2+a-h,t);
> g2:=app(rem(f^2,f2,t),3,h);
> g3:=app(rem(f,f2,t),3,h);
> gg:=g1+p*g2+q*g3;
> ans:=smp(gg^3-f^4-3*p*gg*f^2-3*q*f^3):
>
> sol1:=solve(coeff(coeff(ans,h,7),t),{q});
> gg:=subs(sol1,gg):
> ans:=subs(sol1,ans):
> smp(ans):
> ans1:=smp(ans-coeff(ans,h,7)*gg*f):
> sol2:=solve(tcof(ans1),{a});
> ans1:=subs(sol2,ans1):f2:=subs(sol2,f2):gg:=subs(sol2,gg):f:=subs(sol2,f):
>
> ans1:=smp(ans1):
> ans2:=smp(ans1-coeff(ans1,h,6)*f^2):
>
> sol3:=solve(tcof(ans2),{p});
> f:=subs(sol3,f):f2:=subs(sol3,f2):gg:=subs(sol3,gg):ans2:=subs(sol3,ans2):
>
> smp(ans2):
This says that t^9 cannot be killed!
Now the remaining case.
> f:=h^3+(c)*h+t;f2:=t^2+a-h;
> ff:=rem(f^4,f2,t):
> g1:=app(ff,3,h):g1:=rem(g1,t^2+a-h,t);
> collect(g1,h);
> g2:=app(rem(f^2,f2,t),3,h);
> g3:=app(rem(f,f2,t),3,h);
> gg:=g1+p*g2+q*g3;
> ans:=smp(gg^3-f^4-3*p*gg*f^2-3*q*f^3):
>
> sol1:=solve(coeff(coeff(ans,h,7),t),{p});
> gg:=subs(sol1,gg):
> ans:=subs(sol1,ans):
> smp(ans):
> ans1:=smp(ans-coeff(ans,h,7)*gg*f):
> sol2:=solve(tcof(ans1),{q});
> ans1:=subs(sol2,ans1):f2:=subs(sol2,f2):gg:=subs(sol2,gg):f:=subs(sol2,f):
>
> smp(ans1):
> ans2:=smp(ans1-coeff(ans1,h,6)*f^2):
Thus again, coeff of t^9 survives!