//--------------------------------------------------- // D21 : Heron triangles with two rational medians // Ralph Buchholz //--------------------------------------------------- Z := Integers(); doh := procedure() print "ABKLT(P) --> generates orbit of P"; end procedure; // new Dual Hayes parameters new_delta := function(theta,phi) Theta := (theta*phi+2*phi^2-theta-phi-1)/(3*theta*phi+theta-phi+1); Phi := (-2*theta^2-theta*phi-theta-phi+1)/(3*theta*phi+theta-phi+1); return Theta,Phi; end function; // negative Hayes parameters nu := function(theta,phi) return -phi,-theta; end function; // half dual Hayes parameters chi := function(theta,phi) Theta := (theta*phi+2*phi^2-theta-phi-1)/(3*theta*phi+theta-phi+1); return Theta,phi; end function; // half dual Hayes parameters chi_theta := function(theta,phi) Theta := (2*theta^2+theta*phi+theta+phi-1)/(3*theta*phi+theta-phi+1); return Theta,-theta; end function; // half dual Hayes parameters chi_phi := function(theta,phi) Phi := (-theta*phi-2*phi^2+theta+phi+1)/(3*theta*phi+theta-phi+1); return -phi,Phi; end function; // Old Dual Hayes parameters delta := function(theta,phi) Theta := (2*theta^2+theta*phi+theta+phi-1)/(3*theta*phi+theta-phi+1); Phi := (-theta*phi-2*phi^2+theta+phi+1)/(3*theta*phi+theta-phi+1); return Theta,Phi; end function; // interchange the sign of a signa := function(theta,phi) Theta := (1-theta)/(1+theta); Phi := -1/phi; return Theta,Phi; end function; // interchange the sign of b signb := function(theta,phi) Theta := -1/theta; Phi := (phi+1)/(phi-1); return Theta,Phi; end function; // generate all Hayes parameters hayes_group := function(theta,phi) t1,p1 := Explode([theta,phi]); t2,p2 := delta(t1,p1); t3,p3 := chi(t1,p1); t4,p4 := delta(t3,p3); t5,p5 := nu(t1,p1); t6,p6 := nu(t2,p2); t7,p7 := nu(t3,p3); t8,p8 := nu(t4,p4); orbit1:= [[t1,p1],[t2,p2],[t3,p3],[t4,p4],[t5,p5],[t6,p6],[t7,p7],[t8,p8]]; t9,p9 := signa(t1,p1); tA,pA := delta(t9,p9); tB,pB := chi(t9,p9); tC,pC := delta(tB,pB); tD,pD := nu(t9,p9); tE,pE := nu(tA,pA); tF,pF := nu(tB,pB); tG,pG := nu(tC,pC); orbit2:= [[t9,p9],[tA,pA],[tB,pB],[tC,pC],[tD,pD],[tE,pE],[tF,pF],[tG,pG]]; tH,pH := signb(t1,p1); tI,pI := delta(tH,pH); tJ,pJ := chi(tH,pH); tK,pK := delta(tJ,pJ); tL,pL := nu(tH,pH); tM,pM := nu(tI,pI); tN,pN := nu(tJ,pJ); tO,pO := nu(tK,pK); orbit3:= [[tH,pH],[tI,pI],[tJ,pJ],[tK,pK],[tL,pL],[tM,pM],[tN,pN],[tO,pO]]; tP,pP := signb(t9,p9); tQ,pQ := delta(tP,pP); tR,pR := chi(tP,pP); tS,pS := delta(tR,pR); tT,pT := nu(tP,pP); tU,pU := nu(tQ,pQ); tV,pV := nu(tR,pR); tW,pW := nu(tS,pS); orbit4:= [[tP,pP],[tQ,pQ],[tR,pR],[tS,pS],[tT,pT],[tU,pU],[tV,pV],[tW,pW]]; return orbit1 cat orbit2 cat orbit3 cat orbit4; end function; // Hayes parameters to sides hayes2sides := function(theta,phi) a := (-2*phi*theta^2-phi^2*theta)+(2*theta*phi-phi^2)+theta+1; b := (phi*theta^2+2*phi^2*theta)+(2*theta*phi-theta^2)-phi+1; c := (phi*theta^2-phi^2*theta)+(theta^2+2*theta*phi+phi^2)+theta-phi; A := Denominator(a); B := Denominator(b); C := Denominator(c); l := Lcm([A,B,C]); a,b,c := Explode([Z!(a*l),Z!(b*l),Z!(c*l)]); g := Gcd([a,b,c]); return [a div g,b div g,c div g]; end function; // Sides to Hayes parameters sides2hayes := function(a,b,c) k := 2*a^2+2*c^2-b^2; l := 2*b^2+2*c^2-a^2; if (IsSquare(k)) then t1 := (c-a+Isqrt(k))/(a+b+c); t2 := (c-a-Isqrt(k))/(a+b+c); else t1 := (c-a+Sqrt(k))/(a+b+c); t2 := (c-a-Sqrt(k))/(a+b+c); end if; if (IsSquare(l)) then p1 := (b-c+Isqrt(l))/(a+b+c); p2 := (b-c-Isqrt(l))/(a+b+c); else p1 := (b-c+Sqrt(l))/(a+b+c); p2 := (b-c-Sqrt(l))/(a+b+c); end if; return [t1,p1],[t2,p2],[t1,p2],[t2,p1]; end function; area_septic := function(theta,phi) P := PolynomialRing(Rationals(),2); gamma := x*y*(1-x^2)*(1-y^2)*(3*x*y+x-y+1)*(2*x+y-1)*(x+2*y+1)*(x-y+1); g := Evaluate(gamma,[theta,phi]); return g; end function; A := function(P) theta,phi := Explode(P); Ax := -(-theta*phi-theta+phi^2-1)/(2*theta-1+phi)/phi; Ay := (3*theta*phi+theta+1-phi)/(2*theta^2+theta*phi+theta+phi-1); return ; end function; B := function(P) theta,phi := Explode(P); Bx := -(3*theta*phi+theta+1-phi)/(theta*phi+2*phi^2-phi-1-theta); By := -(-phi+theta*phi-theta^2+1)/(2*phi+theta+1)/theta; return ; end function; C := function(P) theta,phi := Explode(P); Cx := (2*theta-1+phi)*phi/(-theta*phi-theta+phi^2-1); Cy := (2*phi+theta+1)*theta/(-phi+theta*phi-theta^2+1); return ; end function; K := function(P) theta,phi := Explode(P); Kx := theta; Ky := -(2*theta^2+theta*phi+theta+phi-1)/(3*theta*phi+theta+1-phi); return ; end function; L := function(P) theta,phi := Explode(P); Lx := (theta*phi+2*phi^2-phi-1-theta)/(3*theta*phi+theta+1-phi); Ly := phi; return ; end function; T := function(P) theta,phi := Explode(P); Tx := (2*theta^2+theta*phi+theta+phi-1)/(3*theta*phi+theta+1-phi); Ty := -(theta*phi+2*phi^2-phi-1-theta)/(3*theta*phi+theta+1-phi); return ; end function; ABKLT := function(P) image := []; Append(~image,P); Append(~image,T(P)); Append(~image,L(P)); Append(~image,T(L(P))); Append(~image,K(P)); Append(~image,T(K(P))); Append(~image,L(K(P))); Append(~image,T(L(K(P)))); Append(~image,B(P)); Append(~image,T(B(P))); Append(~image,L(B(P))); Append(~image,T(L(B(P)))); Append(~image,K(B(P))); Append(~image,T(K(B(P)))); Append(~image,L(K(B(P)))); Append(~image,T(L(K(B(P))))); Append(~image,A(P)); Append(~image,T(A(P))); Append(~image,L(A(P))); Append(~image,T(L(A(P)))); Append(~image,K(A(P))); Append(~image,T(K(A(P)))); Append(~image,L(K(A(P)))); Append(~image,T(L(K(A(P))))); Append(~image,B(A(P))); Append(~image,T(B(A(P)))); Append(~image,L(B(A(P)))); Append(~image,T(L(B(A(P))))); Append(~image,K(B(A(P)))); Append(~image,T(K(B(A(P))))); Append(~image,L(K(B(A(P))))); Append(~image,T(L(K(B(A(P)))))); return image; end function; lines := function(points) Q := [1,-1]; lines := []; for P in points do m := (P[2]-Q[2])/(P[1]-Q[1]); b := Q[2]-m*Q[1]; Append(~lines,); end for; return lines; end function; smallest := function(list) min := Max(Abs(Numerator(list[1,2])),Abs(Denominator(list[1,2]))); P_min := list[1]; for P in list do t := Max(Abs(Numerator(P[2])),Abs(Denominator(P[2]))); if (t lt min and Abs(P[2]) lt 1) then P_min := P; min := t; end if; end for; return P_min; end function; C1 := function(x,y) f := 27*x^3*y^3-x*y*(x-y)*(8*x^2+11*x*y+8*y^2)-3*x*y*(5*x^2-x*y+5*y^2); f := f-(x-y)*(x^2+4*x*y+y^2)-3*x^2+7*x*y-3*y^2-3*x+3*y-1; if (f eq 0) then return true; else return false; end if; end function; C2 := function(x,y) f := 3*x^2*y^2-2*x*y*(x-y)-x^2-6*x*y-y^2+1; if (f eq 0) then return true; else return false; end if; end function; C3 := function(x,y) f := x*y*(x-y)^3-x^4-11*x^3*y-3*x^2*y^2-11*x*y^3-y^4-2*x^3+2*y^3; f := f+10*x*y+2*x-2*y+1; if (f eq 0) then return true; else return false; end if; end function; C4 := function(t,f) if (t*f*(t-f)+t*f+2*(t-f)-1 eq 0) then return true; else return false; end if; end function; C5 := function(x,y) f := (x-1)^3*y^2+2*(x+1)*(x^3+2*x^2-2*x+1)*y+(2*x-1)*(x+1)^3; if (f eq 0) then return true; else return false; end if; end function; C6 := function(x,y) f := y^4+2*x*y^3-y^3-3*y^2*x-3*y*x^2-2*x*y-x-x^2; if (f eq 0) then return true; else return false; end if; end function; C7 := function(x,y) f := 2*y^4*x-2*y^4+x^2*y^3-6*x*y^3+5*y^3+3*x^2*y^2-3*y^2; f := f+3*y*x^2+2*x*y-y+x^2+2*x+1; if (f eq 0) then return true; else return false; end if; end function; C8 := function(x,y) f := 3*y^2*x-y^2+3*y*x^2-2*x*y+2*x^3*y+y+x^3+x^4; if (f eq 0) then return true; else return false; end if; end function; is_sporadic := function(theta,phi) orbit := ABKLT(); for P in orbit do x,y := Explode(P); if (C1(x,y) or C2(x,y) or C3(x,y) or C4(x,y) or C5(x,y) or C6(x,y) or C7(x,y) or C8(x,y)) then return false; end if; end for; return true; end function; //-------------------------------------------------------------------- // Eulerian 3 median parametrization eulerian_3med := function(x) a := (2*x*(-9*x^4+10*x^2+3)); b := ((9*x^4-6*x^2+1)-x*(9*x^4+26*x^2+1)); c := ((9*x^4-6*x^2+1)+x*(9*x^4+26*x^2+1)); p := (a+b+c); A2 := p*(p-2*a)*(p-2*b)*(p-2*c); return A2; end function; // --- create naive curve print "\n------Model------"; P := PolynomialRing(Integers()); Q := PolynomialRing(Rationals(),2); f := eulerian_3med(x) div x^2; h := hom |
misc >