# #Maple program to transform and study an elliptic curve. 11/13/96 #Analysis and commentary on procedures is in accompanying paper, # "Rational Triangles with Equal Area", David J Rusin, rusin@math.niu.edu # To appear in New York Jour Math Jan 1998. #Maple's output on my machine is shown. #Check it by running maple < maple.input to see input file as it's used. #If input file agrees with output, that suggests the computations of the # paper are valid. It's easier to figure out what the code below is # supposed to show if you read it equation-by-equation in tandem with # the paper! #Here goes: # readlib(eliminate): #We use this a lot! # #INTRODUCTION # #Heron's formula: A^2-s*(s-p)*(s-q)*(s-r): 16*subs({s=(p+q+r)/2, A^2=-C/16},"): eq1:=factor("+C)-C; # # eq1 := (p + q + r) (- p + q + r) (- p + q - r) (p + q - r) - C # #This is "eq(1)" of the paper. # #Covering by Elkies' surfaces expand(factor(subs({p=(x1^4+x2^4)/(2*x1*x2*x3), q=(x2^4+x3^4)/(2*x1*x2*x3), r=(x3^4+x1^4)/(2*x1*x2*x3)},-eq1))); #So eq1 is indeed zero if (x1 x2 x3) is on Elkies surface. # #Equation in x and y: eq2:=subs({p=(x+y)/2, q=(x-y)/2},eq1); #Hm -- can't make maple display it the way I want without explicitly writing #eq2:=(x^2-r^2)*(y^2-r^2)-C; # # 2 2 2 2 # eq2 := (x - r ) (y - r ) - C # #This eq2 is "eq(2)" of the paper. # #THEOREM 1 # #Fine's 2-fold cover: su1:={p=u*(s-C/s),q=u*(t-C/t), r=u*(s+t+C/s+C/t)}: eliminate(su1 union {eq1},{p,q,r})[2][1]: "/C/s^2/t^2: #It seems to have some useless factors. Also there are factors(")[2]: #two interesting factors, but the eq2a:="[2][1]: #other factor simply has u^2 replaced by -u^2. #want the one with opposite coeffs: c:=-subs({s=1,t=0,C=1,u=1},")/subs({u=0,s=2,t=2},"): eq2a:=subs({s=s/c,t=t/c},eq2a): factor(taylor(eq2a,u)); #looks better but Maple treats as a series - yuk. # # 2 # 1/4 s t - (t + s) (s t + C) u # #This is the "other surface" used by Fine, a 2-fold cover of the Heron surface. su2:={s=C*x, t=C*x^2, u=x/2/y}: #Intersect it with a paraboloid to get factor(subs(su2,eq2a)): #an elliptic curve 4*y^2*"/x^3/C^2: eq2b:=-y^2+factor(-"+y^2); # 2 3 # - y + (x + 1) (C x + 1) #Get Weierstrass form: (Send (0,1)->oo ) su3:={x=(1-4*X)/(X+2*C-2*Y), y=(-4*Y^2+8*C*Y+Y+8*X^3-3*X^2-4*C^2-C)/(X+2*C-2*Y)^2}: numer(factor(subs(su3,eq2b)))/(4*X-1)^3; # 3 2 2 # - X + 3 C X + Y - C - C #(0,1) -> oo, (-1,0) -> (1, C-1); it and inverse are (usually) of inf. order. factor(subs(subs(subs({X=1,Y=1-C},su3),su2),su1)); #that should give p,q,r in terms of C factor(subs(C=C/16/v^4,")): #now note "slight change of variables": eq3:=factor({p=2*v*subs(",p), q=2*v*subs(",r), r=2*v*subs(",-q)}); # 4 4 4 # (C + 2 v ) (C - 16 v ) v (C - v ) # eq3 := {q = 1/12 ----------------------, p = ----------, # 3 4 4 # v (C - 4 v ) C + 2 v # # 3 8 12 # C + 96 C v - 16 v # r = 1/12 ------------------------} # 3 4 4 # v (C - 4 v ) (C + 2 v ) # #This is "eq(3)" of the paper. factor(subs(eq3,eq1)); #again a zero means we did it right. # #Just for fun, try to figure out where on Heron surf. all these points are. # #Fine's curve is s^2=C*t. Express interms of pqr only: #eliminate(su1 union {eq1, s^2=C*t}, {C,s,t,u})[2][1]: #slow! Commented out! #"/p/factor(eq1+C)/expand(eq1+C-1); #we recognize a few factors, then # # 3 2 2 3 2 2 2 2 # (r - r + r q - r q - q - 3 r p - p - 2 r p q + p q + 3 r p + p q + q # # 3 3 2 2 3 2 2 # - p ) (r + r + r q - r q - q - 3 r p + p - 2 r p q + p q - q # # 2 2 3 # + 3 r p + p q - p ) # #factors(")[2]: #xx1:="[1][1]: #xx2:=""[2][1]: #factor((xx1+xx2)/2); # # 2 # (p + q - r) (- p + q + r) # #factor((xx1-xx2)/2); # # - p + q - r # #Since the above is so slow we simply verify that it's right. factor(subs(su1,(p+q-r)*(-p+q+r)^2+(p-q+r))); #this surface in s-t-u coords factor(subs(u^2=s*t/4/(s+t)/(s*t+C),")); #intersection with Heron surf #if it has -s^2+Ct as a factor, then you did OK. # #Now the curve of genus zero: one must compute either #eliminate(eq3 union {eq1}, {C,v})[2][1]; #(slow!) #Or, if you want the fast way out and expect s homogeneous cubic, do: eqx:=x1*p^3+x2*q^3+x3*r^3+x4*p^2*q+x5*q^2*r+x6*r^2*p+x7*p*q^2+x8*q*r^2+ x9*r*p^2+x10*p*q*r: yo:=numer(subs(eq3,eqx)): ss:={}: for i from 0 to 9 do ss:=ss union {coeff(yo,C,i)*v^(4*i)/v^36}: od: solve(ss union {x2=3}, {x1,x2,x3,x4,x5,x6,x7,x8,x9,x10}): subs(",[x1,x2,x3,x4,x5,x6,x7,x8,x9,x10]); # [13, 3, -5, 9, 5, 3, 7, -3, 21, 6] #So this tells you just what cubic surface contains the curve of genus zero. # #THEOREM 2 # #Sequence of transformations of coordinates taking E_1 to E_2 #(each of form (a,b) ->(a,f(a)+g(a)*c), and hence obviously invertible. # ^-- [well, 1/c for c, once]. z1:=y=r*(u*r^2+x^2)/(x^2-r^2);#separate the variables z2:=x=r*(1/w-u);#now attempt to solve quadratic for w -- need a sqrt(s): z3:=w=(2*u^2*r^4+2*r^4*u-C*u-s*r^4)/(u^2*r^4+2*r^4*u^3+2*r^4*u^2-r^4-C*u^2+C); z4:=u=X/(-2*r^4);#these two just make the lead coefficients equal to 1 z5:=s=Y/(-2*r^6); # 2 2 # r (u r + x ) # z1 := y = ------------- # 2 2 # x - r # # # z2 := x = r (1/w - u) # # # 2 4 4 4 # 2 u r + 2 r u - C u - s r # z3 := w = --------------------------------- # 2 4 4 3 4 2 # 3 u r + 2 r u - r - C u + C # # X # z4 := u = - 1/2 ---- # 4 # r # # Y # z5 := s = - 1/2 ---- # 6 # r # #the combined effect of these expresses x and y as functions of X and Y: f1:=factor(simplify(subs({z4,z5},subs(z3, z2)))): f2:=factor(simplify(subs({z4, f1}, z1))): fp:={f1, f2}: #i.e., (x,y)=fp(X,Y) = (f1, f2). Now, we can invert this to get g ... g:=solve(fp, {X,Y}): #...but it becomes easier to state using eq2 to replace C: g:=factor(simplify(g, {C=C+eq2})); # 2 2 2 2 #g := {X = - 2 r (- y r - x r + y x ), Y = 2 (x - r) (r + x) (- r + y) x r} # #This is "eq(5)" of the paper. # #What does the coordinate transform get for us? eqa:=(factor(simplify(subs(fp,eq2)))): #We will define E_2 with the factor of the numerator containing a Y. #I don't know how to say this in maple. Kludge follows. (One "qq" will = 0) fa:=factors(numer(eqa))[2]: eqb:=fa[1][1]: eqc:=fa[2][1]: qq3:=subs({r=0,C=0,X=0},eqb): qq4:=subs({r=0,C=0,X=0},eqc): (eqb*qq3+eqc*qq4)/(qq3+qq4): eq4:=factor(-"/coeff(qq3+qq4,Y,2)+Y^2)-Y^2; # 4 8 2 4 2 # eq4 := (4 C r - 4 r + X ) (C - 2 r + X) - Y # #This is "eq(4)" of the paper. # #Now we use this to simplify our f (currently using fp): factor(simplify(fp, {Y^2=Y^2+eq4})): xx:=subs(",x): yy:=subs("",y): simplify(expand(xx*subs(Y=-Y,denom(xx))),{Y^2=Y^2+eq4})/subs(Y=-Y,denom(xx)): xx2:=factor(simplify(",{Y^2=Y^2+eq4})): f:={x=xx2, y=yy}; # 4 # (2 C - 2 r + X) r Y # f := {y = ------------------, x = 1/2 ----------------} # 4 4 # 2 r - X (C - 2 r + X) r # #This is "eq(6)" of the paper. # #Just to check that f and g are inverses factor(subs(subs(f,g),X)-X):simplify(",{Y^2=Y^2+eq4}); factor(subs(subs(f,g),Y)-Y);simplify(",{Y^2=Y^2+eq4}); factor(subs(subs(g,f),x)-x);simplify(",{C=C+eq2}); factor(subs(subs(g,f),y)-y);simplify(",{C=C+eq2}); #All should come out to zero. # #Doubling formulae: draw tangent line and look for intersection with E2: w1:=subs({X=X0, Y=Y0}, eq4): w2:=subs({X=X0, Y=Y0}, diff(eq4,X)): w3:=subs({X=X0, Y=Y0}, diff(eq4,Y)): simplify((subs({X=X0+t*w3, Y=Y0-t*w2},eq4)-w1)/t^2): tt:=solve(",t): #Here are "denominator-cleared" coordinates of the doubled point -- nX:=simplify(4*Y^2*subs({X0=X,Y0=Y},simplify(X0+tt*w3)), {Y^2=Y^2+eq4}): nY:=factor(simplify(8*Y^3*subs({X0=X,Y0=Y},simplify(Y0-tt*w2)),{Y^2=Y^2+eq4})): #they are mentioned but not displayed in the paper. We _do_ use: X2:=factor(simplify(subs(g,nX/(4*Y^2)),{C=C+eq2})); # # 2 2 2 2 4 2 2 2 # (x y - y r - x - x r ) r # X2 := - ------------------------------- # 2 # x # Y2:=factor(simplify(subs(g,nY/(8*Y^3)),{C=C+eq2})); # # 2 2 2 2 2 # (r + x) (x - r) (x + y ) y r # Y2 := -------------------------------- # 3 # x #These are "eq(7)" of the paper. They give (X,Y) for 2*g(x,y). # #Points of low order. #2 g(x,y) = O iff above formulas not defined! i.e., iff x=0 #3 g(x,y) = O iff X2 = X so ord3:=numer(factor(simplify(X2-subs(g,X),{C=C+eq2}))); # 2 2 2 # ord3 := - r (x - r) (r + x) (x r - 2 y x + r y ) # ord3:=simplify(ord3/r/(x-r)/(x+r)): #4 g(x,y) = 0 iff Y2 = 0 so use that formula to see y=0 for all real points. X4:=subs(x^2=solve(expand(subs(y=0,eq2)),x^2),subs(y=0,subs(g,X))); # 4 # X4 := 2 r - 2 C #is the X coordinate of any point in image of g and of order 4. #8 g(x,y) = 0 iff X2 = X4 or 2r^4 ord8a:=numer(factor(simplify(X2-X4,{C=C+eq2}))); # # 2 2 2 2 2 2 # ord8a := (x - r) (r + x) (- x r + 2 x y - y r ) # ord8:=simplify(ord8a/(x-r)/(x+r)): ord8b:=numer(factor(simplify(X2-2*r^4))); # # 2 # ord8b := - r (x - r) (r + x) (y - x) (y + x) #These are the unnumbered equations from the section of orders. all:={x=0,y=0,ord3=0,ord8=0}: all2:=all union subs(z=x,subs(x=y,subs(y=z,all))): all3:=all2 union subs(x=-x, all2): eq8:=all3 union subs(y=-y,all3); #This is "eq(8)" of the text, except I can't get Maple to eliminate #redundant equations such as x=0 and -x=0 factor(simplify(subs({x=p+q,y=p-q},eq8))); # #GEOMETRIC DESCRIPTIONS: #Doubling in E1: factor(simplify(subs({X=X2, Y=Y2},f),{C=C+eq2})): doubl:=subs(",{x2=x,y2=y}); # 2 2 2 2 2 2 2 2 # (x + y ) r - x r + 2 x y - y r # {x2= 1/2 -----------, y2= -------------------------} # y x (y - x) (y + x) r # #Now assume r=2, and (a,b)=top vertex. WMA a>=0 and p>=q. toxy:={x=p+q,y=p-q,x2=p2+q2,y2=p2-q2}: #actually don't need abs. values and swaps here: auto's preserve {p^2,q^2} #and so at worst swap {a, -a} and hence preserve A=a^2. doub2:=factor(subs(r=2,solve(subs(toxy,doubl),{p2,q2}))): # p',q' wrt p,q toab2:={p2^2=(a2+1)^2+b^2, q2^2=(a2-1)^2+b^2}: fromab2:=solve(toab2,{a2,b^2}): A2:=subs(fromab2,a2)^2: # A' wrt p',q' doub3:=factor(subs(doub2,A2)): # A' wrt p,q doub4:=numer(doub3)/expand(denom(doub3)): # A' wrt p^2, q^2 toab:={p^2=(a+1)^2+b^2,q^2=(a-1)^2+b^2}: toAB:={a^2=A, b^2=B-1}: simplify(numer(doub4),toab)/simplify(denom(doub4), toab): # A' wrt a, b factor(simplify(numer("),{a^2=A})/simplify(denom("),{a^2=A})): factor(simplify(numer("),{b^2=B-1})/simplify(denom("),{b^2=B-1})): doub5:="; # A' wrt A, B #That's the doubling formula presented: # 2 2 # (A - B) (A + B) # doub5 := 1/4 --------------------------- # 2 2 # A (- 4 A + A + 2 A B + B ) #Equilibrium pts: cv3:=expand(subs(A=B*x,A*denom(doub5)-numer(doub5))/B^4); #That's it -- recall B = b^2+1, and a=A^(1/2)=(xB)^(1/2). Roots? factor(subs(B=1,cv3)); #Finds x along horiz. axis must be 1 factor(subs(z=0,subs(B=1/z,cv3))); #Finds x as top (b) -> oo : x=1/3. #"The real root decreases" since dx/dB < 0: indeed, it's -(dF/dB)/(dF/dx) factor(-diff(cv3,B)/diff(cv3,x)); #First look at it; then... solve(denom(")/B,B); #shows it's never zero, so dx/dB can't change sign: factor(subs(B=",cv3)); #See? you'd need x=1, i.e. B=1 (b=0). #Note: the curve of equilibrium points is illustrated using this parameteriz: B0:=factor(solve(cv3,B)): b2:=factor(B0-1): a2:=factor(x*B0): a2:=subs(x=xi,a2):b2:=subs(x=xi,b2): for i from 1 to 10 do xi:=(1/3)*(i/10)+1*(1-i/10): pt[i]:=evalf([sqrt(a2),sqrt(b2)]);od; #For proper sketching with xfig splines, watch tangent at horizontal axis. # #Check to see equilibrium points really are the points of order 3: #(use 1/Q for B to make everything a polynomial) eliminate({a^2*Q=x,subs(B=1/Q,cv3),(b^2+1)*Q=1} union toab,{a,b,x,Q}): #shows three possibilities. What conditions on (p,q) allow solutions? "[1][2][1]*"[2][2][1]*"[3][2][1]: factors(")[2]: #there are four: they read (p^2-q^2)*(+-p +q) +- (2)*(p^2+q^2) {"[1][1],"[2][1],"[3][1],"[4][1]}; #which is the order-3 condition. # #Order-8 condition: toxya:={x=subs(toxy,x),y=subs(toxy,y)}: eliminate(toxya union toab union {subs(r=2,ord8)}, {x,y,p,q,C})[2][1]/a/b; #..., the hyperbola. # #THEOREM 3a # #Unlike the development of the f and g in theorem 2, we simply verify here #that the proposed substitutions work. They were developed in tandem with APECS eqx:=-Y^2+X^3+4*C*X: topq:=subs(p=q,{X=2*r*(p+q+r),Y=4*r^2*(p+q+r)}): subs(Y^2=Y^2+eqx,solve(",{q,r})); #recovers p,q factor(subs(topq,eqx)): factor(simplify(",{C=C+subs(p=q,eq1)})); #A zero means (X,Y) is on the curve. #Statement that Y^2=X^3+4CX has no torsion except pts of order 2: #It _does_ have order2 pts, so just check to see if there can be _rational_ #pts of order 3,4,5 eq0:=subs({X=X0,Y=Y0},eqx): factor((subs({X=X0+t,Y=Y0+m*t},eqx)-eq0)/t): solve(subs(t=0,"),m): solve(subs(m=","")/t,t): doub:=factor(subs({m="",t="},{XX2=X0+t,YY2=Y0+m*t})):#so (XX2,YY2)=2*(X,Y) #order3: need XX2=X. factor(simplify(numer(subs(doub,XX2)-X0),{Y0^2=Y0^2+eq0})); #order4: need YY2=0. factor(simplify(numer(subs(doub,YY2)),{Y0^2=Y0^2+eq0})); #order5: X-coord of double of double of (X0,Y0) would be X0. factor(subs({X0=subs(doub,XX2),Y0=subs(doub,YY2)},doub)): factor(numer(subs(",XX2)-X0)): factor(simplify(",{Y0^2=Y0^2+eq0})); #In all 3 cases, no rational roots for _negative, rational_ C. Try e.g.this: solve(factor(simplify(",{X0^2=Q*C})),Q); #(note:x0^2=4*C is no good either!) # #THEOREM 3b eqx:=C*Y^4+X^2*(X^2-1)^3*(3*X^2+1); topq:={Y=2*(p^2+q^2)/(p-q)^3,X=(p+q)/(p-q)}: solve(topq,{p,q}); # shows the substitution is invertible factor(simplify(subs(topq,eqx),{C=C+eq1})): factors(numer("))[2]:# there are three! {"[1][1],"[2][1],"[3][1]}; #But two we recognize, viz: factor({"[1]-(q-p)*(p+q)^2,"[2]-(q-p)*(p+q)^2,"[3]-(q-p)*(p+q)^2}); ""[2]; #this is the oddball in my current Maple session; your mileage may vary #It arises as follows: from (XY) get (pq) as above, then find r from eq1 #two values (+-r0) are the ones meeting the order-3 condition; other two (+-) #have r^2 = 2(p^2+q^2)-r0^2. By law of cosines this other r comes from #replacing the edge of length q by its reflection across the perpendicular #with p # #THEOREM 3c eliminate({subs(toxy,ord8), eq1},r)[2][1]; factor(solve(",C)); # shows -C a square factor(subs(C=-cc^2,"")); factor(subs({X=q/p,Y=cc*(p^2+q^2)/p^3},-Y^2+2*cc*(X^5-X))); gcd(numer("),""); # common factor shows the solutions are right. factor(solve(",cc)); su:={p=2*m*(m^2+1)*d,q=(m^4-1)*d,r=(m^4-6*m^2+1)*d}; factor(subs(su,"")); #that's the parameterization of cc's expand("/4/d^2); factor(subs(su,subs(toxy,ord8))); # should get zero #By the way, the parameterization is invertible: factor(subs(su,(r*q-p^2+q^2)/(r*p))); #there's m; now get d from p say. # #THEOREM 3d factor(solve(cv3,B)); #parameterization of B from x. Thus a^2=A=xB= "*x; # and b^2=B-1= factor(subs(""-1)); #y^2=quadratic is well-known to be parameterizable. Just make sure we got it OK su:={x=(m^2+1)/(m^2+4*m+1)}; factor(subs(su,(3*x-1)*(x+1))); #good, so a^2=square factor(subs(su,(3*x+1)*(x-1)));# clearly requires numer("/16); #to be a square too. Here's a form better for APECS: expand(subs(m=-m,")); #so do Ein(0,-1,0,1,0); Rk(); subs(m=0,su);subs(m=1,su);subs(m=-1,su);#shows x=1/3, +-1 (and x=-1/3 if 0=1/m) # solve(subs({p=29/8,q=11/8,r=3},eq1),C); # -63 is the right "area" subs({p=10,q=5,r=9},subs(toxy,ord3)); # "0" means condition is satisfied. subs({p=15,q=20,r=7},subs(toxy,ord8)); # #THEOREM 4 # r2:=p-q: r3a:=simplify(subs({x=p+q,y=p-q}, ord3)): r3b:=simplify(subs({x=p+q,y=q-p}, ord3)): r8:=simplify(subs({x=p+q,y=p-q}, ord8)): q2:=p-r: q3a:=subs(z=r,subs(r=q,subs(q=z,r3a))): q3b:=subs(z=r,subs(r=q,subs(q=z,r3b))): q8:=subs(z=r,subs(r=q,subs(q=z,r8))): #e22 would mean p=q=r: equilateral. e23a:=numer(factor(simplify(subs(q=p,q3a)))); # isosc + order-3 [can draw, not rational] # 2 2 # e23a := - 2 r (2 r p - p + r ) # e23b:=numer(factor(simplify(subs(q=p,q3b)))); # 3 2 3 # e23b := - 4 p - 2 r p + 2 r # e28:=numer(factor(simplify(subs(q=p,q8)))); # isosc. + order-8: can draw, not rational # 2 2 2 # e28 := 2 r (- 3 p + r ) # e3a3a:=numer(factor(simplify(subs(r=solve(r3a,r),q3a)))); #order-3 two ways # 2 2 2 3 2 3 # e3a3a := - 4 p q (p - q) (3 p + 2 p q + q ) (p - p q - 2 q ) #This is the one cited in the text as an example. # e3a3b:=numer(factor(simplify(subs(r=solve(r3a,r),q3b)))); # #e3a3b := # # 7 6 5 2 4 3 3 4 2 5 6 7 # 4 q (p + q) (p - 4 p q - 3 p q - p q + 3 p q + 2 p q - p q - q ) # e3a8:=numer(factor(simplify(subs(r=solve(r3a,r),q8)))); # order-3 + order-8: see Th 3(b,c) # # 2 # e3a8 := 4 p q (p + q) (p - q) # # 7 6 5 2 4 3 3 4 2 5 6 7 # (p - 7 p q - 5 p q + p q + 11 p q + 7 p q + p q - q ) # e3b3b:=numer(factor(simplify(subs(r=solve(r3b,r),q3b)))); # # 2 2 4 3 3 4 # e3b3b := - 4 p q (p + q) (p + 2 p q - q ) (p - p q + q p + q ) # e3b8:=numer(factor(simplify(subs(r=solve(r3b,r),q8)))); # # 2 # e3b8 := 4 p q (p + q) (p - q) # # 7 6 5 2 4 3 3 4 2 5 6 7 # (p - 7 p q - 5 p q + p q + 11 p q + 7 p q + p q - q ) # subs(r^4=solve(r8,r^2)^2,q8): e88:=numer(factor(simplify(subs(r^2=solve(r8,r^2),")))); # 2 2 2 2 # e88 := - 4 p q (p - q) (p + q) (p - 3 q ) # #Note: the real roots of the various curves shown above (none rational) lead #to triangles which (after scaling) have two different rotations with top #vertex on one of the three families' special curves. For example, e28 has #a root p=r/sqrt(3) from which we deduce that the triangle (2/sqrt3,2/sqrt3,2) #is isosceles and yet when rotated so that q is the base, gives (after #scaling) the triangle (2, 2sqrt3, 2) on the order-3 curve. These triangles #have top vertices (a,b) where a=(p^2-q^2)/4=0 and 2, respectively, and #b=sqrt3/3, sqrt3 respectively. These two points are labelled "d" in the #illustration. Here are the other labelled points, found likewise: #a=(0, 0.87) -- equilateral ("e22") #b=(0, 0.85), (1.35, 1.98) -- "e23" #c=(0, 4.72), (0.83, 0.81) -- "e23" #d=(0, 0.58), (1.35, 1.98) -- "e28" #e=(0.73, 0.32), (4.92, 8.45) -- "e33" #f=(0.82, 0.16), (11.24, 11.27) -- "e38" #g=(0.77, 0.44), (1.13, 0.53) -- "e38" #h=(2.54, 4.25), (1.30, 0.83) -- "e38" #Other roots led to triangles which are isosceles (e.g. are "e88" but only #by "cheating"). # #The curve for equilateral triangles is, up to scaling, expand(subs({C=solve(subs({p=1,q=1,r=1},eq1),C),r=1},eq4)); # #THEOREM 5a # eq4a:=factor(subs({C=lambda,r=1},eq4)): #Assuming coeff(eq4,X,3)=1 we do... co0:=coeff(expand(eq4a+Y^2),X,0): co1:=coeff(expand(eq4a),X,1): co2:=coeff(expand(eq4a),X,2): eqz:=simplify(subs(X=W-co2/3,eq4a)): aa:=factor(coeff(expand(eqz), W, 1)): bb:=factor(coeff(expand(eqz)+Y^2, W, 0)): Y^2=W^3+aa*W+bb: #Now compute the usual invariants: delta:=factor(-16*(4*aa^3+27*bb^2)); j:=factor(-1728*(4*aa)^3/delta); # # 2 3 # (16 - 16 lambda + lambda ) # j := - 16 --------------------------- # 4 # lambda (- 1 + lambda) # factor(subs(lambda=lambda/(lambda-1),")-"); # 0 shows j is sigma-invariant eq10:=u=lambda^2/(16*(lambda-1)); # # 2 # lambda # eq10 := u = ---------------- # - 16 + 16 lambda #This is "eq(10)" of the paper. eliminate({jj=j,eq10},lambda)[2][1]: factor(solve(",jj)); # # 3 # (u - 1) # - 256 -------- # 2 # u # -numer(factor("-subs(u=u2,")))/256; # 2 2 # (u - u2) (u u2 + u - 3 u u2 + u2) # eliminate({"/(u-u2),sx=u+u2,px=u*u2},{u,u2})[2][1]; # # 2 # sx - 3 px + px # factor(subs(s=3*px-px^2,s^2-4*px)); # 2 # px (- 4 + px) (px - 1) # #The parameterization techniques to make this a square are well known. factor(subs(px=(t+1)^2/t,subs(sx=3*px-px^2,u^2-sx*u+px))); # # 2 2 # (t + t + u) (u t + t + 1) # --------------------------- # 2 # t # u1:=factor(solve(",u)[1]); # # u1 := - t (t + 1) # u2:=factor(solve("",u)[2]); # # t + 1 # u2 := - ----- # 2 # t numer(factor(u2-rhs(eq10))): factor(coeff(",lambda,1)^2-4*coeff(",lambda,0)*coeff(",lambda,2)); # # 2 # 64 (t + 1) (t + 2) # numer(factor(u1-rhs(eq10))): factor(coeff(",lambda,1)^2-4*coeff(",lambda,0)*coeff(",lambda,2)); # # 2 # 64 t (t + 1) (1 + 2 t) # #Here's how to make both be squares: solve(subs(u=subs(t=((1-s^2)/(2*s))^2,u1),eq10),lambda): simplify({"[1],"[2]}); # # 4 # 4 - 1 + s # {1 - s , --------} # 4 # s solve(subs(u=subs(t=((1-s^2)/(2*s))^2,u2),eq10),lambda): factor({"[1],"[2]}); # # 2 2 # (s + 1) s (s + 1) s # {8 ----------, - 8 ----------} # 4 4 # (s + 1) (s - 1) expand(simplify(subs(s=(t+1)/(t-1),"))); # # 1 4 # {1 - ----, - t + 1} # 4 # t #THEOREM 5b # factor(subs(lambda=1-s^4,eq4a)): eq4b:=factor("+Y^2)-Y^2; # # 2 4 2 2 # (X + 2 s ) (s + 1 - X) (- X + 2 s ) - Y factor(subs({Y=I*(s-1)^6*Yp/8,X=-(s-1)^4*Xp/4+(s^2+1)^2/2},eq4b)): -numer(factor(subs(s=(t+1)/(t-1),")))/64; # # 3 2 2 2 4 4 8 4 # Xp - Yp - Xp - Xp t - 4 Xp t + 4 t + 4 t # factor("+Yp^2)-Yp^2; # # 2 2 4 2 # (Xp + 2 t ) (Xp - 2 t ) (Xp - t - 1) - Yp # #OK, so they're Q(i)-isomorphic. Modify substitutions a little over Q: factor(subs({Y=(s-1)^6*Yp/8,X=(s-1)^4*Xp/4-(s^2+1)^2/2},eq4b)): numer(factor(subs(s=(t+1)/(t-1),")))/64: factor("+Yp^2)-Yp^2; # # 2 4 4 2 2 # (Xp - 1 - 4 t - t ) (Xp - 1 - t ) (Xp - 2 t ) - Yp # # #THEOREM 5e numer(factor(subs({Y=u*s^2/(s-1)^2,X=s/2},-Y^2+X^3-4*X))); solve(",u^2); #checks out! #Some other things I've done with maple but didn't record here: # #Show that the 8 symmetries are of the form #p -> +-p+e for some e among the subgroup of order 4 # #Verify substitutions mentioned in closing paragraphs # #compute some points for curves in illustration # (example of for-loop given above) # #plot({[(a2)^(1/2),(b2)^(1/2), x=0.35 .. 1], # [cos(t),sin(t),t=0..Pi/2],[(t+1/t)/2,(t-1/t)/2,t=1..4]}); #makes Maple do the work to plot the curves # #ETC!