read(IntBasis); # Rational Parametrization of a g=0 curve with a degree 2 curve # f is a polynomial in x and y # f must be irreducible over the algebraic closure of the constants # Output: a parametrization [X(s,t),Y(s,t),F(s,t)] where X(s,t),Y(s,t) are # the points on the curve f and where s,t are the points on the curve F. Here # F is a curve of degree 2. ratpar:=proc(ff,x,y,s,t) local u,j,co,f,n,i,z,res,b,v,a,den,d,d1,i0,bb,p,f2,resp,vars,w, y_powers,zero; options remember; # Make sure that the coefficients are evala normalized: f:=collect(ff,[x,y],distributed,g_normal); n:=degree(f,{x,y}); if n<3 then RETURN([x,y,ff]) fi; if coeff(f,y,n)=0 then # Use one of these 2 linear transformations to avoid this case. if coeff(f,x,n)<>0 then res:=procname(f,y,x,args[4..nargs]); RETURN([res[2],res[1],res[3..nops(res)]]) fi; res:=procname(subs(x=x+y,f),args[2..nargs]); RETURN([g_normal(res[1]+res[2]),res[2..nops(res)]]) fi; # Now coeff(f,y,n)<>0, so [0,1,0] is not a point on the curve if g_normal(discrim(subs(z=0,x=1,homogeneous(f,x,y,z,`polynom`) ),y))=0 then res:=procname(numer(subs({x=x/(x+1),y=y/(x+1)},f)),args[2..nargs]); # Apply the same transformation on the result and normalize # the result in Q(s)[t]/(res[3]) if nops(res)=2 then RETURN([g_normal(res[1]/(res[1]+1)), g_normal(res[2]/(res[1]+1))]) else RETURN([FFDIV(res[3],s,t,res[1]/(res[1]+1)), FFDIV(res[3],s,t,res[2]/(res[1]+1)),res[3]]) fi fi; # now there are no ramification points nor singularities at infinity b:=integral_basis(f,x,y); if convert([seq(degree(denom(i),x),i=b)],`+`)<>(n-1)*(n-2)/2 then ERROR(`genus is not zero`) fi; # elimate denominators: den:=denom(b[n]); b:=[seq(expand(g_normal(den*i)),i=b)]; w:=L_inf(b,x,y,den,n); v:=expand([1*den,x*den,x^2*den,op(w),seq(i*x,i=w)]); # Now v is a basis for L(2*(line at infinity)) # L(-canonical divisor) = L(2*(line at infinity)) intersected # with the set {b | b*diff(all integral elements,x) is integral} # First treat the ramification points at the multiplicity 1 factor of # the discriminant. We take those elements of the vector space spanned # by v that have roots in this points. To do this take a function a # that has poles in these points and then multiply with v d:=discrim(f,y); d1:=evala(Sqrfree(d))[2][1]; if d1[2]=1 then # the discriminant does have a multiplicity 1 factor d1:=expand(d1[1]); if member(n-degree(d1,x),{1,2}) then # then we'll have 2 or 3 functions left afterwards v:=[1,x,op(w)] fi; a:=numer(FFDIV(f,x,y,diff(f,x),diff(f,y))); # Now a/d1 has poles of order 1 at the ramification points of d1 # Take a generic number i0: i0:=0; while evala(Gcd(subs(y=i0,f),d1))<>1 do i0:=i0+1 od; # a*y^i mod f, with y=i0 substituted. So these are polynomials in x. y_powers:=[seq(subs(y=i0,rem(expand(y^i*a),f,y)),i=0..n-1)]; zero:=convert([seq(co[i]*evala(Rem(collect( convert([seq(coeff(v[i],y,j)*y_powers[j+1],j=0..n-1)],`+`) ,x),d1,x)),i=1..2*n+1)],`+`); vars:={seq(co[i],i=1..2*n+1)}; v:=subs(solve({coeffs(collect(zero,x),x)},vars) ,convert([seq(co[i]*v[i],i=1..2*n+1)],`+`)); vars:=indets(v) intersect vars; v:=[seq(subs(solve(vars),subs(i=1,v)),i=vars)]; # The dimension of v should have dropped degree(d1,x) because we # have specified roots for the functions in v in degree(d1,x) points if nops(v) <> 2*n+1-degree(d1,x) then bug() fi else d1:=1 fi; # switch the order in the integral basis so the basis elements are # used in a different order in the following loop. bb:=[b[1..2],seq(b[n-i],i=0..n-3)]; i:=1; while nops(v)>3 do i:=i+1; # a:=diff(generic integral element,x) # (each integral basis element need not be generic, but we # treat them one by one, and together they are generic). # The denominator d1 has already been taken care of and # can be disregarded a:=FFDIV(f,x,y,subs(RootOf(f,y)=y,diff(subs(y=RootOf(f,y), bb[i]/den),x)*d1)); # Compute a basis for those elements b in the vectorspace # generated by v which satisfy a*b = integral v:=frac_integral_a(f,x,y,v,a,b,den,n) # For a=diff(generic integral element,x) the dimension of the # L(D) we end up with must be 3. od; v:=[seq(primpart(evala(Expand(i))),i=v)]; if nops(v)=2 then RETURN(express_in_p(f,x,y,s,v[1],v[2])) fi; # Write v[1]=s v[2]=t v[3]=u and search for a degree 2 relation: i0:=-1; f2:=convert([seq(seq(co[i,j]*s^i*t^j*u^(2-i-j),i=0..2-j),j=0..2)],`+`); vars:=indets(f2) minus {s,t,u}; while nops(vars)>1 do i0:=i0+1; f2:=subs(solve({coeffs(collect(evala(Rem(expand(subs(x=i0, subs(s=v[1],t=v[2],u=v[3],f2))),subs(x=i0,f),y)),y),y)}, vars),f2); vars:=indets(f2) intersect vars od; f2:=subs(op(vars)=1,f2); vars:=[s,t,u]; for i from 1 to 3 do if degree(f2,vars[i])=1 then # The quotient of the other two generates the function field RETURN(express_in_p(f,x,y,s,op({op(v)} minus {v[i]}))) fi od; # the degree is 2 in all three variables s,t,u if member(line,{args}) then RETURN(point_on_C2(f,x,y,f2,s,t,u,v,n)) fi; f2:=subs(u=1,f2); # This may need some modification of charpol res:=[seq(FFDIV(f2,s,t,solve( `genus1/charpol`(v[1]/v[3],op(i),f,s)-`genus1/charpol`(v[2]/v[3], op(i),f,t),i[1])),i=[[x,y],[y,x]]),f2]; if not has([res,f],RootOf) then # Check the result (not in the RootOf case, then mod p is problematic) p:=nextprime(10000); i0:=0; while Expand(subs(s=i0,denom(res[1])*denom(res[2])*numer(res[3]))) mod p=0 do i0:=i0+1; p:=nextprime(p) od; resp:=subs(s=i0,[Expand(res[1]),Expand(res[2]) ,Expand(numer(res[3]))]) mod p; resp:=[Rem(resp[1],resp[3],t),Rem(resp[2],resp[3],t),resp[3]] mod p; if Rem(Expand(subs(x=resp[1],y=resp[2],Expand(subs(s=i0,numer(f))) mod p)) mod p,resp[3],t) mod p <> 0 then bug() fi fi; # check OK, return the result res end: # v1/v2 generates the function field. Compute X(s) and Y(s) such that # x=X(v1/v2) and y=Y(v1/v2) express_in_p:=proc(f,x,y,s,v1,v2) local z,d,zero; zero:=expand(v1-s*v2); d:=subs(x=1,homogeneous(zero,x,y,z,`polynom`)); d:=expand(d/z^ldegree(d,z)); d:=evala(Resultant(subs(z=0,d), subs(z=0,x=1,homogeneous(f,x,y,z,`polynom`)),y)); [seq(express_x_in_p(f,op(z),s,zero,d/icontent(d)),z=[[x,y],[y,x]])] end: express_x_in_p:=proc(f,x,y,s,zero,d) local X,cX,vars,i,R; X:=convert([seq(cX[i]*s^i,i=0..degree(f,y))],`+`); vars:=indets(X) minus {s}; i:=-1; while has(X,vars) do i:=i+1; R:=subs(x=i,[zero,f]); if degree(R[1],s)*degree(R[2],y)*degree(R[1],y)=0 or evala(Gcd(op(R)))<>1 then next fi; R:=evala(Resultant(op(R),y)); X:=evala(Expand(subs(solve({coeffs(collect(evala(Rem(X-i*d, expand(R),s)),s),s)},vars),X))) od; g_normal(X/d) end: # Input: a vectorspace v # Output: the subspace w \subset v which can be written as an integral # element divided by a. frac_integral_a:=proc(f,x,y,v,a,b,den,d) global trancendental_ext; local z,equations,co,ext,i,ansatz,dena,numa,so,vars; dena:=expand(denom(a)); numa:=evala(Rem(expand(numer(a)),dena,x)); z:=0; for i from 1 to nops(v) do z:=z+co[i]*evala(Rem(expand(numa*v[i]),f,y)) od; # now z/dena/den should be integral ansatz:=convert([seq(co[i]*v[i],i=1..nops(v))],`+`); so:=solve(evala({coeffs(expand(evala(Rem(expand(z) ,dena,x))),[x,y])}),{seq(co[i],i=1..nops(v))}); ansatz:=subs(so,ansatz); z:=subs(so,z); # Now z is divisible by dena z:=expand(g_normal(z/dena)); ext:=g_ext([args]); for i from d-1 by -1 to 0 do while degree(coeff(z,y,i),x) >=degree(lcoeff(b[i+1],y),x) and coeff(z,y,i)<>0 do z:=g_expand(z-b[i+1]* g_normal(lcoeff(coeff(z,y,i),x)/lcoeff(lcoeff(b[i+1],y),x)) *x^(degree(coeff(z,y,i),x)-degree(lcoeff(b[i+1],y),x)) ,ext); if trancendental_ext<>{} then z:=expand(collect(z,[x,y],g_normal)) fi od od; equations:={coeffs(z,[x,y])}; z:=g_normal(subs(g_solve(equations),ansatz)); vars:=indets(z) intersect {seq(co[i],i=1..nops(v))}; [seq(subs(solve(vars),subs(i=1,z)),i=vars)] end: # Function Field DIVision, compute a/b in Qbar(x)[y]/(f) FFDIV:=proc(f,x,y,a,b) local d,q,i,qc; if nargs=4 then d:=normal(a); RETURN(FFDIV(f,x,y,numer(d),denom(d))) fi; d:=degree(f,y); q:=convert([seq(qc[i]*y^i,i=0..d-1)],`+`); g_normal(subs(solve(evala({coeffs(collect(rem(collect(q*b-a,y), f,y),y,numer),y)}),{seq(qc[i],i=0..d-1)}),q)) end: # Output: L(line at infinity), i.e. a basis for all integral functions # with a pole of order <= 1 at infinity (we skip the elements 1 and x). # Assumptions: no singularities nor ramification points at infinity # b/den=integral basis, the genus is 0, the curve is irreducible over the # algebraic closure of the constants and y is integral over C[x]. # Note that the output should still be divided by den to get the correct # answer. L_inf:=proc(b,x,y,den,n) local R,vars,i,j,d,Cr,Cb,di,ai,S,co; R:=0; # variables which must not be eliminated: vars:=indets([args,seq(C[i],i=0..n)]); # The basis for L(1*line) will be obtained # by substituting (0,0,..,1,0,0,..) in the C[i] in R. # The coefficient of y^i*(suitable power of x)/den must be C[i]. # At infinity this looks like: y^i/z + ... for i from n-1 by -1 to 0 do d:=1+degree(den,x)-i; if d<0 then bug() fi; Cr:=coeff(R,y,i)-C[i]*x^d; Cb:=lcoeff(b[i+1],y); di:=degree(Cr,x)-degree(Cb,x); ai:=convert([seq(co[i,j]*x^j,j=0..di)],`+`); S:=collect(Cr-ai*Cb,x); # from x^d and up this should be zero S:={co[0,0],seq(coeff(S,x,j),j=d..degree(S,x))}; # S:={seq(coeff(S,x,j),j=d..degree(S,x))}; # if i=0 then # S:={op(S),coeff(expand(coeff(R,y,i)-ai*b[1]),x,d-1)} # fi; R:=collect(subs(solve(evala(S),indets(S) minus vars), R-ai*b[i+1]),[x,y],distributed,g_normal) od; vars:={seq(C[i]=0,i=0..n)}; [seq(subs(vars,subs(C[i]=1,R)),i=1..n-1)] end: point_on_C2:=proc(f,x,y,f2,s,t,u,v,n) local x0,d0,y0,P,P1,P2,G,i,j,vars; G:=factors(subs(u=0,s=1,f2))[2]; if degree(expand(G[1][1]),t)=1 then P:=[1,solve(G[1][1],t),0] elif irem(n,2)=0 then P:=[1,RootOf(G[1][1],t),0] # Need to add more code for the case of a odd degree Puiseux expansion else x0:=-1; d0:=0; while irem(d0,2)=0 do x0:=x0+1; y0:=factors(subs(x=x0,f)); for i in y0[2] do if i[2]=1 then d0:=degree(i[1],y); if irem(d0,2)=1 then y0:=RootOf(i[1],y); break fi fi od od; P:=[seq(g_normal(subs(x=x0,y=y0,i)),i=v)]; if d0>1 then G:=convert([seq(seq(co[i,j]*s^i*t^j*u^((d0+1)/2-i-j) ,i=0..(d0+1)/2-j),j=0..1)],`+`); vars:=indets(G) minus {s,t,u}; G:=subs(solve({coeffs(evala(Expand(subs(s=P[1],t=P[2],u=P[3] ,G))),y0)},vars),G); vars:=[op(vars intersect indets(G))]; G:=g_normal(subs(vars[1]=0,vars[2]=1,G)/subs( vars[2]=0,vars[1]=1,G)); G:=FFDIV(op(subs(u=1,[f2,s,t,G]))); P:=solve(denom(G),s); P:=[P,solve(subs(s=P,numer(G)),t),1] fi; fi; #lprint(P); if P[3]<>0 then P1:=P[3]*v[1]-P[1]*v[3]; P2:=P[3]*v[2]-P[2]*v[3] else # switch 1 and 3 P1:=P[1]*v[3]-P[3]*v[1]; P2:=P[1]*v[2]-P[2]*v[1] fi; # P1/P2 generates the function field express_in_p(f,x,y,s,P1/icontent(P1),P2/icontent(P2)); end: lprint(`For help about rational parametrizations type ?ratpar`): `help/text/ratpar`:=TEXT( ``, `FUNCTION: ratpar - compute a rational bijection with a degree <= 2 curve`, ``, `CALLING SEQUENCES:`, ` ratpar(f,x,y,s,t)`, ``, `PARAMETERS:`, ` f - a polynomial in x and y describing a curve with g=0`, ` x,y,s,t - variables`, ``, `SYNOPSIS:`, ``, `- If the genus of a curve is 0 one can compute a birational equivalence`, ` between the curve and the projective line P^1. The algorithm for this`, ` in IntBasis, called genus, uses algebraic extensions over the base field`, ` to compute such a birational equivalence.`, ` This procedure ratpar computes a rational parametrization, i.e. a`, ` parametrization without using algebraic extensions. However, contrary`, ` to procedure genus the curve will not be parametrized by a line but by`, ` another curve g in the variables s and t with degree(g) <= 2.`, ` A parametrization where the parameter takes values in P^1 can then be`, ` obtained from the output of ratpar by parametrizing this degree <= 2`, ` curve. This takes at most an algebraic extension of degree 2 over the`, ` base field.`, ``, `- The output is of the form [X(s,t) , Y(s,t) , g(s,t) ] where g is a`, ` polynomial of degree <= 2 in s and t and where X(s,t) and Y(s,t) are`, ` polynomials in t of degree <= 1 with rational functions in s as`, ` coefficients. If [s0,t0] is a point on g then [X(s0,t0),Y(s0,t0)] is`, ` a point on the curve f.`, ``, `- If the option line is given then ratpar computes a bijection with a line`, ` instead of with a conic. The output is of the form [X(s),Y(s)] where X`, ` and Y are rational functions in s that parametrize the curve. If`, ` degree(f,{x,y}) is odd then this parametrization will be rational, i.e. no`, ` RootOf's will be introduced in the output.`, ``, `EXAMPLE:`, ``, `f:=`, `y^7-3*x*y^5-6*y^5+12*x^2*y^4+4*x*y^3+3*x^2*y^3-6*x^4*y^3-6*x^3*y^2-x^3*y+2*x^7;`, ``, `v:=ratpar(f,x,y,s,t); # Note: the output is not uniquely determined`, ``, `v := [ `,` `,` 7 6 5 \ 4 3 2`,`(- 71880 s - 1121024 s + 757896 s + 7359\ 1472 s + 264012360 s - 48729024 s`,` `, ` 6 4`, ` - 1063575456 s - 910801920 + 15647756928 t + 499380 s t - 25092984 s t` ,` `, ` 5 2 3 /`, ` + 6772749 s t + 6595884348 s t - 838442784 s t - 562441854 s t) / (` ,` /`, ` `,` 4 6 5`, ` - 91067448 s + 24461505184 + 736416 s - 770976 s + 14476667520 s`,` ` ,` 7 3 2`, ` + 40217 s - 434818848 s + 1619495664 s ),`,` `, ` 7 6 5 4 3`, `- 1/2 (- 35184 s - 387780 s - 3552144 s - 64955376 s - 422236448 s`,` `, ` 2 6 5`, ` - 642436608 s + 1748031872 s + 3633850368 + 285729 s t + 2617440 s t`, ` `,` 4 3 2`, ` + 6163530 s t + 200611032 s t + 1603557888 s t + 3408493344 s t`,` ` ,` / 4 6 5` ,` - 161407488 t) / (- 91067448 s + 24461505184 + 736416 s - 770976 s`, ` /`,` `, ` 7 3 2`, ` + 14476667520 s + 40217 s - 434818848 s + 1619495664 s ),`,` `, ` 2 2`, `- 4 + s - 11/2 t - 14 s t + 369/8 t ]`, ``, `# Now check the answer:`, `s0:=0: t0:=RootOf(subs(s=s0,v[3])):`, `X0:=subs(s=s0,t=t0,v[1]): Y0:=subs(s=s0,t=t0,v[2]):`, `evala(subs(x=X0,y=Y0,f));`, ``, ` 0`, `# OK`, # `# Finding the rational points on the curve f is now reduced to finding the`, # `# rational points on the curve v[3]=-4+s^2-11/2*t-14*s*t+369/8*t^2`, `# the degree of f is odd, then a rational parametrization exists:`, `v:=ratpar(f,x,y,s,line);`, `v := [ `,` `, ` 2`, `- 3969 (821244441733120 + 1252538234492672 s - 438316749262872 s`,` `, ` 3 4 5`, ` - 984664077659680 s - 135968528778230 s + 152161773060168 s`,` `, ` 6 7 /`, ` + 48554984621407 s + 3930151674740 s ) / (16755544134879024644`, ` /`,` `,` \ 2 3`,` + 15538891016\ 24610128 s - 15857523561474336000 s - 4750347293169903908 s`,` `,` \ 4 5 6`, ` + 3320730501061929088 s + 1799807034862160268 s + 281527774136508368 s` ,` `,` 7`,` + 11382198531558719 s ),`,` `, ` 2`, `- 7938 (- 5949548548288 - 34117337854724 s - 73294136755344 s`,` `, ` 3 4 5`, ` - 67583090983103 s - 14897064670672 s + 15045600016224 s`,` `, ` 6 7 /`, ` + 8398111410944 s + 995626586368 s ) / (16755544134879024644`, ` /`,` `,` \ 2 3`,` + 1553889101624\ 610128 s - 15857523561474336000 s - 4750347293169903908 s`,` `,` \ 4 5 6`, ` + 3320730501061929088 s + 1799807034862160268 s + 281527774136508368 s` ,` `,` 7`,` + 11382198531558719 s )`,` `, `] `, ``, `SEE ALSO: genus` ):