# $Source: /u/maple/research/lib/polytools/src/RCS/shorten,v $ # $Notify: mvanhoei@daisy.uwaterloo.ca macro( EXT={'RootOf','radical','nonreal'}, RAD={'radical','nonreal'} ): # Note: It would be nice to add some additional functionality # to this code, namely that it also gives the transformation # that it uses. That would make it useful in more applications. # If anyone interested to spend time on this, feel free to do so. # I've given one application in evala/AFactor. This used to return: # # (x-y^4+256-RootOf(65537-512*_Z+_Z^2))*(x-256+RootOf(65537-512*_Z+_Z^2)-y^4) # # on the following input: evala(AFactor( (y^4-x)^2+1 )); # but now gives a much smaller nicer result. # Find a shorter polynomial giving the same extension field. `polytools/shorten`:=proc(f,x::name) local n,lf,g0,g1,g2,g3,S; option `Copyright (c) 2000 Waterloo Maple Inc. All rights reserved.\ Author: Mark van Hoeij`; if nargs=1 then n:=indets(f,name); if nops(n)<>1 then x # = error message else return procname(f,n[1]) fi elif indets(f,EXT)<>{} then Normalizer:=`evala/Normal` fi; lf:=Normalizer(lcoeff(f,x)); if f=0 then return 0 elif lf=0 then return procname(collect(f,x,Normalizer),x) fi; n:=degree(f,x); if n<1 then error "wrong input" elif n=1 then x else g0:=collect(f/lf,x,Normalizer); if coeff(g0,x,0)=0 then return f fi; g1:=`polytools/shorten*`(g0,x); g2:=collect(subs(x=x-coeff(g1,x,n-1)/n,g1),x,Normalizer); g3:=`polytools/shorten_int`(g1,x); S:={f,g0,g1,g2,g3}; if coeff(g0,x,0)=-1 then g0:=-g0 fi; if coeff(g0,x,0)=1 then S:=S union {add(coeff(g0,x,n-i)*x^i,i=0..n)} fi; S:=S union map(primpart,S,x); S:=`polytools/sort_poly`([op(S)],x)[1]; if `polytools/shorter`(S,f,x) then S:=procname(S,x) elif nargs=2 then S:=`polytools/shorten23`(f,x); g0:=coeff(S,x,0); g0:=collect(x^n*subs(x=1/x,S)/g0,x,Normalizer); S:=`polytools/sort_poly`([S,g0],x)[1]; if `polytools/shorter`(S,f,x) then S:=procname(S,x,x) fi fi; S fi end: # Decide if f is shorter (better in some sense) than g. `polytools/shorter`:=proc(f,g,x) local a,b,i; a,b:=degree(f,x), degree(g,x); if f<>g and a=b then a,b:=seq(`if`(type(i,polynom),0,1),i=[f,g]); if a=b then if a=0 then a,b:=degree(f),degree(g) fi; if a=b then a,b:=length(f),length(g); if a=b then a,b:=seq(`if`(lcoeff(i,x)=1,0,1),i=[f,g]); if a=b then a,b:=seq(`if`(type(i,polynom(rational,x)),0,1),i=[f,g]); if a=b then a,b:=seq(`if`(type(i,polynom(integer,x)),0,1),i=[f,g]); if a=b then a,b:=seq(nops(i),i=[f,g]); if a=b then a,b:=seq(abs(convert(map(j -> op([numer(j),denom(j)]), indets(i,rational)),`*`)),i=[f,g]) fi fi fi fi fi fi fi fi; evalb(a `polytools/shorter`(i,k,x)) end: # subs x=x+integer for a monic polynomial `polytools/shorten_int`:=proc(f,x) local n,v; n:=degree(f,x); v:=select(type,{op(coeff(f,x,n-1)+x)},rational) minus {0}; if v<>{} and n>0 then v:=v[1]/n; v, n:=frac(v), trunc(v); if v<-1/2 then n:=n-1 elif v>=1/2 then n:=n+1 fi; if n<>0 then v:=expand(subs(x=x-n,f)); if length(v)<=length(f) then return v fi fi fi; f end: `polytools/shorten23`:=proc(f,x) local d,p,i,j; d:=degree(f,x); p:=f; if d=3 and nargs=2 and type(p,ratpoly(rational,indets(f,name))) and irreduc(f) then _EnvExplicit:=true; d:=convert(`solve/poly3`(subs(x=_X,p))[1],RootOf); d:=indets(d,RootOf); if nops(d)=1 then p:=subs(_Z=x,op(1,d[1])) fi; elif {seq(coeff(f,x,i),i=1..d-1)}={0} then p:=Normalizer(tcoeff(f,x)/lcoeff(f,x)); p:=map(sqrfree,[numer(p),denom(p)]); j:=p[1][1]/p[2][1]; if type(j,rational) then _Env_ifactor_easy:=true; j:=mul(`if`(type(i[1],integer) ,i[1]^floor(i[2]/d+0.3),1),i=ifactors(j)[2]) fi; j:=j*mul(i[1]^floor(i[2]/d+0.3),i=p[1][2]) /mul(i[1]^floor(i[2]/d+0.7),i=p[2][2]); if nargs=3 then return j fi; p:=x^d+Normalizer(tcoeff(f,x)/lcoeff(f,x)/j^d) elif d=2 then p:=procname(x^2-Normalizer(discrim(f,x)),x) fi; p end: `polytools/shorten*`:=proc(f,x) local n,S,i,a,b; n:=degree(f,x); S:=NULL; for i from 0 to n-1 do a,b:=coeff(f,x,i),coeff(f,x,i+1); if a<>0 and b<>0 then S:=S,Normalizer(a/b) fi od; if S=NULL or nargs>2 then a:=coeff(f,x,0); b:=`polytools/shorten23`(x^n+a,x,x); i:=subs(x=x*b,f) else a,b:=map(denom,[S]),map(numer,[S]); while nops(a)>1 do a:=[gcd(a[1],a[2]),op(a[3..-1])]; b:=[gcd(b[1],b[2]),op(b[3..-1])]: od; i:=subs(x=x/a[1]*b[1],f) fi; i:=collect(i/lcoeff(i,x),x,Normalizer); if nargs=2 then a:=procname(i,x,x); if `polytools/shorter`(a,i,x) then i:=a fi fi; i end: #savelib('`polytools/shorten`',\ '`polytools/shorter`',\ '`polytools/sort_poly`',\ '`polytools/shorten_int`',\ '`polytools/shorten23`',\ '`polytools/shorten*`'):