(* This file is for the following artice: Tetsuya ANDO, Some Cubic and Quartic Inequalities of Four Variables. Copy and past suitable part, and test by Mathematica. *) (*---------------------------- Theorem 1.1 ----------------------------------*) sigma1[a_,b_,c_,d_]:=a+b+c+d sigma2[a_,b_,c_,d_]:=a b+a c+a d+b c+b d+c d sigma3[a_,b_,c_,d_]:=b c d + a c d + a b d + a b c sigma4[a_,b_,c_,d_]:=a b c d S4[x0_,x1_,x2_,x3_]:=x0^4+x1^4+x2^4+x3^4 T31[x0_,x1_,x2_,x3_]:=x0^3(x1+x2+x3)+x1^3(x0+x2+x3)+x2^3(x0+x1+x3)+x3^3(x0+x1+x2) S22[x0_,x1_,x2_,x3_]:=x0^2x1^2+x0^2x2^2+x0^2x3^2+x1^2x2^2+x1^2x3^2+x2^2x3^2 T211[x0_,x1_,x2_,x3_]:=x0^2(x1 x2+x1 x3+x2 x3)+x1^2(x0 x2+x0 x3+x2 x3)+x2^2(x0 x1+x0 x3+x1 x3)+x3^2(x0 x1+x0 x2+x1 x2) U[x0_,x1_,x2_,x3_]:=x0 x1 x2 x3 S3[x0_,x1_,x2_,x3_]:=x0^3+x1^3+x2^3+x3^3 S2[x0_,x1_,x2_,x3_]:=x0^2+x1^2+x2^2+x3^2 S1[x0_,x1_,x2_,x3_]:=x0+x1+x2+x3 T21[x0_,x1_,x2_,x3_]:=x0^2(x1+x2+x3)+x1^2(x0+x2+x3)+x2^2(x0+x1+x3)+x3^2(x0+x1+x2) S111[x0_,x1_,x2_,x3_]:=x1 x2 x3 + x0 x2 x3 + x0 x1 x3 + x0 x1 x2 S11[x0_,x1_,x2_,x3_]:=x0 x1+x0 x2+x0 x3+x1 x2+x1 x3+x2 x3 Expand[(sigma1[a, b, c, d])^4 - (S4[a, b, c, d] + 4 T31[a, b, c, d] + 6 S22[a, b, c, d] + 12 T211[a, b, c, d] + 24 U[a, b, c, d])] Expand[(sigma1[a, b, c, d])^2 sigma2[a, b, c, d] - (T31[a, b, c, d] + 2 S22[a, b, c, d] + 5 T211[a, b, c, d] + 12 U[a, b, c, d])] Expand[(sigma2[a, b, c, d])^2 - (S22[a, b, c, d] + 2 T211[a, b, c, d] + 6 U[a, b, c, d])] Expand[sigma1[a, b, c, d] sigma3[a, b, c, d] - (T211[a, b, c, d] + 4 U[a, b, c, d])] (* sigma1^4 == S4 + 4 T31 + 6 S22 + 12 T211 + 24 U, sigma1^2 sigma2 == T31 + 2 S22 + 5 T211 + 12 U, sigma2^2 == S22 + 2 T211 + 6 U, sigma1 sigma3 == T211 + 4 U, sigma4 == U *) Solve[{sigma1^4 == S4 + 4 T31 + 6 S22 + 12 T211 + 24 U, sigma1^2 sigma2 == T31 + 2 S22 + 5 T211 + 12 U, sigma2^2 == S22 + 2 T211 + 6 U, sigma1 sigma3 == T211 + 4 U, sigma4 == U}, {S4, T31, S22, T211, U}] (* S4 == sigma1^4 - 4 sigma1^2 sigma2 + 2 sigma2^2 + 4 sigma1 sigma3 - 4 sigma4, T31 == sigma1^2 sigma2 - 2 sigma2^2 - sigma1 sigma3 + 4 sigma4, S22 == sigma2^2 - 2 sigma1 sigma3 + 2 sigma4, T211 == sigma1 sigma3 - 4 sigma4, U == sigma4 *) (*---------------------------- Theorem 1.2 ----------------------------------*) (* ${\frac g}_t$ *) FrakGt[a_,b_,c_,d_,t_] := (1/3)(3 sigma1[a,b,c,d]^4 - 2(t+7) sigma1[a,b,c,d]^2 sigma2[a,b,c,d] + (t+3)^2 sigma2[a,b,c,d]^2 - 2(t^2-9) sigma1[a,b,c,d] sigma3[a,b,c,d] - 4(t+3)^2 sigma4[a,b,c,d]) (* ${\frac g}_{\infty}$ *) FrakGi[a_,b_,c_,d_] := sigma2[a,b,c,d]^2 - 2 sigma1[a,b,c,d] sigma3[a,b,c,d] - 4 sigma4[a,b,c,d] (* ${\frac p}$ *) FrakP[a_,b_,c_,d_] := sigma2[a,b,c,d]^2 - 3 sigma1[a,b,c,d] sigma3[a,b,c,d] + 12 sigma4[a,b,c,d] s0[a_,b_,c_,d_] := S4[a,b,c,d] - 4 U[a,b,c,d] (* = sigma1^4 - 4 sigma1^2 sigma2 + 2 sigma2^2 + 4 sigma1 sigma3 - 8 sigma4 *) s1[a_,b_,c_,d_] := T31[a,b,c,d] - 12 U[a,b,c,d] (* = sigma1^2 sigma2 - 2 sigma2^2 - sigma1 sigma3 - 8 sigma4 *) s2[a_,b_,c_,d_] := S22[a,b,c,d] - 6 U[a,b,c,d] (* = sigma2^2 - 2 sigma1 sigma3 - 4 sigma4 *) s3[a_,b_,c_,d_] := T211[a,b,c,d] - 12 U[a,b,c,d] (* = sigma1 sigma3 - 16 sigma4 *) s4[a_,b_,c_,d_] := U[a, b, c, d] Expand[3 FrakGt[a,b,c,d,t] - (3 s0[a,b,c,d] - 2(t+1) (s1[a,b,c,d] - s3[a,b,c,d]) + (t^2+2t-1) s2[a,b,c,d])] Factor[FrakGt[x,1,1,1,t]] (* = (t-x)^2(x-1)^2 *) Factor[FrakGt[x,x,1,1,t]] (* = (1/3)(t-1)^2(x-1)^2(x+1)^2 *) Factor[FrakGt[0,0,0,1,t]] (* = 1 *) Expand[FrakGi[a,b,c,d] - s2[a,b,c,d]] Factor[FrakGi[-1, -1, 1, 1]] Factor[FrakGi[1, 0, 0, 0]] Expand[FrakP[a,b,c,d] - (s2[a,b,c,d] - s3[a,b,c,d])] Factor[FrakP[x,1,1,1]] (* = 0 *) Factor[FrakP[x,x,1,1]] (* = (x-1)^4 *) Factor[FrakP[0,0,0,1]] (* = 0 *) (*---------------------------- Corollary 1.3 ----------------------------------*) Expand[3 FrakGt[a,b,c,d,t] - ((a^2+b^2-c^2-d^2 + (t+1)(c d-a b))^2 + (a^2-b^2+c^2-d^2 + (t+1)(b d-a c))^2 + (a^2-b^2-c^2+d^2 + (t+1)(b c-a d))^2)] Expand[FrakGt[a,b,c,d,t] - (1/12)( (a-b)^2(2(a+b)-(t+1)(c+d))^2 + (a-c)^2(2(a+c)-(t+1)(b+d))^2 + (a-d)^2(2(a+d)-(t+1)(c+b))^2 + (b-c)^2(2(b+c)-(t+1)(a+d))^2 + (b-d)^2(2(b+d)-(t+1)(a+c))^2 + (c-d)^2(2(c+d)-(t+1)(a+b))^2)] Expand[FrakGi[a,b,c,d] - ((a b-c d)^2 + (a c-b d)^2 + (a d-b c)^2)] Expand[FrakP[a,b,c,d] - (1/2)((a-b)^2(c-d)^2 + (a-c)^2(b-d)^2 + (a-d)^2(b-c)^2)] (*---------------------------- Theorem 1.4 ----------------------------------*) (* {\frak f}_t^{ab} *) FrakFtab[a_,b_,c_,d_,t_] := (1/3)(3sigma1[a,b,c,d]^4 - 2(t+7) sigma1[a,b,c,d]^2 sigma2[a,b,c,d] + 8(t+1) sigma2[a,b,c,d]^2 + (t^2 - 6 t + 21) sigma1[a,b,c,d] sigma3[a,b,c,d] - 16(t^2+3) sigma4[a,b,c,d] ) (* {\frak f}_t^c *) FrakFtc[a_,b_,c_,d_,t_] := (1/9)(9 sigma1[a,b,c,d]^4 - 6(t+7) sigma1[a,b,c,d]^2 sigma2[a,b,c,d] + (t+7)^2 sigma2[a,b,c,d]^2 + 12(t-1)sigma1[a,b,c,d] sigma3[a,b,c,d] -12(t-1)(3t+13) sigma4[a,b,c,d] ) (* {\frak p} *) FrakP[a_,b_,c_,d_] := sigma2[a,b,c,d]^2 - 3 sigma1[a,b,c,d] sigma3[a,b,c,d] + 12 sigma4[a,b,c,d] (* {\frak q}_1 *) FrakQ1[a_,b_,c_,d_] := sigma1[a,b,c,d]^2 sigma2[a,b,c,d] - 4 sigma2[a,b,c,d]^2 + 3 sigma1[a,b,c,d] sigma3[a,b,c,d] (* {\frak q}_2 *) FrakQ2[a_,b_,c_,d_] := sigma1[a,b,c,d] sigma3[a,b,c,d] - 16 sigma4[a,b,c,d] Expand[FrakFtab[a,b,c,d,t] - (1/3)(3 s0[a,b,c,d] - 2(t+1) s1[a,b,c,d] + 2(2t-1) s2[a,b,c,d] + (t^2+3) s3[a,b,c,d])] Expand[FrakFtc[a,b,c,d,t] - (1/9)(9 s0[a,b,c,d] - 6(t+1) s1[a,b,c,d] + (t^2+2t+19)s2[a,b,c,d] + 2(t^2+5t-8) s3[a,b,c,d])] Expand[FrakQ1[a,b,c,d] - (s1[a,b,c,d] - 2 s2[a,b,c,d])] Expand[FrakQ2[a,b,c,d] - s3[a,b,c,d]] Expand[FrakQ1[a,b,c,d] - (a b(a-b)^2 + a c(a-c)^2 + a d(a-d)^2 + b c(b-c)^2 + b d(b-d)^2 + c d(c-d)^2)] Expand[FrakQ2[a,b,c,d] - (a b(c-d)^2 + a c(b-d)^2 + a d(b-c)^2 + b c(a-d)^2 + b d(a-c)^2 + c d(a-b)^2)] Factor[FrakFtab[t,1,1,1,t]] Factor[FrakFtab[0,0,1,1,t]] Factor[FrakFtc[t,1,1,1,t]] Factor[FrakFtc[0, 0, (1+t+Sqrt[t^2+2t-35])/6, 1, t]] Factor[FrakFtc[0, 0, u, 1, (3u^2-u+3)/u]] Factor[FrakQ1[1, 0, 0, 0]] Factor[FrakQ1[1, 1, 0, 0]] Factor[FrakQ1[1, 1, 1, 0]] Factor[FrakQ1[1, 1, 1, 1]] Factor[FrakQ2[1, 0, 0, 0]] Factor[FrakQ2[t, 1, 0, 0]] (*---------------------------- Theorem 1.8 ----------------------------------*) (* Discriminants *) d1[p0_,p1_,p2_,p3_] := 128p0^2 + 24p0 p1 + 36p0 p2 + 12p0 p3 - 9p1^2 d2[p0_,p1_,p2_,p3_] := 16p0+6p1+2p2+p3 d3[p0_,p1_,p2_,p3_] := 4p0 p2 - p1^2 d4[p0_,p1_,p2_,p3_] := 27p0 + 9p1 + 3p2 + p3 d5[p0_,p1_,p2_,p3_] := 16p0 + 4p1+p2 d6[p0_,p1_,p2_,p3_] := p0 (* In the form f = s0 + p s1 + q s2 + r s3 = S4 + p(T31-12 U) + q(S22-6 U) + r(T211-12 U) *) DiscC1[p_,q_,r_] := -9p^2 + 12(p+q+r) + 8 DiscP2[p_,q_,r_] := p + r DiscC4[p_,q_,r_] := - p^2 + 4 q - 8 DiscP3[p_,q_,r_] := 2p+q+r+1 DiscP4[p_,q_,r_] := 2p+q+2 Expand[d1[1,p1,p2,p3] - DiscC1[4+p1, 6+2 p1 + p2, 12 + 5 p1 + 2 p2 + p3]] Expand[d2[1,p1,p2,p3] - DiscP2[4+p1, 6+2 p1 + p2, 12 + 5 p1 + 2 p2 + p3]] Expand[d3[1,p1,p2,p3] - DiscC4[4+p1, 6+2 p1 + p2, 12 + 5 p1 + 2 p2 + p3]] Expand[d4[1,p1,p2,p3] - DiscP3[4+p1, 6+2 p1 + p2, 12 + 5 p1 + 2 p2 + p3]] Expand[d5[1,p1,p2,p3] - DiscP4[4+p1, 6+2 p1 + p2, 12 + 5 p1 + 2 p2 + p3]] (* How to convert: f = p0 sigma1^4 + p1 sigma1^2 sigma2 + p2 sigma2^2 + p3 sigma1 sigma3 - (256p0 + 96p1 + 36p2 + 16p3) sigma4 and f = s0 + p s1 + q s2 + r s3 = S4 + p(T31-12 U) + q(S22-6 U) + r(T211-12 U) (sigma1^4 - 4 sigma1^2 sigma2 + 2 sigma2^2 + 4 sigma1 sigma3 - 8 sigma4) + p(sigma1^2 sigma2 - 2 sigma2^2 - sigma1 sigma3 - 8 sigma4) + q (sigma2^2 - 2 sigma1 sigma3 - 4 sigma4) + r(sigma1 sigma3 - 16 sigma4) = sigma1^4 + (p-4) sigma1^2 sigma2 + (-2p+q+2) sigma2^2 + (-p-2q+r+4) sigma1 sigma3 -4 (2 + 2 p + q + 4 r) sigma4 *) (* Solve[{p1==(p-4), p2==(-2p+q+2), p3==(-p-2q+r+4)},{p,q,r}] p == 4 + p1 q == 6 + 2 p1 + p2 r == 12 + 5 p1 + 2 p2 + p3 *) (* s0 = S4-4U = sigma1^4 - 4 sigma1^2 sigma2 + 2 sigma2^2 + 4 sigma1 sigma3 - 8 sigma4 s1 = T31 - 12 U = sigma1^2 sigma2 - 2 sigma2^2 - sigma1 sigma3 - 8 sigma4 s2 = S22 - 6 U = sigma2^2 - 2 sigma1 sigma3 - 4 sigma4 s3 = T211 - 12 U = sigma1 sigma3 - 16 sigma4 *) (*======= Section 3.1: $\P_{\R}^3/{\frak S}_4$, $\P_+^3/{\frak S}_4$ ========*) (*-------------------------- Proposition 3.3 --------------------------------*) sigma1[a_,b_,c_,d_]:=a+b+c+d sigma2[a_,b_,c_,d_]:=a b+a c+a d+b c+b d+c d sigma3[a_,b_,c_,d_]:=b c d + a c d + a b d + a b c sigma4[a_,b_,c_,d_]:=a b c d (* 3 sigma1^2 - 8 sigma2 = \sum (a-b)^2 \geq 0. sigma2/sigma1^2 \leq 3/8 sigma3/sigma1^3 \leq 1/16, sigma4/sigma1^4 \leq 1/256 *) Disc4[S1_,S2_,S3_,S4_] := (S1^2 S2^2 S3^2 - 4S2^3 S3^2 - 4 S1^3 S3^3 + 18 S1 S2 S3^3 - 27 S3^4 - 4 S1^2 S2^3 S4 + 16 S2^4 S4 + 18 S1^3 S2 S3 S4 - 80 S1 S2^2 S3 S4 - 6 S1^2 S3^2 S4 + 144 S2 S3^2 S4 - 27 S1^4 S4^2 + 144 S1^2 S2 S4^2 - 128 S2^2 S4^2 - 192 S1 S3 S4^2 + 256 S4^3) G[s1_,s2_,s3_,s4_] := 64 s4 - 16s2^2 + 16s1^2 s2 - 16s1 s3 - 3s1^4 (* Figure of $\P_{\R}^3/{\frak S}_4$ and $\P_+^3/{\frak S}_4$ *) ContourPlot3D[Disc4[1,x,y,z]==0,{x,0,3/8},{y,0,1/16},{z,0,1/256}] ContourPlot3D[Disc4[1,x,y,z]==0,{x,-2,3/8},{y,-2,1/4},{z,-1/2,2}] ContourPlot3D[Disc4[1,x,y,z]==0,{x,-1,3/8},{y,-1,1/4},{z,-1/5,1}] ContourPlot3D[{Disc4[1,x,y,z]==0, G[1,x,y,z]==0},{x,0,3/8},{y,0,1/16},{z,0,1/256}] ContourPlot3D[{Disc4[1,x,y,z]==0, G[1,x,y,z]==0},{x,-2,3/8},{y,-2,1/4},{z,-1/2,2}] ContourPlot3D[{Disc4[1,x,y,z]==0, G[1,x,y,z]==0},{x,-1,3/8},{y,-1,1/4},{z,-1/5,1}] (* C_1, C_2 *) Show[ParametricPlot3D[{sigma2[s,t,1,1]/sigma1[s,t,1,1]^2, sigma3[s,t,1,1]/sigma1[s,t,1,1]^3, sigma4[s,t,1,1]/sigma1[s,t,1,1]^4},{s,-4,5},{t,-4,5}], ParametricPlot3D[{sigma2[s,1,1,1]/sigma1[s,1,1,1]^2, sigma3[s,1,1,1]/sigma1[s,1,1,1]^3, sigma4[s,1,1,1]/sigma1[s,1,1,1]^4}, ParametricPlot3D[{sigma2[s,s,1,1]/sigma1[s,s,1,1]^2, sigma3[s,s,1,1]/sigma1[s,s,1,1]^3, sigma4[s,s,1,1]/sigma1[s,s,1,1]^4}, {s,-1,1}], PlotRange -> {{-2, 3/8}, {-2, 1/4}, {-1/2, 2}}] {s,-40,40}] Show[ParametricPlot3D[{10 s2[s,1,1,1]/s1[s,1,1,1]^2, 5 s3[s,1,1,1]/s1[s,1,1,1]^3, 3 s4[s,1,1,1]/s1[s,1,1,1]^4}, {s, -40, 40}], ParametricPlot3D[{10 s2[s,s,1,1]/s1[s,s,1,1]^2, 5 s3[s,s,1,1]/s1[s,s,1,1]^3, 3 s4[s,s,1,1]/s1[s,s,1,1]^4}, {s, -1, 1}], PlotRange -> {{-100, 1/2}, {-100, 50}, {-20, 100}}] (* (5): C_1 *) Eliminate[{x==sigma2[t,1,1,1]/sigma1[t,1,1,1]^2, y==sigma3[t,1,1,1]/sigma1[t,1,1,1]^3, z==sigma4[t,1,1,1]/sigma1[t,1,1,1]^4},t] Eliminate[{x==sigma2[t,1,1,1]/sigma1[t,1,1,1]^2, y==sigma3[t,1,1,1]/sigma1[t,1,1,1]^3},t] (* -9 x^2 + 32 x^3 + 27 y - 108 x y + 108 y^2, && x^2 == 3 y - 12 z *) ContourPlot[-9 x^2 + 32 x^3 + 27 y - 108 x y + 108 y^2 == 0, {x,-5,1}, {y,-7,4}] Expand[(32(x-3/8)^3+27(x-3/8)^2-108(x-3/8)(y-1/16)+108(y-1/16)^2) - (-9 x^2 + 32 x^3 + 27 y - 108 x y + 108 y^2)] (* (6): C_2 *) Eliminate[{x==sigma2[t,t,1,1]/sigma1[t,t,1,1]^2, y==sigma3[t,t,1,1]/sigma1[t,t,1,1]^3, z==sigma4[t,t,1,1]/sigma1[t,t,1,1]^4},t] (* 4 x == 1 + 8 y && y^2 == z *) (* (7) *) Disc4[S1_,S2_,S3_,S4_] := (S1^2 S2^2 S3^2 - 4S2^3 S3^2 - 4 S1^3 S3^3 + 18 S1 S2 S3^3 - 27 S3^4 - 4 S1^2 S2^3 S4 + 16 S2^4 S4 + 18 S1^3 S2 S3 S4 - 80 S1 S2^2 S3 S4 - 6 S1^2 S3^2 S4 + 144 S2 S3^2 S4 - 27 S1^4 S4^2 + 144 S1^2 S2 S4^2 - 128 S2^2 S4^2 - 192 S1 S3 S4^2 + 256 S4^3) Expand[Disc4[sigma1[s,t,1,1],sigma2[s,t,1,1],sigma3[s,t,1,1],sigma4[s,t,1,1]]] (* = 0 *) Expand[((a-b)(a-c)(a-d)(b-c)(b-d)(c-d))^2 - Disc4[sigma1[a,b,c,d],sigma2[a,b,c,d],sigma3[a,b,c,d],sigma4[a,b,c,d]]] G[s1_,s2_,s3_,s4_] := 64 s4 - 16s2^2 + 16s1^2 s2 - 16s1 s3 - 3s1^4 Ga[a_,b_,c_,d_] := 64 sigma4[a,b,c,d] - 16 sigma2[a,b,c,d]^2 + 16 sigma1[a,b,c,d]^2 sigma2[a,b,c,d] - 16 sigma1[a,b,c,d] sigma3[a,b,c,d] - 3 sigma1[a,b,c,d]^4 Factor[Ga[a,a,c,d]] (* = -(c-d)^2 (8a^2 - 8a c + 3c^2 - 8a d + 2c d + 3d^2) *) Factor[Ga[a,a,a,d]] (* = -3(a-d)^4) *) (* $\Delta^1 *) Eliminate[{x==s2[s,1,1,1]/s1[s,1,1,1]^2, y==s3[s,1,1,1]/s1[s,1,1,1]^3}, s] Eliminate[{x==s2[s,1,1,1]/s1[s,1,1,1]^2, z==s4[s,1,1,1]/s1[s,1,1,1]^4}, s] Eliminate[{y==s3[s,1,1,1]/s1[s,1,1,1]^3, z==s4[s,1,1,1]/s1[s,1,1,1]^4}, s] FC2xy[x_,y_]:=-9 x^2 + 32 x^3 + 27 y - 108 x y + 108 y^2 FC2xz[x_,z_]:=-x^3 + 3 x^4 + 27 z - 108 x z + 72 x^2 z + 432 z^2 FC2yz[y_,z_]:=-y^3 + 27 y^4 - 6 y^2 z + 27 z^2 - 768 y z^2 + 4096 z^3 ContourPlot[FC2xy[x, y] == 0, {x, -2, 3/8}, {y, -3, 1}] ContourPlot[FC2xz[x, z] == 0, {x, -2, 3/8}, {z, -1, 1/10}] ContourPlot[FC2yz[y, z] == 0, {y, -3, 1}, {z, -1, 1/10}] (*=================== Section 3.2: ${\Cal P}_{4,4}^{s0}$ ====================*) S4[x0_,x1_,x2_,x3_]:=x0^4+x1^4+x2^4+x3^4 T31[x0_,x1_,x2_,x3_]:=x0^3(x1+x2+x3)+x1^3(x0+x2+x3)+x2^3(x0+x1+x3)+x3^3(x0+x1+x2) S22[x0_,x1_,x2_,x3_]:=x0^2x1^2+x0^2x2^2+x0^2x3^2+x1^2x2^2+x1^2x3^2+x2^2x3^2 T211[x0_,x1_,x2_,x3_]:=x0^2(x1 x2+x1 x3+x2 x3)+x1^2(x0 x2+x0 x3+x2 x3)+x2^2(x0 x1+x0 x3+x1 x3)+x3^2(x0 x1+x0 x2+x1 x2) U[x0_,x1_,x2_,x3_]:=x0 x1 x2 x3 S2[x0_,x1_,x2_,x3_]:=x0^2+x1^2+x2^2+x3^2 S11[x0_,x1_,x2_,x3_]:=x0 x1+x0 x2+x0 x3+x1 x2+x1 x3+x2 x3 s0[a_,b_,c_,d_] := S4[a, b, c, d] - 4 U[a, b, c, d] s1[a_,b_,c_,d_] := T31[a, b, c, d] - 12 U[a, b, c, d] s2[a_,b_,c_,d_] := S22[a, b, c, d] - 6 U[a, b, c, d] s3[a_,b_,c_,d_] := T211[a, b, c, d] - 12 U[a, b, c, d] s4[a_,b_,c_,d_] := U[a, b, c, d] (* ${\frak g}_t(a,b,c,d)$ *) FrakGt[a_,b_,c_,d_,t_]:= (1/3)(3 s0[a,b,c,d] - 2(t+1) (s1[a,b,c,d] - s3[a,b,c,d]) + (t^2+2t-1) s2[a,b,c,d] ) (* ${\frak g}_{\infty}(a,b,c,d)$ *) FrakGi[a_,b_,c_,d_] := s2[a,b,c,d] (* ${\frak p}(a,b,c,d)$ *) FrakP[a_,b_,c_,d_] := s2[a,b,c,d] - s3[a,b,c,d] (* ${\frak t}_t^{ab}(a,b,c,d)$ *) FrakFtab[a_,b_,c_,d_,s_] := (1/3)(3 s0[a,b,c,d] - 2(s+1) s1[a,b,c,d] + 2(2s-1) s2[a,b,c,d] + (s^2+3) s3[a,b,c,d]) (* ${\frak t}_t^c(a,b,c,d)$ *) FrakFtc[a_,b_,c_,d_,t_] := (1/9)(9 s0[a,b,c,d] - 6(t+1) s1[a,b,c,d] + (t^2+2t+19)s2[a,b,c,d] + 2(t^2+5t-8) s3[a,b,c,d]) (* ${\frak q}_1(a,b,c,d)$ *) FrakQ1[a_,b_,c_,d_] := s1[a,b,c,d] - 2 s2[a,b,c,d] (* ${\frak q}_2(a,b,c,d)$ *) FrakQ2[a_,b_,c_,d_] := s3[a,b,c,d] (*---------------------------- Theorem 3.4 ----------------------------------*) DiscC1[p_,q_,r_] := -9p^2 + 12(p+q+r) + 8 (*----------------------------- Lemma 3.5 -----------------------------------*) (* $f_{4,4}^{s0}(x_0,x_1,x_2,x_3)$ *) f44s0[x0_,x1_,x2_,x3_] := (-3 x0 x1^4 + 4 x1^5 + 6 x0^2 x1^2 x2 - 24 x0 x1^3 x2 + 14 x1^4 x2 - 3 x0^3 x2^2 + 20 x0^2 x1 x2^2 - 48 x0 x1^2 x2^2 + 16 x1^3 x2^2 + 34 x0^2 x2^3 + 16 x0 x1 x2^3 + 8 x1^2 x2^3 + 44 x0 x2^4 - 48 x1 x2^4 - 72 x2^5 + 12 x0^2 x1^2 x3 + 12 x0 x1^3 x3 - 36 x1^4 x3 - 12 x0^3 x2 x3 + 20 x0^2 x1 x2 x3 + 120 x0 x1^2 x2 x3 - 56 x1^3 x2 x3 - 76 x0^2 x2^2 x3 - 32 x0 x1 x2^2 x3 - 64 x1^2 x2^2 x3 - 32 x0 x2^3 x3 + 112 x1 x2^3 x3 + 144 x2^4 x3 - 12 x0^3 x3^2 - 40 x0^2 x1 x3^2 - 18 x0 x1^2 x3^2 + 104 x1^3 x3^2 + 14 x0^2 x2 x3^2 - 104 x0 x1 x2 x3^2 + 84 x1^2 x2 x3^2 + 64 x0 x2^2 x3^2 + 16 x1 x2^2 x3^2 - 152 x2^3 x3^2 + 28 x0^2 x3^3 + 12 x0 x1 x3^3 - 136 x1^2 x3^3 + 8 x0 x2 x3^3 - 56 x1 x2 x3^3 + 32 x2^2 x3^3 - 3 x0 x3^4 + 84 x1 x3^4 + 14 x2 x3^4 - 20 x3^5) Factor[f44s0[s0[a,b,c,d], s1[a,b,c,d], s2[a,b,c,d], s3[a,b,c,d]]] (* = 16 (a - b)^2 (a - c)^2 (b - c)^2 (a - d)^2 (b - d)^2 (c - d)^2 (a + b + c + d)^4 ((a-b)^2+(a-c)^2+(a-d)^2+(b-c)^2+(b-d)^2+(c-d)^2)^2 *) Show[ParametricPlot3D[{{s1[a, b, 1, 1]/s0[a, b, 1, 1], s2[a, b, 1, 1]/s0[a, b, 1, 1], s3[a, b, 1, 1]/s0[a, b, 1, 1]}, {3 (a + 2)/(a^2 + 2 a + 3), 3/(a^2 + 2 a + 3), 3/(a^2 + 2 a + 3)}}, {a,-10,10},{b,-10,10}, PlotRange -> {{-5,4},{-1,2},{-5,2}}, RegionFunction -> Function[{a, b}, (a^2 - 1)^2 + (b^2 - 1)^2 > 0.00001]], ContourPlot3D[{f44s0[1, x, y, z] == 0, y == z}, {x,-4,4},{y,0,3/2},{z,-4,2}]] ParametricPlot3D[{p1[a, b]/p0[a, b], p2[a, b]/p0[a, b], p3[a, b]/p0[a, b]}, {a, -2, 2}, {b, -2, 2}] Factor[f44s0[1, t, 1/2, t - 1]] (* Singular Point (a=b, c=d=1) *) (* Tangent space at (x0:...:x3)=(2:3:1:1) = Phi(1:1:1:1) *) 3s0[a,b,c,d]-4s1[a,b,c,d]+2s2[a,b,c,d]+4s3[a,b,c,d] Factor[f44s0[x0, x1, x2, -(3 x0 - 4 x1 + 2 x2)/4]] (* 1/64 (x0 - 2 x2)^2 (3 x0 - 4 x1 + 6 x2) (315 x0^2 - 384 x0 x1 + 660 x0 x2 - 256 x1 x2 + 492 x2^2) *) (* L_2 = \Phi \{(a0:a1:a2:a3) | a0+a1+a2+a3=0 \} *) Expand[s0[-a-b-c,a,b,c] - 2 s2[-a-b-c,a,b,c]] (* = 0 *) Expand[s1[-a-b-c,a,b,c] + 2 s2[-a-b-c,a,b,c] - s3[-a-b-c,a,b,c]] (* = 0 *) (* i.e. $L_2 \subset x_0-2 x_2 = 0 \cap x_1+x_0-x_3 = 0$. *) Expand[3(s0[a,b,c,d] - 2 s2[a,b,c,d]) + 4(s1[a,b,c,d] + 2 s2[a,b,c,d] - s3[a,b,c,d]) - (a+b+c+d)^2 (3 (a^2+b^2+c^2+d^2) - 2 (a b+a c+a d+b c+b d+c d))] (* = 0 *) (* $g_2(x_0,x_1,x_2,x_3)$ *) G2[x0_,x1_,x2_,x3_] := (x1-x3)^2 + 2x2^2 - 3x2 x0 Expand[G2[s0[t,1,1,1], s1[t,1,1,1], s2[t,1,1,1], s3[t,1,1,1]]] (* = 0 *) (*---------------------- Proof of Theorem 1.9(1) ----------------------------*) (* \Phi_4^0(s:1:1:1) = ((s^2+2s+3):3(s+2):3:3) C_1 = x_2=x_3 \cap (x_1-x_3)^2 + 2 x_2^2 - 3 x_2 x_0 = 0$ *) (* L_1 = \Phi \{(s:s:1:1) | s \in \R \} (s0[s,s,1,1] : s1[s,s,1,1] : s2[s,s,1,1] : s3[s,s,1,1]) = (2(s+1)^2 : 2((s+1)^2+2s) : (s+1)^2 : 4s) i.e. $L_1 \subset x_0 = 2 x_2 \cap x_1 = x_0 + x_3$. *) (*------------------- After Proof of Theorem 1.9(1) -------------------------*) Expand[3 FrakGt[a,b,c,d,t] - ((a^2+b^2-c^2-d^2 + (t+1)(c d-a b))^2 + (a^2-b^2+c^2-d^2 + (t+1)(b d-a c))^2 + (a^2-b^2-c^2+d^2 + (t+1)(b c-a d))^2)] Expand[FrakGt[a,b,c,d,t] - (1/12)( (a-b)^2(2(a+b)-(t+1)(c+d))^2 + (a-c)^2(2(a+c)-(t+1)(b+d))^2 + (a-d)^2(2(a+d)-(t+1)(c+b))^2 + (b-c)^2(2(b+c)-(t+1)(a+d))^2 + (b-d)^2(2(b+d)-(t+1)(a+c))^2 + (c-d)^2(2(c+d)-(t+1)(a+b))^2)] Expand[FrakGi[a,b,c,d] - ((a b-c d)^2 + (a c-b d)^2 + (a d-b c)^2)] Expand[FrakP[a,b,c,d] - (1/2)((a-b)^2(c-d)^2 + (a-c)^2(b-d)^2 + (a-d)^2(b-c)^2)] (*------------------------------ Lemma 3.6 ----------------------------------*) S4[a_,b_,c_,d_]:=a^4+b^4+c^4+d^4 T31[a_,b_,c_,d_]:=a^3(b+c+d)+b^3(a+c+d)+c^3(a+b+d)+d^3(a+b+c) S22[a_,b_,c_,d_]:=a^2b^2+a^2c^2+a^2d^2+b^2c^2+b^2d^2+c^2d^2 T211[a_,b_,c_,d_]:=a^2(b c+b d+c d)+b^2(a c+a d+c d)+c^2(a b+a d+b d)+d^2(a b+a c+b c) U[a_,b_,c_,d_]:=a b c d s0[a_,b_,c_,d_] := S4[a,b,c,d] - 4 U[a,b,c,d] s1[a_,b_,c_,d_] := T31[a,b,c,d] - 12 U[a,b,c,d] s2[a_,b_,c_,d_] := S22[a,b,c,d] - 6 U[a,b,c,d] s3[a_,b_,c_,d_] := T211[a,b,c,d] - 12 U[a,b,c,d] s[a_,b_,c_,d_] := {s0[a,b,c,d], s1[a,b,c,d], s2[a,b,c,d], s3[a,b,c,d]} sa0[a_,b_,c_,d_] := 4 (a^3 - b c d) sa1[a_,b_,c_,d_] := 3 a^2 b + b^3 + 3 a^2 c + c^3 + 3 a^2 d - 12 b c d + d^3 sa2[a_,b_,c_,d_] := 2 (a b^2 + a c^2 - 3 b c d + a d^2) sa3[a_,b_,c_,d_] := 2 a b c + b^2 c + b c^2 + 2 a b d + b^2 d + 2 a c d - 12 b c d + c^2 d + b d^2 + c d^2 sa[a_,b_,c_,d_] := {sa0[a,b,c,d], sa1[a,b,c,d], sa2[a,b,c,d], sa3[a,b,c,d]} saa0[a_,b_,c_,d_] := 12a^2 saa1[a_,b_,c_,d_] := 6 a (b + c + d) saa2[a_,b_,c_,d_] := 2 (b^2 + c^2 + d^2) saa3[a_,b_,c_,d_] := 2 (b c + b d + c d) saa[a_,b_,c_,d_] := {saa0[a,b,c,d], saa1[a,b,c,d], saa2[a,b,c,d], saa3[a,b,c,d]} saaa0[a_,b_,c_,d_] := 24a saaa1[a_,b_,c_,d_] := 6 (b + c + d) saaa2[a_,b_,c_,d_] := 0 saaa3[a_,b_,c_,d_] := 0 saaa[a_,b_,c_,d_] := {saaa0[a,b,c,d], saaa1[a,b,c,d], saaa2[a,b,c,d], saaa3[a,b,c,d]} (*---------------------------- Lemma 3.6(1) ---------------------------------*) (* Matrix $A$ *) A[t_] := {s[t,1,1,1], sa[t,1,1,1], s[-1,-1,1,1]} (* = {{(t-1)^2(t^2+2t+3), 3(t-1)^2(t+2), 3(t-1)^2, 3(t-1)^2}, {4(t^3-1), 9(t^2-1), 6(t-1), 6(t-1)}, {0, -16, 0, -16}} Factor[NullSpace[A[t]]] (* $\R \cdot {\frak g}_t *) Factor[Det[{{1,0,0,0},s[t,1,1,1], sa[t,1,1,1], s[-1,-1,1,1]}]] (* = 144(t-1)^4 * (*---------------------------- Lemma 3.6(2) ---------------------------------*) Factor[FrakGt[x,x,1,1,1]] (* = 0 *) A := {s[0,0,1,1], s[2,2,1,1]} (* {{2,2,1,0}, {18, 26, 9, 8}} *) g[a_,b_,c_,d_] := s1[a,b,c,d]-2 s2[a,b,c,d]-s3[a,b,c,d] (* This isn't PSD *) Factor[FrakFtab[x,x,1,1,1]] (* = 0 *) Factor[g[x,x,1,1]] (* = 0 *) NullSpace[A] (* Base of Ker A is {FrakFtab[a,b,c,d,1], g[a,b,c,d] *) Factor[FrakFtab[x,1,1,1,1] + c g[x,1,1,1]] (* = (x-1)^3(x-1-3c) *) (* (x-1)^3(x-1-3c) >= 0 for all x \in \R if anf only if c=0 *) (*---------------------------- Lemma 3.6(3) ---------------------------------*) Factor[FrakGt[x,y,z,-x-y-z,-3]] (* = 0 *) (* = S_1^2 (3S_3 - 2T_{1,1) *) (* 3 FrakGt[a,b,c,d,-3] == 3 s0[a,b,c,d] + 4 (s1[a,b,c,d] - s3[a,b,c,d]) + 2 s2[a,b,c,d] *) A := {s[1,2,3,-6], sa[1,2,3,-6], s[1,2,4,-7]} (* {{1538, -962, 769, 576}, {148, 248, 314, 516}, {2898, -2002, 1449, 896}} *) NullSpace[A] (*---------------------------- Lemma 3.6(4) ---------------------------------*) FrakGi[a_,b_,c_,d_] := s2[a,b,c,d] Factor[FrakGi[a,b,c,d] - ((a b-c d)^2 + (a c-b d)^2 + (a d-b c)^2)] (* = 0 *) A := {s[0,0,0,1], sa[0,0,0,1], s[1,1,-1,-1]} (* = {{1,0,0,0}, {0,1,0,0}, {0, 16,0,-16}} *) NullSpace[A] (*---------------------------- Lemma 3.6(5) ---------------------------------*) FrakP[a_,b_,c_,d_] := s2[a,b,c,d] - s3[a,b,c,d] Factor[FrakP[a,b,c,d] - ( (a-b)^2(c-d)^2 + (a-c)^2(b-d)^2 + (a-d)^2(b-c)^2)] (* = 0 *) A := {s[2,1,1,1], s[0,0,0,1], sa[0,0,0,1]} (* = {{11,12,3,3}, {1,0,0,0}, {0,1,0,0}} *) NullSpace[A] (*------------------------------ Lemma 3.7 ----------------------------------*) DiscC1[p_,q_,r_] := -9p^2 + 12(p+q+r) + 8 DiscP2[p_,q_,r_] := p + r FrakGt[a,b,c,d,t] := (1/3)(3 s0[a,b,c,d] - 2(t+1) (s1[a,b,c,d] - s3[a,b,c,d]) + (t^2+2t-1) s2[a,b,c,d]) FrakP[a_,b_,c_,d_] := s2[a,b,c,d] - s3[a,b,c,d] (* $(1/3){\frak f}_t + \alpha {\frak p} = s_0 + (-2(t+1)/3) s_1 + ((t^2+2t-1)/3 + \alpha) s_2 + (2(t+1)/3 - \alpha) s_3 *) Factor[DiscC1[-2(t+1)/3, (t^2+2t-1)/3 + alpha, 2(t+1)/3 - alpha]] (* = 0 *) (* Proof of s2[a,b,c,d] - s3[a,b,c,d] \geq 0. Cf. s2[t,1,1,1] - s3[t,1,1,1] = 0 *) St4[a_,b_,c_] := (a^4+b^4+c^4) St31[a_,b_,c_] := (a^3b + b^3c + c^3a) St13[a_,b_,c_] := (a b^3 + b c^3 + c a^3) St22[a_,b_,c_] := (a^2b^2 + b^2c^2 + c^2a^2) USt1[a_,b_,c_] := a b c(a + b + c) Tt31[a_,b_,c_] := St31[a,b,c] + St13[a,b,c] St3[a_,b_,c_] := (a^3+b^3+c^3) St21[a_,b_,c_] := (a^2b + b^2c + c^2a) St12[a_,b_,c_] := (a b^2 + b c^2 + c a^2) Tt21[a_,b_,c_] := (a^2b + b^2c + c^2a)+(a b^2 + b c^2 + c a^2) Ut[a_,b_,c_] := a b c St2[a_,b_,c_] := (a^2+b^2+c^2) St11[a_,b_,c_] := (a b + b c + c a) Factor[(s2[a,b,c,d] - s3[a,b,c,d]) - ((St2[a,b,c]-St11[a,b,c]) d^2 - (Tt21[a,b,c] - 6Ut[a,b,c]) d + (St22[a,b,c] - USt1[a,b,c]))] (*--------------- Proof of Theorem 1.1(1), 1.2, 1.8(1) ---------------------*) sigma1[a_,b_,c_,d_]:=a+b+c+d sigma2[a_,b_,c_,d_]:=a b+a c+a d+b c+b d+c d sigma3[a_,b_,c_,d_]:=b c d + a c d + a b d + a b c sigma4[a_,b_,c_,d_]:=a b c d S4[x0_,x1_,x2_,x3_]:=x0^4+x1^4+x2^4+x3^4 T31[x0_,x1_,x2_,x3_]:=x0^3(x1+x2+x3)+x1^3(x0+x2+x3)+x2^3(x0+x1+x3)+x3^3(x0+x1+x2) S22[x0_,x1_,x2_,x3_]:=x0^2x1^2+x0^2x2^2+x0^2x3^2+x1^2x2^2+x1^2x3^2+x2^2x3^2 T211[x0_,x1_,x2_,x3_]:=x0^2(x1 x2+x1 x3+x2 x3)+x1^2(x0 x2+x0 x3+x2 x3)+x2^2(x0 x1+x0 x3+x1 x3)+x3^2(x0 x1+x0 x2+x1 x2) U[x0_,x1_,x2_,x3_]:=x0 x1 x2 x3 S3[x0_,x1_,x2_,x3_]:=x0^3+x1^3+x2^3+x3^3 S2[x0_,x1_,x2_,x3_]:=x0^2+x1^2+x2^2+x3^2 S1[x0_,x1_,x2_,x3_]:=x0+x1+x2+x3 T21[x0_,x1_,x2_,x3_]:=x0^2(x1+x2+x3)+x1^2(x0+x2+x3)+x2^2(x0+x1+x3)+x3^2(x0+x1+x2) S111[x0_,x1_,x2_,x3_]:=x1 x2 x3 + x0 x2 x3 + x0 x1 x3 + x0 x1 x2 S11[x0_,x1_,x2_,x3_]:=x0 x1+x0 x2+x0 x3+x1 x2+x1 x3+x2 x3 s0[a_,b_,c_,d_] := S4[a,b,c,d] - 4 U[a,b,c,d] s1[a_,b_,c_,d_] := T31[a,b,c,d] - 12 U[a,b,c,d] s2[a_,b_,c_,d_] := S22[a,b,c,d] - 6 U[a,b,c,d] s3[a_,b_,c_,d_] := T211[a,b,c,d] - 12 U[a,b,c,d] t0[a_,b_,c_,d_] := sigma1[a,b,c,d]^4 - 256 sigma4[a,b,c,d] t1[a_,b_,c_,d_] := sigma1[a,b,c,d]^2 sigma2[a,b,c,d] - 96 sigma4[a,b,c,d] t2[a_,b_,c_,d_] := sigma2[a,b,c,d]^2 - 36 sigma4[a,b,c,d] t3[a_,b_,c_,d_] := sigma1[a,b,c,d] sigma3[a,b,c,d] - 16 sigma4[a,b,c,d] Expand[t0[a,b,c,d] - (s0[a,b,c,d] + 4 s1[a,b,c,d] + 6 s2[a,b,c,d] + 12 s3[a,b,c,d])] Expand[t1[a,b,c,d] - (s1[a,b,c,d] + 2 s2[a,b,c,d] + 5 s3[a,b,c,d])] Expand[t2[a,b,c,d] - (s2[a,b,c,d] + 2 s3[a,b,c,d])] Expand[t3[a,b,c,d] - s3[a,b,c,d]] A := {{1,4,6,12},{0,1,2,5},{0,0,1,2},{0,0,0,1}} Inverse[A] Expand[s0[a,b,c,d] - (t0[a,b,c,d] - 4 t1[a,b,c,d] + 2 t2[a,b,c,d] + 4 t3[a,b,c,d])] Expand[s1[a,b,c,d] - (t1[a,b,c,d] - 2 t2[a,b,c,d] - t3[a,b,c,d])] Expand[s2[a,b,c,d] - (t2[a,b,c,d] - 2 t3[a,b,c,d])] Expand[s3[a,b,c,d] - t3[a,b,c,d]] (*---------------------- Proof of Theorem 1.7(1) ----------------------------*) FrakGt[a_,b_,c_,d_,t_] := (1/3)(3 s0[a,b,c,d] - 2(t+1) (s1[a,b,c,d] - s3[a,b,c,d]) + (t^2+2t-1) s2[a,b,c,d]) f[a_,b_,c_] := 3 FrakGt[a,b,c,-a-b-c,t]/(t+3)^2 f[x_,y_] := 3 FrakGt[x,y,-x-y-1,1,t]/(t+3)^2 Factor[D[f[x,y],x]] (* = 2(2x+y+1)(x^2+x y+y^2+x+3y+1) *) Factor[D[f[x,y],y]] (* = 2(x+2y+1)(x^2+x y+y^2+3x+y+1) *) Solve[{(2x+y+1)==0, 2(x+2y+1)==0}] (* x=y=1/3 *) Solve[{(2x+y+1)==0, (x^2+x y+y^2+3x+y+1)==0}] (* (x,y)=(-1,1), (-1/3,-1/3) *) Solve[{(x^2+x y+y^2+x+3y+1)==0, (x+2y+1)==0}] (* (x,y) = (-1/3,-1/3), (1,-1) *) Solve[{(x^2+x y+y^2+x+3y+1)==0, (x^2+x y+y^2+3x+y+1)==0}] (* (x,y) = (-1,-1). (-1/3,-1/3) *) f[-1,1] (* = 0 *) f[-1/3,-1/3] (* = 16/27 \ne 0 *) f[1,-1] (* = 0 *) f[-1,-1] (* = 0 *) (* Thus Sing(V_{\C}(f)) = {(-1,1), (1,-1), (-1,-1) *) Expand[ct[x-1, y+1]] (* = 8x^2+8xy+4y^2 +... *) Expand[ct[x+1, y-1]] (* = 4x^4+8xy+8y^2 +... *) Expand[ct[x-1, y-1]] (* = 4x^2+4y^2+...*) (* These are acnodes *) Factor[3 FrakGt[a,b,c,d,-3] - S1[a,b,c,d]^2 (3 S2[a,b,c,d] - 2 S11[a,b,c,d])] (* = 0 *) (*---------------------- Proof of Corollary 1.3 -----------------------------*) q1[a_,b_,c_,d_]:=a^2 q2[a_,b_,c_,d_]:=a b q3[a_,b_,c_,d_]:=a c q4[a_,b_,c_,d_]:=a d q5[a_,b_,c_,d_]:=b^2 q6[a_,b_,c_,d_]:=b c q7[a_,b_,c_,d_]:=b d q8[a_,b_,c_,d_]:=c^2 q9[a_,b_,c_,d_]:=c d q10[a_,b_,c_,d_]:=d^2 q[a_,b_,c_,d_]:={q1[a,b,c,d],q2[a,b,c,d],q3[a,b,c,d],q4[a,b,c,d],q5[a,b,c,d],q6[a,b,c,d],q7[a,b,c,d],q8[a,b,c,d],q9[a,b,c,d],q10[a,b,c,d]} qa1[a_,b_,c_,d_]:=2a qa2[a_,b_,c_,d_]:=b qa3[a_,b_,c_,d_]:=c qa4[a_,b_,c_,d_]:=d qa5[a_,b_,c_,d_]:=0 qa6[a_,b_,c_,d_]:=0 qa7[a_,b_,c_,d_]:=0 qa8[a_,b_,c_,d_]:=0 qa9[a_,b_,c_,d_]:=0 qa10[a_,b_,c_,d_]:=0 qa[a_,b_,c_,d_]:={qa1[a,b,c,d],qa2[a,b,c,d],qa3[a,b,c,d],qa4[a,b,c,d],qa5[a,b,c,d],qa6[a,b,c,d],qa7[a,b,c,d],qa8[a,b,c,d],qa9[a,b,c,d],qa10[a,b,c,d]} qb1[a_,b_,c_,d_]:=0 qb2[a_,b_,c_,d_]:=a qb3[a_,b_,c_,d_]:=0 qb4[a_,b_,c_,d_]:=0 qb5[a_,b_,c_,d_]:=2b qb6[a_,b_,c_,d_]:=c qb7[a_,b_,c_,d_]:=d qb8[a_,b_,c_,d_]:=0 qb9[a_,b_,c_,d_]:=0 qb10[a_,b_,c_,d_]:=0 qb[a_,b_,c_,d_]:={qb1[a,b,c,d],qb2[a,b,c,d],qb3[a,b,c,d],qb4[a,b,c,d],qb5[a,b,c,d],qb6[a,b,c,d],qb7[a,b,c,d],qb8[a,b,c,d],qb9[a,b,c,d],qb10[a,b,c,d]} qc1[a_,b_,c_,d_]:=0 qc2[a_,b_,c_,d_]:=0 qc3[a_,b_,c_,d_]:=a qc4[a_,b_,c_,d_]:=0 qc5[a_,b_,c_,d_]:=0 qc6[a_,b_,c_,d_]:=b qc7[a_,b_,c_,d_]:=0 qc8[a_,b_,c_,d_]:=2c qc9[a_,b_,c_,d_]:=d qc10[a_,b_,c_,d_]:=0 qc[a_,b_,c_,d_]:={qc1[a,b,c,d],qc2[a,b,c,d],qc3[a,b,c,d],qc4[a,b,c,d],qc5[a,b,c,d],qc6[a,b,c,d],qc7[a,b,c,d],qc8[a,b,c,d],qc9[a,b,c,d],qc10[a,b,c,d]} qd1[a_,b_,c_,d_]:=0 qd2[a_,b_,c_,d_]:=0 qd3[a_,b_,c_,d_]:=0 qd4[a_,b_,c_,d_]:=a qd5[a_,b_,c_,d_]:=0 qd6[a_,b_,c_,d_]:=0 qd7[a_,b_,c_,d_]:=b qd8[a_,b_,c_,d_]:=0 qd9[a_,b_,c_,d_]:=c qd10[a_,b_,c_,d_]:=2d qd[a_,b_,c_,d_]:={qd1[a,b,c,d],qd2[a,b,c,d],qd3[a,b,c,d],qd4[a,b,c,d],qd5[a,b,c,d],qd6[a,b,c,d],qd7[a,b,c,d],qd8[a,b,c,d],qd9[a,b,c,d],qd10[a,b,c,d]} (* Zero points of ${\frak g}_t$, $t \ne 1$ *) AG[t_] := {q[1,1,1,1], q[t,1,1,1], q[1,t,1,1], q[1,1,t,1], q[1,1,1,t], q[1,1,-1,-1], q[1,-1,1,-1], q[1,-1,-1,1]} Factor[NullSpace[AG[t]]] (* Base: Qb1[a_,b_,c_,d_,t_] := a^2-b^2-c^2+d^2 + (t+1)(b c-a d) Qb2[a_,b_,c_,d_,t_] := (a-c)(2a+2c-(t+1)b-(t+1)d) Qb3[a_,b_,c_,d_,t_] := (a-b)(2a+2b-(t+1)c-(t+1)d) *) (* Zero points of ${\frak g}_{\infty}$ *) AGi:= {q[1,1,1,1], q[1,1,-1,-1], q[1,-1,1,-1], q[1,-1,-1,1], q[1,0,0,0], q[0,1,0,0], q[0,0,1,0], q[0,0,0,1]} NullSpace[AGi] (* Base: a b-c d, a c-b d, a d-b c *) (* Zero points of ${\frak p}$ *) AP := {q[1,1,1,1], q[1,0,0,0], q[0,1,0,0], q[0,0,1,0], q[0,0,0,1], q[2,1,1,1], q[1,2,1,1], q[1,1,2,1], q[1,1,1,2]} NullSpace[AP] (* Base (a-b)(c-d), (a-c)(b-d) *) (*================== Section 3.3: ${\Cal P}_{4,4}^{s0+}$ ====================*) (*--------------------------- Theorem 3.8 -----------------------------------*) S4[x0_,x1_,x2_,x3_]:=x0^4+x1^4+x2^4+x3^4 T31[x0_,x1_,x2_,x3_]:=x0^3(x1+x2+x3)+x1^3(x0+x2+x3)+x2^3(x0+x1+x3)+x3^3(x0+x1+x2) S22[x0_,x1_,x2_,x3_]:=x0^2x1^2+x0^2x2^2+x0^2x3^2+x1^2x2^2+x1^2x3^2+x2^2x3^2 T211[x0_,x1_,x2_,x3_]:=x0^2(x1 x2+x1 x3+x2 x3)+x1^2(x0 x2+x0 x3+x2 x3)+x2^2(x0 x1+x0 x3+x1 x3)+x3^2(x0 x1+x0 x2+x1 x2) U[x0_,x1_,x2_,x3_]:=x0 x1 x2 x3 S2[x0_,x1_,x2_,x3_]:=x0^2+x1^2+x2^2+x3^2 S11[x0_,x1_,x2_,x3_]:=x0 x1+x0 x2+x0 x3+x1 x2+x1 x3+x2 x3 s0[a_,b_,c_,d_] := S4[a, b, c, d] - 4 U[a, b, c, d] s1[a_,b_,c_,d_] := T31[a, b, c, d] - 12 U[a, b, c, d] s2[a_,b_,c_,d_] := S22[a, b, c, d] - 6 U[a, b, c, d] s3[a_,b_,c_,d_] := T211[a, b, c, d] - 12 U[a, b, c, d] s4[a_,b_,c_,d_] := U[a, b, c, d] s[a_,b_,c_,d_] := {s0[a,b,c,d], s1[a,b,c,d], s2[a,b,c,d], s3[a,b,c,d]} FrakFtab[a_,b_,c_,d_,t_] := (1/3)(3 s0[a,b,c,d] - 2(t+1) s1[a,b,c,d] + 2(2t-1) s2[a,b,c,d] + (t^2+3) s3[a,b,c,d]) FrakFtc[a_,b_,c_,d_,t_] := (1/9)(9 s0[a,b,c,d] - 6(t+1) s1[a,b,c,d] + (t^2+2t+19)s2[a,b,c,d] + 2(t^2+5t-8) s3[a,b,c,d]) FrakP[a_,b_,c_,d_] := s2[a,b,c,d] - s3[a,b,c,d] FrakQ1[a_,b_,c_,d_] := s1[a,b,c,d] - 2 s2[a,b,c,d] FrakQ2[a_,b_,c_,d_] := s3[a,b,c,d] DiscC1[p_,q_,r_] := -9p^2 + 12(p+q+r) + 8 DiscC4[p_,q_,r_] := - p^2 + 4 q - 8 DiscP3[p_,q_,r_] := 2p+q+r+1 DiscP4[p_,q_,r_] := 2p+q+2 Expand[FrakQ1[a,b,c,d] - (a b(a-b)^2 + a c(a-c)^2 + a d(a-d)^2 + b c(b-c)^2 + b d(b-d)^2 + c d(c-d)^2)] Expand[FrakQ2[a,b,c,d] - (a b(c-d)^2 + a c(b-d)^2 + a d(b-c)^2 + b c(a-d)^2 + b d(a-c)^2 + c d(a-b)^2)] Factor[FrakFtab[t,1,1,1,t]] Factor[FrakFtab[0,0,1,1,t]] Factor[FrakFtc[t,1,1,1,t]] Factor[FrakFtc[0, 0, (t+1+Sqrt[t^2+2t-35])/6, 1, t]] Factor[FrakFtc[0, 0, u, 1, (3u^2-u+3)/u]] Factor[FrakP[x,1,1,1]] (* = 0 *) Factor[FrakP[x,x,1,1]] (* = (x-1)^4 *) Factor[FrakP[0,0,0,1]] (* = 0 *) Factor[FrakQ1[1,1,1,0]] Factor[FrakQ1[1,1,0,0]] Factor[FrakQ1[1,0,0,0]] Factor[FrakQ2[x,1,0,0]] Factor[FrakQ2[1,0,0,0]] (* Imformation relating $X_{4,4}^{s0+}$ *) g3[x0_,x1_,x2_,x3_] := (x1+x3)^2 - (x2 + 2 x3) (x0 + 2 x2) g4[x0_,x1_,x2_,x3_] := (x1 - 2 x3)^2 - (x0 - x3)^2 + (x0 - 2x2 + x3)^2 Factor[g3[s0[0,a,b,1], s1[0,a,b,1], s2[0,a,b,1], s3[0,a,b,1]]] (* = 0 *) Factor[g3[s0[a,b,c,d],s1[a,b,c,d],s2[a,b,c,d],s3[a,b,c,d]]] (* = 4 a b c d (3S2[a,b,c,d]-2S11[a,b,c,d])^2 *) Factor[g4[s0[0,a,b,c], s1[0,a,b,c], s2[0,a,b,c], s3[0,a,b,c]]] (* = -3(a-b)^2(a-c)^2(b-c)^2(a+b+c)^2 \leq 0 *) *--------------------------- Lemma 3.11(1) ----------------------------------*) (* $C_1^+$ = \big\{ s[t,1,1,1] \big| t \geq 0 \big\}$ *) FC1a[x0_,x1_,x2_,x3_] := x1^2 - 2x1 x2 - 3x0 x2 + 3x2^2 FC1b[x0_,x1_,x2_,x3_] := x2 - x3 Expand[FC1a[s0[t,1,1,1], s1[t,1,1,1], s2[t,1,1,1], s3[t,1,1,1]]] Expand[FC1b[s0[t,1,1,1], s1[t,1,1,1], s2[t,1,1,1], s3[t,1,1,1]]] ParametricPlot3D[{s1[t,1,1,1]/s0[t,1,1,1], s2[t,1,1,1]/s0[t,1,1,1], s3[t,1,1,1]/s0[t,1,1,1]}, {t,0,10}] (*-------------------------- Lemma 3.11(2) ----------------------------------*) (* $C_3$ = \big\{ s[0,t,1,1] \big| t \geq 0 \big\}$ *) FC3a[x0_,x1_,x2_,x3_] := (x1+x3)^2 - (x2 + 2 x3) (x0 + 2 x2) (* = g3[] *) FC3b[x0_,x1_,x2_,x3_] := (x1 - 2 x3)^2 - (x0 - x3)^2 + (x0 - 2x2 + x3)^2 (* = g4[] *) Expand[FC3a[s0[0,t,1,1], s1[0,t,1,1], s2[0,t,1,1], s3[0,t,1,1]]] Expand[FC3b[s0[0,t,1,1], s1[0,t,1,1], s2[0,t,1,1], s3[0,t,1,1]]] ParametricPlot3D[{s1[0,t,1,1]/s0[0,t,1,1], s2[0,t,1,1]/s0[0,t,1,1], s3[0,t,1,1]/s0[0,t,1,1]}, {t,0,10}] (*-------------------------- Lemma 3.11(4) ----------------------------------*) (* $C_4$ = \big\{ s[0,0,t,1] \big| t \geq 0 \big\}$ *) FC4a[x0_,x1_,x2_,x3_] := x1^2 - 2 x2^2 - x0 x2 FC4b[x0_,x1_,x2_,x3_] := x3 Expand[FC4a[s0[0,0,t,1], s1[0,0,t,1], s2[0,0,t,1], s3[0,0,t,1]]] Expand[FC4b[s0[0,0,t,1], s1[0,0,t,1], s2[0,0,t,1], s3[0,0,t,1]]] ParametricPlot3D[{s1[0,0,t,1]/s0[0,0,t,1], s2[0,0,t,1]/s0[0,0,t,1], s3[0,0,t,1]/s0[0,0,t,1]}, {t,0,10}] ParametricPlot[{s1[0,0,t,1]/s0[0,0,t,1], s2[0,0,t,1]/s0[0,0,t,1]}, {t,0,10}] (*---------------------------- Lemma 3.11 -----------------------------------*) (* $C_1^+$, $C_2$, $C_3$ and $C_4$ *) (* $C_2$ = \big\{ s[t,t,1,1] \big| t \geq 0 \big\}$ *) Show[ ParametricPlot3D[{s1[t,1,1,1]/s0[t,1,1,1], s2[t,1,1,1]/s0[t,1,1,1], s3[t,1,1,1]/s0[t,1,1,1]}, {t,0,10}, PlotRange -> {{-0.1,2.1},{-0.1,1.1},{-0.1,1.1}}], ParametricPlot3D[{s1[t,t,1,1]/s0[t,t,1,1], s2[t,t,1,1]/s0[t,t,1,1], s3[t,t,1,1]/s0[t,t,1,1]}, {t,0,10}, PlotRange -> {{-0.1,2.1},{-0.1,1.1},{-0.1,1.1}}], ParametricPlot3D[{s1[0,t,1,1]/s0[0,t,1,1], s2[0,t,1,1]/s0[0,t,1,1], s3[0,t,1,1]/s0[0,t,1,1]}, {t,0,10}, PlotRange -> {{-0.1,2.1},{-0.1,1.1},{-0.1,1.1}}], ParametricPlot3D[{s1[0,0,t,1]/s0[0,0,t,1], s2[0,0,t,1]/s0[0,0,t,1], s3[0,0,t,1]/s0[0,0,t,1]}, {t,0,10}, PlotRange -> {{-0.1,2.1},{-0.1,1.1},{-0.1,1.1}}]] (*-------------------------- After Lemma 3.11 -------------------------------*) (* ${\frak f}_5^{ab} = {\frak f}_5^c$. *) Factor[FrakFtab[a,b,c,d,5] - FrakFtc[a,b,c,d,5]] (* ${\frak f}_{\infty}^c := s_2 + 2 s_3$. *) FrakFi[a_,b_,c_,d_,t_] := s2[a,b,c,d] + 2 s3[a,b,c,d] (* ${\frak f}_{\infty}^c = {\frak p} + 3 {\frak q}_2$ *) Factor[FrakFi[a,b,c,d,t] - FrakP[a,b,c,d] - 3 FrakQ2[a,b,c,d]] (* ${\frak h}_u^c$ *) FrakHuc[a_,b_,c_,d_,u_] := 3u^2 s0[a,b,c,d] - 6u(u^2+1) s1[a,b,c,d] + 3(u^4+4u^2+1) s2[a,b,c,d] + 2(3u^4+3u^3+2u^2+3u+3) s3[a,b,c,d] (* $t = (3u^2-u+3)/u$, then $\displaystyle {\frak h}_u^c = 3u^2 {\frak f}_t^c$. *) Expand[FrakHuc[a,b,c,d,u] - 3u^2 FrakFtc[a,b,c,d,(3u^2-u+3)/u]] (* ${\frak h}_u^c(0$, $0$, $u$, $1) = 0$. *) Expand[FrakHuc[0,0,u,1,u]] (*---------------------------- Lemma 3.12 -----------------------------------*) S4[a_,b_,c_,d_]:=a^4+b^4+c^4+d^4 T31[a_,b_,c_,d_]:=a^3(b+c+d)+b^3(a+c+d)+c^3(a+b+d)+d^3(a+b+c) S22[a_,b_,c_,d_]:=a^2b^2+a^2c^2+a^2d^2+b^2c^2+b^2d^2+c^2d^2 T211[a_,b_,c_,d_]:=a^2(b c+b d+c d)+b^2(a c+a d+c d)+c^2(a b+a d+b d)+d^2(a b+a c+b c) U[a_,b_,c_,d_]:=a b c d s0[a_,b_,c_,d_] := S4[a,b,c,d] - 4 U[a,b,c,d] s1[a_,b_,c_,d_] := T31[a,b,c,d] - 12 U[a,b,c,d] s2[a_,b_,c_,d_] := S22[a,b,c,d] - 6 U[a,b,c,d] s3[a_,b_,c_,d_] := T211[a,b,c,d] - 12 U[a,b,c,d] s[a_,b_,c_,d_] := {s0[a,b,c,d], s1[a,b,c,d], s2[a,b,c,d], s3[a,b,c,d]} sa0[a_,b_,c_,d_] := 4 (a^3 - b c d) sa1[a_,b_,c_,d_] := 3 a^2 b + b^3 + 3 a^2 c + c^3 + 3 a^2 d - 12 b c d + d^3 sa2[a_,b_,c_,d_] := 2 (a b^2 + a c^2 - 3 b c d + a d^2) sa3[a_,b_,c_,d_] := 2 a b c + b^2 c + b c^2 + 2 a b d + b^2 d + 2 a c d - 12 b c d + c^2 d + b d^2 + c d^2 sa[a_,b_,c_,d_] := {sa0[a,b,c,d], sa1[a,b,c,d], sa2[a,b,c,d], sa3[a,b,c,d]} saa0[a_,b_,c_,d_] := 12a^2 saa1[a_,b_,c_,d_] := 6 a (b + c + d) saa2[a_,b_,c_,d_] := 2 (b^2 + c^2 + d^2) saa3[a_,b_,c_,d_] := 2 (b c + b d + c d) saa[a_,b_,c_,d_] := {saa0[a,b,c,d], saa1[a,b,c,d], saa2[a,b,c,d], saa3[a,b,c,d]} saaa0[a_,b_,c_,d_] := 24a saaa1[a_,b_,c_,d_] := 6 (b + c + d) saaa2[a_,b_,c_,d_] := 0 saaa3[a_,b_,c_,d_] := 0 saaa[a_,b_,c_,d_] := {saaa0[a,b,c,d], saaa1[a,b,c,d], saaa2[a,b,c,d], saaa3[a,b,c,d]} Factor[FrakFtab[0,x,1,1,t] - (1/3) (x(x+2) ((t - 2(x-1)^2/(x+2))^2 + x(16-x)(x-1)^2/(x+2)^2))] Expand[FrakFtab[0,x,1,1,t] - (1/3) (x (18(25-t)^2 + (t^2+120(5-t)+1575)(x-16) + (4(5-t)+120)(x-16)^2 + 3(x-16)^3))] Expand[FrakFtab[x,1,1,1,t] - (x-t)^2 (x-1)^2] Expand[FrakFtab[0,0,x,1,t] - (1/3)(x-1)^2(3(x-(t-2)/3)^2 + (1/3)(5-t)(1+t))] Expand[FrakFtc[x,1,1,1,t] - (x-t)^2 (x-1)^2] Factor[FrakFtc[0,x,1,1,t] - (1/9)(2x+1)^2((t-(x-1)^2(6x+5)/(2x+1)^2)^2 + 24x(x-1)^2(x+2)(3x+2)/(2x+1)^4)] Expand[FrakFtc[0,0,x,1,t] - (1/9)(3x^2 - (t+1)x + 3)^2] Expand[FrakHuc[0,0,x,1,u] - 3(x-u)^2(u x-1)^2] Expand[FrakQ1[x,1,1,1] - 3x(x-1)^2] Expand[FrakQ1[0,x,1,1] - 2x(x-1)^2] Expand[FrakQ1[0,0,x,1] - x(x-1)^2] Expand[FrakQ2[x,1,1,1] - 3(x-1)^2] Expand[FrakQ2[0,x,1,1] - x(x+2)] Expand[FrakQ2[0,0,x,1]] (*-------------------------- Lemma 3.12(1) ---------------------------------*) A1[t_] := {s[t,1,1,1], sa[t,1,1,1], s[0,0,1,1]} (* = {{(t-1)^2(t^2+2t+3), 3(t-1)^2(t+2), 3(t-1)^2, 3(t-1)^2}, {4(t^3-1), 9(t^2-1), 6(t-1), 6(t-1)}, {2,2,1,0}} *) Factor[NullSpace[A1[t]]] Factor[(t^2+3){3/(3+t^2),-((2(1+t))/(3+t^2)),(2(2t-1))/(3+t^2),1}.s[a,b,c,d] - 3 FrakFtab[a,b,c,d,t]] (* = 0 *) Factor[Det[{{1,0,0,0},s[t,1,1,1], sa[t,1,1,1], s[0,0,1,1]}]] (* = 9(t-1)^4 *) (*-------------------------- Lemma 3.12(2) ---------------------------------*) Factor[FrakFtab[x,x,1,1,1]] A2 := {saaa[1,1,1,1], s[0,0,1,1], sa[0,0,1,1]} (* = {{24, 18, 0, 0}, {2, 2, 1, 0}, {0, 2, 0, 2}} *) NullSpace[A2] (*-------------------------- Lemma 3.12(3) ---------------------------------*) tu[u] := (3u^2-u+3)/u Factor[FrakHuc[a,b,c,d,u] - 3u^2 FrakFtc[a,b,c,d,tu[u]]] (* = 0 *) A3[u_] := {s[(3u^2-u+3)/u ,1,1,1], sa[(3u^2-u+3)/u ,1,1,1], s[0,0,u,1]} (* = {{(3u^2-2u+3)^2(9u^4+20u^2+9)/u^4, 3(3u^2-2u+3)^2(3u^2+u+3))/u^3, 3(3u^2-2u+3)^2/u^2, 3(3u^2-2u+3)^2/u^2}, {4(3u^2-2u+3)(9u^4-3u^3+19u^2-3u+9)/u^3, 27(u^2+1)(3u^2-2u+3)/u^2, 6(3u^2-2u+3)/u, 6(3u^2-2u+3)/u}, {u^4+1, u(u^2+1), u^2, 0}} *) Expand[A3[u] - { {(tu[u]-1)^2(tu[u]^2+2tu[u]+3), 3(tu[u]-1)^2(tu[u]+2), 3(tu[u]-1)^2, 3(tu[u]-1)^2}, {4(tu[u]^3-1), 9(tu[u]^2-1), 6(tu[u]-1), 6(tu[u]-1)}, {u^4+1, u(u^2+1), u^2, 0}}] Factor[NullSpace[A3[u]]] Factor[ ( 6 (3+3u+2u^2+3u^3+3u^4)/(u^2)) { (3u^2)/(2(3+3u+2u^2+3u^3+3u^4)), -((3u(1+ u^2))/(3+3u+2u^2+3u^3+3u^4)), (3(1+4u^2+u^4))/(2(3+3u+2u^2+3u^3+3u^4)), 1}.s[a,b,c,d] - 9 FrakFtc[a,b,c,d,(3u^2-u+ 3)/u]] (* = 0 *) Factor[Det[{{1,0,0,0},s[(3u^2-u+3)/u ,1,1,1], sa[(3u^2-u+3)/u ,1,1,1], s[0,0,u,1]}]] (* = 9(3u^2-2u+3)^4/u^2 *) (*-------------------------- Lemma 3.12(5) ---------------------------------*) FrakQ1[a_,b_,c_,d_] := s1[a,b,c,d] - 2 s2[a,b,c,d] A5 := {s[0,1,1,1], s[0,0,1,1], s[0,0,0,1]} (* = {{3,6,3,3}, {2,2,1,0}, {1,0,0,0}} *) NullSpace[A5] (* ={{0,-1,2,0}} *) (*-------------------------- Lemma 3.12(6) ---------------------------------*) FrakQ2[a_,b_,c_,d_] := s3[a,b,c,d] Factor[FrakQ2[a,b,0,0]] (* = 0 *) A6 := {s[0,0,0,1], s[0,0,1,1], s[0,0,1,2]} (* = {{1,0,0,0}, {2,2,1,0}, {17,10,4,0}} *) NullSpace[A6] (* = {{0,0,0,1}} *) (*---------------------------- Lemma 3.16 -----------------------------------*) (* Discriminants in homogeneous form *) DiscC1h[p0_,p1_,p2_,p3_] := 8p0^2 - 9 p1^2 + 12 p0 p1 + 12 p0 p2 + 12 p0 p3 DiscC4h[p0_,p1_,p2_,p3_] := -8 p0^2 - p1^2 + 4 p0 p2 DiscP3h[p0_,p1_,p2_,p3_] := p0 + 2p1 + p2+ p3 DiscP4h[p0_,p1_,p2_,p3_] := 2p0 + 2p1 + p2 DiscP5h[p0_,p1_,p2_,p3_] := p0 FrakGt[a,b,c,d,t] := (1/3)(3 s0[a,b,c,d] - 2(t+1) (s1[a,b,c,d] - s3[a,b,c,d]) + (t^2+2t-1) s2[a,b,c,d]) FrakP[a_,b_,c_,d_] := s2[a,b,c,d] - s3[a,b,c,d] (* $(1/3){\frak f}_t + \alpha {\frak p} = s_0 + (-2(t+1)/3) s_1 + ((t^2+2t-1)/3 + \alpha) s_2 + (2(t+1)/3 - \alpha) s_3 *) Factor[DiscC1h[1, -2(t+1)/3, (t^2+2t-1)/3 + alpha, 2(t+1)/3 - alpha]] (* = 0 *) (* $f = (1/3u^3){\frak h}_u^c + v {\frak q}_2 = s0 - (2(u^2+1)/u) s1 + ((u^4+4u^2+1)/u^2) s2 + (2(3u^4+3u^3+2u^2+3u+3)/(3u^2) + v) s3$ *) Eliminate[{p1==-2(u^2+1)/u, p2==(u^4+4u^2+1)/u^2, p3==2(3u^4+3u^3+2u^2+3u+3)/(3u^2) + v}, {u,v}] Factor[DiscC4h[1, -2(u^2+1)/u, (u^4+4u^2+1)/u^2, 2(3u^4+3u^3+2u^2+3u+3)/(3u^2) + v]] (*----------------------- Proof of Proposition 1.7(2) -----------------------*) F[x_,y_,z_,t_] := 3 FrakFtab[x, y, z-x-y, -z, t] f[x_,y_,t_] := F[x,y,1,t] Factor[f[x,0,t]] (* = 8(t+1)(x^2-x+1)^2 > 0 *) Factor[f[0,x,t]] (* = 8(t+1)(x^2-x+1)^2 > 0 *) Factor[F[1,0,z,t]] (* = 8(t+1)(z^2-z+1)^2 > 0 *) Factor[F[0,1,z,t]] (* = 8(t+1)(z^2-z+1)^2 > 0 *) Factor[f[-1,1,t]] (* = -16(t-1)^2 < 0 *) Factor[f[1,-1,t]] (* = -16(t-1)^2 < 0 *) Factor[f[1,1,t]] (* = -16(t-1)^2 < 0 *) Factor[3 FrakFtab[1,0,z-1-0, -z, t]] (*= 8(1+t)(z^2-z+1)^2 *) (*----------------------- Proof of Proposition 1.7(3) -----------------------*) G[x_,y_,z_,t_] := 9 FrakFtc[x, y, z-x-y, -z, t] g[x_,y_,t_] := G[x,y,1,t] Factor[g[x,0,t]] (* = (t+7)^2(x^2-x+1)^2 *) Factor[g[0,x,t]] (* = (t+7)^2(x^2-x+1)^2 *) Factor[G[1,0,z,t]] (* = (t+7)^2(z^2-z+1)^2 *) Factor[G[0,1,z,t]] (* = (t+7)^2(z^2-z+1)^2 *) Factor[g[1,1,t]] (* = -32(t^2+2t-11) < 0 *) Factor[g[1,-1,t]] (* = -32(t^2+2t-11) < 0 *) Factor[g[-1,1,t]] (* = -32(t^2+2t-11) < 0 *) (*--------------------- Proof of Proposition 1.7(2-ii) ----------------------*) Factor[FrakFtab[x,y,1,1,1] - (1/3)(x-y)^2(3x^2+2x y+3y^2-8x-8y+8)] (*----------------------- Proof of Proposition 1.5 --------------------------*) f1[a_,b_,c_,d_]:=a^4 f2[a_,b_,c_,d_]:=a^3b f3[a_,b_,c_,d_]:=a^3c f4[a_,b_,c_,d_]:=a^3d f5[a_,b_,c_,d_]:=a^2b^2 f6[a_,b_,c_,d_]:=a^2b c f7[a_,b_,c_,d_]:=a^2b d f8[a_,b_,c_,d_]:=a^2c^2 f9[a_,b_,c_,d_]:=a^2c d f10[a_,b_,c_,d_]:=a^2d^2 f11[a_,b_,c_,d_]:=a b^3 f12[a_,b_,c_,d_]:=a b^2c f13[a_,b_,c_,d_]:=a b^2d f14[a_,b_,c_,d_]:=a b c^2 f15[a_,b_,c_,d_]:=a b c d f16[a_,b_,c_,d_]:=a b d^2 f17[a_,b_,c_,d_]:=a c^3 f18[a_,b_,c_,d_]:=a c^2d f19[a_,b_,c_,d_]:=a c d^2 f20[a_,b_,c_,d_]:=a d^3 f21[a_,b_,c_,d_]:=b^4 f22[a_,b_,c_,d_]:=b^3c f23[a_,b_,c_,d_]:=b^3d f24[a_,b_,c_,d_]:=b^2c^2 f25[a_,b_,c_,d_]:=b^2c d f26[a_,b_,c_,d_]:=b^2d^2 f27[a_,b_,c_,d_]:=b c^3 f28[a_,b_,c_,d_]:=b c^2d f29[a_,b_,c_,d_]:=b c d^2 f30[a_,b_,c_,d_]:=b d^3 f31[a_,b_,c_,d_]:=c^4 f32[a_,b_,c_,d_]:=c^3d f33[a_,b_,c_,d_]:=c^2d^2 f34[a_,b_,c_,d_]:=c d^3 f35[a_,b_,c_,d_]:=d^4 f[a_,b_,c_,d_]:={f1[a,b,c,d],f2[a,b,c,d],f3[a,b,c,d],f4[a,b,c,d],f5[a,b,c,d],f6[a,b,c,d],f7[a,b,c,d],f8[a,b,c,d],f9[a,b,c,d],f10[a,b,c,d],f11[a,b,c,d],f12[a,b,c,d],f13[a,b,c,d],f14[a,b,c,d],f15[a,b,c,d],f16[a,b,c,d],f17[a,b,c,d],f18[a,b,c,d],f19[a,b,c,d],f20[a,b,c,d],f21[a,b,c,d],f22[a,b,c,d],f23[a,b,c,d],f24[a,b,c,d],f25[a,b,c,d],f26[a,b,c,d],f27[a,b,c,d],f28[a,b,c,d],f29[a,b,c,d],f30[a,b,c,d],f31[a,b,c,d],f32[a,b,c,d],f33[a,b,c,d],f34[a,b,c,d],f35[a,b,c,d]} (* If $\{frak f}_t^{ab}(a^2,b^2,c^2,d^2) = \sum f_i(a,b,c,d)^2$ or ${\frak f}_t^c(a^2,b^2,c^2,d^2) = \sum f_i(a,b,c,d)^2$, $f_i$ (a,b,c,d) must has the following 35 zeros: *) Factor[Det[{f[1,1,-1,-1], f[1,1,1,s], f[-s,1,1,1], f[1,-s,1,1], f[1,1,-s,1], f[1,1,1,-s], f[s,-1,1,1], f[s,1,-1,1], f[s,1,1,-1], f[-1,s,1,1], f[1,s,-1,1], f[1,s,1,-1], f[-1,1,s,1], f[1,-1,s,1], f[1,1,s,-1], f[-1,1,1,s], f[1,-1,1,s], f[1,1,-1,s], f[s,1,-1,-1], f[s,-1,1,-1], f[s,-1,-1,1], f[-1,s,1,-1], f[-1,s,-1,1], f[1,s,-1,-1], f[-1,-1,s,1], f[1,-1,s,-1], f[-1,1,s,-1], f[1,-1,-1,s], f[-1,1,-1,s], f[-1,-1,1,s], f[v,1,0,0], f[v,0,-1,0], f[v,0,0,-1], f[0,v,1,0], f[0,v,0,1]}]] (* = 549755813888 s^(13) (s^2-1)^(23) (s^2+3)^6 v^6 (1+s^2-2v^2)(-2+v^2+s^2v^2)(1+v^2+s^2v^2-3v^4) *) (*----------------------- Proof of Proposition 1.6 --------------------------*) f1[a_,b_,c_,d_]:=a^4 f2[a_,b_,c_,d_]:=a^3b f3[a_,b_,c_,d_]:=a^3c f4[a_,b_,c_,d_]:=a^3d f5[a_,b_,c_,d_]:=a^2b^2 f6[a_,b_,c_,d_]:=a^2b c f7[a_,b_,c_,d_]:=a^2b d f8[a_,b_,c_,d_]:=a^2c^2 f9[a_,b_,c_,d_]:=a^2c d f10[a_,b_,c_,d_]:=a^2d^2 f11[a_,b_,c_,d_]:=a b^3 f12[a_,b_,c_,d_]:=a b^2c f13[a_,b_,c_,d_]:=a b^2d f14[a_,b_,c_,d_]:=a b c^2 f15[a_,b_,c_,d_]:=a b c d f16[a_,b_,c_,d_]:=a b d^2 f17[a_,b_,c_,d_]:=a c^3 f18[a_,b_,c_,d_]:=a c^2d f19[a_,b_,c_,d_]:=a c d^2 f20[a_,b_,c_,d_]:=a d^3 f21[a_,b_,c_,d_]:=b^4 f22[a_,b_,c_,d_]:=b^3c f23[a_,b_,c_,d_]:=b^3d f24[a_,b_,c_,d_]:=b^2c^2 f25[a_,b_,c_,d_]:=b^2c d f26[a_,b_,c_,d_]:=b^2d^2 f27[a_,b_,c_,d_]:=b c^3 f28[a_,b_,c_,d_]:=b c^2d f29[a_,b_,c_,d_]:=b c d^2 f30[a_,b_,c_,d_]:=b d^3 f31[a_,b_,c_,d_]:=c^4 f32[a_,b_,c_,d_]:=c^3d f33[a_,b_,c_,d_]:=c^2d^2 f34[a_,b_,c_,d_]:=c d^3 f35[a_,b_,c_,d_]:=d^4 f[a_,b_,c_,d_]:={f1[a,b,c,d],f2[a,b,c,d],f3[a,b,c,d],f4[a,b,c,d],f5[a,b,c,d],f6[a,b,c,d],f7[a,b,c,d],f8[a,b,c,d],f9[a,b,c,d],f10[a,b,c,d],f11[a,b,c,d],f12[a,b,c,d],f13[a,b,c,d],f14[a,b,c,d],f15[a,b,c,d],f16[a,b,c,d],f17[a,b,c,d],f18[a,b,c,d],f19[a,b,c,d],f20[a,b,c,d],f21[a,b,c,d],f22[a,b,c,d],f23[a,b,c,d],f24[a,b,c,d],f25[a,b,c,d],f26[a,b,c,d],f27[a,b,c,d],f28[a,b,c,d],f29[a,b,c,d],f30[a,b,c,d],f31[a,b,c,d],f32[a,b,c,d],f33[a,b,c,d],f34[a,b,c,d],f35[a,b,c,d]} fa1[a_,b_,c_,d_]:=4a^3 fa2[a_,b_,c_,d_]:=3a^2b fa3[a_,b_,c_,d_]:=3a^2c fa4[a_,b_,c_,d_]:=3a^2d fa5[a_,b_,c_,d_]:=2a b^2 fa6[a_,b_,c_,d_]:=2a b c fa7[a_,b_,c_,d_]:=2a b d fa8[a_,b_,c_,d_]:=2a c^2 fa9[a_,b_,c_,d_]:=2a c d fa10[a_,b_,c_,d_]:=2a d^2 fa11[a_,b_,c_,d_]:=b^3 fa12[a_,b_,c_,d_]:=b^2c fa13[a_,b_,c_,d_]:=b^2d fa14[a_,b_,c_,d_]:=b c^2 fa15[a_,b_,c_,d_]:=b c d fa16[a_,b_,c_,d_]:=b d^2 fa17[a_,b_,c_,d_]:=c^3 fa18[a_,b_,c_,d_]:=c^2d fa19[a_,b_,c_,d_]:=c d^2 fa20[a_,b_,c_,d_]:=d^3 fa21[a_,b_,c_,d_]:=0 fa22[a_,b_,c_,d_]:=0 fa23[a_,b_,c_,d_]:=0 fa24[a_,b_,c_,d_]:=0 fa25[a_,b_,c_,d_]:=0 fa26[a_,b_,c_,d_]:=0 fa27[a_,b_,c_,d_]:=0 fa28[a_,b_,c_,d_]:=0 fa29[a_,b_,c_,d_]:=0 fa30[a_,b_,c_,d_]:=0 fa31[a_,b_,c_,d_]:=0 fa32[a_,b_,c_,d_]:=0 fa33[a_,b_,c_,d_]:=0 fa34[a_,b_,c_,d_]:=0 fa35[a_,b_,c_,d_]:=0 fa[a_,b_,c_,d_]:={fa1[a,b,c,d],fa2[a,b,c,d],fa3[a,b,c,d],fa4[a,b,c,d],fa5[a,b,c,d],fa6[a,b,c,d],fa7[a,b,c,d],fa8[a,b,c,d],fa9[a,b,c,d],fa10[a,b,c,d],fa11[a,b,c,d],fa12[a,b,c,d],fa13[a,b,c,d],fa14[a,b,c,d],fa15[a,b,c,d],fa16[a,b,c,d],fa17[a,b,c,d],fa18[a,b,c,d],fa19[a,b,c,d],fa20[a,b,c,d],fa21[a,b,c,d],fa22[a,b,c,d],fa23[a,b,c,d],fa24[a,b,c,d],fa25[a,b,c,d],fa26[a,b,c,d],fa27[a,b,c,d],fa28[a,b,c,d],fa29[a,b,c,d],fa30[a,b,c,d],fa31[a,b,c,d],fa32[a,b,c,d],fa33[a,b,c,d],fa34[a,b,c,d],fa35[a,b,c,d]} fb1[a_,b_,c_,d_]:=0 fb2[a_,b_,c_,d_]:=a^3 fb3[a_,b_,c_,d_]:=0 fb4[a_,b_,c_,d_]:=0 fb5[a_,b_,c_,d_]:=2a^2b fb6[a_,b_,c_,d_]:=a^2c fb7[a_,b_,c_,d_]:=a^2d fb8[a_,b_,c_,d_]:=0 fb9[a_,b_,c_,d_]:=0 fb10[a_,b_,c_,d_]:=0 fb11[a_,b_,c_,d_]:=3a b^2 fb12[a_,b_,c_,d_]:=2a b c fb13[a_,b_,c_,d_]:=2a b d fb14[a_,b_,c_,d_]:=a c^2 fb15[a_,b_,c_,d_]:=a c d fb16[a_,b_,c_,d_]:=a d^2 fb17[a_,b_,c_,d_]:=0 fb18[a_,b_,c_,d_]:=0 fb19[a_,b_,c_,d_]:=0 fb20[a_,b_,c_,d_]:=0 fb21[a_,b_,c_,d_]:=4b^3 fb22[a_,b_,c_,d_]:=3b^2c fb23[a_,b_,c_,d_]:=3b^2d fb24[a_,b_,c_,d_]:=2b c^2 fb25[a_,b_,c_,d_]:=2b c d fb26[a_,b_,c_,d_]:=2b d^2 fb27[a_,b_,c_,d_]:=c^3 fb28[a_,b_,c_,d_]:=c^2d fb29[a_,b_,c_,d_]:=c d^2 fb30[a_,b_,c_,d_]:=d^3 fb31[a_,b_,c_,d_]:=0 fb32[a_,b_,c_,d_]:=0 fb33[a_,b_,c_,d_]:=0 fb34[a_,b_,c_,d_]:=0 fb35[a_,b_,c_,d_]:=0 fb[a_,b_,c_,d_]:={fb1[a,b,c,d],fb2[a,b,c,d],fb3[a,b,c,d],fb4[a,b,c,d],fb5[a,b,c,d],fb6[a,b,c,d],fb7[a,b,c,d],fb8[a,b,c,d],fb9[a,b,c,d],fb10[a,b,c,d],fb11[a,b,c,d],fb12[a,b,c,d],fb13[a,b,c,d],fb14[a,b,c,d],fb15[a,b,c,d],fb16[a,b,c,d],fb17[a,b,c,d],fb18[a,b,c,d],fb19[a,b,c,d],fb20[a,b,c,d],fb21[a,b,c,d],fb22[a,b,c,d],fb23[a,b,c,d],fb24[a,b,c,d],fb25[a,b,c,d],fb26[a,b,c,d],fb27[a,b,c,d],fb28[a,b,c,d],fb29[a,b,c,d],fb30[a,b,c,d],fb31[a,b,c,d],fb32[a,b,c,d],fb33[a,b,c,d],fb34[a,b,c,d],fb35[a,b,c,d]} fc1[a_,b_,c_,d_]:=0 fc2[a_,b_,c_,d_]:=0 fc3[a_,b_,c_,d_]:=a^3 fc4[a_,b_,c_,d_]:=0 fc5[a_,b_,c_,d_]:=0 fc6[a_,b_,c_,d_]:=a^2b fc7[a_,b_,c_,d_]:=0 fc8[a_,b_,c_,d_]:=2a^2c fc9[a_,b_,c_,d_]:=a^2d fc10[a_,b_,c_,d_]:=0 fc11[a_,b_,c_,d_]:=0 fc12[a_,b_,c_,d_]:=a b^2 fc13[a_,b_,c_,d_]:=0 fc14[a_,b_,c_,d_]:=2a b c fc15[a_,b_,c_,d_]:=a b d fc16[a_,b_,c_,d_]:=0 fc17[a_,b_,c_,d_]:=3a c^2 fc18[a_,b_,c_,d_]:=2a c d fc19[a_,b_,c_,d_]:=a d^2 fc20[a_,b_,c_,d_]:=0 fc21[a_,b_,c_,d_]:=0 fc22[a_,b_,c_,d_]:=b^3 fc23[a_,b_,c_,d_]:=0 fc24[a_,b_,c_,d_]:=2b^2c fc25[a_,b_,c_,d_]:=b^2d fc26[a_,b_,c_,d_]:=0 fc27[a_,b_,c_,d_]:=3b c^2 fc28[a_,b_,c_,d_]:=2b c d fc29[a_,b_,c_,d_]:=b d^2 fc30[a_,b_,c_,d_]:=0 fc31[a_,b_,c_,d_]:=4c^3 fc32[a_,b_,c_,d_]:=3c^2d fc33[a_,b_,c_,d_]:=2c d^2 fc34[a_,b_,c_,d_]:=d^3 fc35[a_,b_,c_,d_]:=0 fc[a_,b_,c_,d_]:={fc1[a,b,c,d],fc2[a,b,c,d],fc3[a,b,c,d],fc4[a,b,c,d],fc5[a,b,c,d],fc6[a,b,c,d],fc7[a,b,c,d],fc8[a,b,c,d],fc9[a,b,c,d],fc10[a,b,c,d],fc11[a,b,c,d],fc12[a,b,c,d],fc13[a,b,c,d],fc14[a,b,c,d],fc15[a,b,c,d],fc16[a,b,c,d],fc17[a,b,c,d],fc18[a,b,c,d],fc19[a,b,c,d],fc20[a,b,c,d],fc21[a,b,c,d],fc22[a,b,c,d],fc23[a,b,c,d],fc24[a,b,c,d],fc25[a,b,c,d],fc26[a,b,c,d],fc27[a,b,c,d],fc28[a,b,c,d],fc29[a,b,c,d],fc30[a,b,c,d],fc31[a,b,c,d],fc32[a,b,c,d],fc33[a,b,c,d],fc34[a,b,c,d],fc35[a,b,c,d]} fd1[a_,b_,c_,d_]:=0 fd2[a_,b_,c_,d_]:=0 fd3[a_,b_,c_,d_]:=0 fd4[a_,b_,c_,d_]:=a^3 fd5[a_,b_,c_,d_]:=0 fd6[a_,b_,c_,d_]:=0 fd7[a_,b_,c_,d_]:=a^2b fd8[a_,b_,c_,d_]:=0 fd9[a_,b_,c_,d_]:=a^2c fd10[a_,b_,c_,d_]:=2a^2d fd11[a_,b_,c_,d_]:=0 fd12[a_,b_,c_,d_]:=0 fd13[a_,b_,c_,d_]:=a b^2 fd14[a_,b_,c_,d_]:=0 fd15[a_,b_,c_,d_]:=a b c fd16[a_,b_,c_,d_]:=2a b d fd17[a_,b_,c_,d_]:=0 fd18[a_,b_,c_,d_]:=a c^2 fd19[a_,b_,c_,d_]:=2a c d fd20[a_,b_,c_,d_]:=3a d^2 fd21[a_,b_,c_,d_]:=0 fd22[a_,b_,c_,d_]:=0 fd23[a_,b_,c_,d_]:=b^3 fd24[a_,b_,c_,d_]:=0 fd25[a_,b_,c_,d_]:=b^2c fd26[a_,b_,c_,d_]:=2b^2d fd27[a_,b_,c_,d_]:=0 fd28[a_,b_,c_,d_]:=b c^2 fd29[a_,b_,c_,d_]:=2b c d fd30[a_,b_,c_,d_]:=3b d^2 fd31[a_,b_,c_,d_]:=0 fd32[a_,b_,c_,d_]:=c^3 fd33[a_,b_,c_,d_]:=2c^2d fd34[a_,b_,c_,d_]:=3c d^2 fd35[a_,b_,c_,d_]:=4d^3 fd[a_,b_,c_,d_]:={fd1[a,b,c,d],fd2[a,b,c,d],fd3[a,b,c,d],fd4[a,b,c,d],fd5[a,b,c,d],fd6[a,b,c,d],fd7[a,b,c,d],fd8[a,b,c,d],fd9[a,b,c,d],fd10[a,b,c,d],fd11[a,b,c,d],fd12[a,b,c,d],fd13[a,b,c,d],fd14[a,b,c,d],fd15[a,b,c,d],fd16[a,b,c,d],fd17[a,b,c,d],fd18[a,b,c,d],fd19[a,b,c,d],fd20[a,b,c,d],fd21[a,b,c,d],fd22[a,b,c,d],fd23[a,b,c,d],fd24[a,b,c,d],fd25[a,b,c,d],fd26[a,b,c,d],fd27[a,b,c,d],fd28[a,b,c,d],fd29[a,b,c,d],fd30[a,b,c,d],fd31[a,b,c,d],fd32[a,b,c,d],fd33[a,b,c,d],fd34[a,b,c,d],fd35[a,b,c,d]} faa1[a_,b_,c_,d_]:=12a^2 faa2[a_,b_,c_,d_]:=6a b faa3[a_,b_,c_,d_]:=6a c faa4[a_,b_,c_,d_]:=6a d faa5[a_,b_,c_,d_]:=2b^2 faa6[a_,b_,c_,d_]:=2b c faa7[a_,b_,c_,d_]:=2b d faa8[a_,b_,c_,d_]:=2c^2 faa9[a_,b_,c_,d_]:=2c d faa10[a_,b_,c_,d_]:=2d^2 faa11[a_,b_,c_,d_]:=0 faa12[a_,b_,c_,d_]:=0 faa13[a_,b_,c_,d_]:=0 faa14[a_,b_,c_,d_]:=0 faa15[a_,b_,c_,d_]:=0 faa16[a_,b_,c_,d_]:=0 faa17[a_,b_,c_,d_]:=0 faa18[a_,b_,c_,d_]:=0 faa19[a_,b_,c_,d_]:=0 faa20[a_,b_,c_,d_]:=0 faa21[a_,b_,c_,d_]:=0 faa22[a_,b_,c_,d_]:=0 faa23[a_,b_,c_,d_]:=0 faa24[a_,b_,c_,d_]:=0 faa25[a_,b_,c_,d_]:=0 faa26[a_,b_,c_,d_]:=0 faa27[a_,b_,c_,d_]:=0 faa28[a_,b_,c_,d_]:=0 faa29[a_,b_,c_,d_]:=0 faa30[a_,b_,c_,d_]:=0 faa31[a_,b_,c_,d_]:=0 faa32[a_,b_,c_,d_]:=0 faa33[a_,b_,c_,d_]:=0 faa34[a_,b_,c_,d_]:=0 faa35[a_,b_,c_,d_]:=0 faa[a_,b_,c_,d_]:={faa1[a,b,c,d],faa2[a,b,c,d],faa3[a,b,c,d],faa4[a,b,c,d],faa5[a,b,c,d],faa6[a,b,c,d],faa7[a,b,c,d],faa8[a,b,c,d],faa9[a,b,c,d],faa10[a,b,c,d],faa11[a,b,c,d],faa12[a,b,c,d],faa13[a,b,c,d],faa14[a,b,c,d],faa15[a,b,c,d],faa16[a,b,c,d],faa17[a,b,c,d],faa18[a,b,c,d],faa19[a,b,c,d],faa20[a,b,c,d],faa21[a,b,c,d],faa22[a,b,c,d],faa23[a,b,c,d],faa24[a,b,c,d],faa25[a,b,c,d],faa26[a,b,c,d],faa27[a,b,c,d],faa28[a,b,c,d],faa29[a,b,c,d],faa30[a,b,c,d],faa31[a,b,c,d],faa32[a,b,c,d],faa33[a,b,c,d],faa34[a,b,c,d],faa35[a,b,c,d]} faaa1[a_,b_,c_,d_]:=24a faaa2[a_,b_,c_,d_]:=6b faaa3[a_,b_,c_,d_]:=6c faaa4[a_,b_,c_,d_]:=6d faaa5[a_,b_,c_,d_]:=0 faaa6[a_,b_,c_,d_]:=0 faaa7[a_,b_,c_,d_]:=0 faaa8[a_,b_,c_,d_]:=0 faaa9[a_,b_,c_,d_]:=0 faaa10[a_,b_,c_,d_]:=0 faaa11[a_,b_,c_,d_]:=0 faaa12[a_,b_,c_,d_]:=0 faaa13[a_,b_,c_,d_]:=0 faaa14[a_,b_,c_,d_]:=0 faaa15[a_,b_,c_,d_]:=0 faaa16[a_,b_,c_,d_]:=0 faaa17[a_,b_,c_,d_]:=0 faaa18[a_,b_,c_,d_]:=0 faaa19[a_,b_,c_,d_]:=0 faaa20[a_,b_,c_,d_]:=0 faaa21[a_,b_,c_,d_]:=0 faaa22[a_,b_,c_,d_]:=0 faaa23[a_,b_,c_,d_]:=0 faaa24[a_,b_,c_,d_]:=0 faaa25[a_,b_,c_,d_]:=0 faaa26[a_,b_,c_,d_]:=0 faaa27[a_,b_,c_,d_]:=0 faaa28[a_,b_,c_,d_]:=0 faaa29[a_,b_,c_,d_]:=0 faaa30[a_,b_,c_,d_]:=0 faaa31[a_,b_,c_,d_]:=0 faaa32[a_,b_,c_,d_]:=0 faaa33[a_,b_,c_,d_]:=0 faaa34[a_,b_,c_,d_]:=0 faaa35[a_,b_,c_,d_]:=0 faaa[a_,b_,c_,d_]:={faaa1[a,b,c,d],faaa2[a,b,c,d],faaa3[a,b,c,d],faaa4[a,b,c,d],faaa5[a,b,c,d],faaa6[a,b,c,d],faaa7[a,b,c,d],faaa8[a,b,c,d],faaa9[a,b,c,d],faaa10[a,b,c,d],faaa11[a,b,c,d],faaa12[a,b,c,d],faaa13[a,b,c,d],faaa14[a,b,c,d],faaa15[a,b,c,d],faaa16[a,b,c,d],faaa17[a,b,c,d],faaa18[a,b,c,d],faaa19[a,b,c,d],faaa20[a,b,c,d],faaa21[a,b,c,d],faaa22[a,b,c,d],faaa23[a,b,c,d],faaa24[a,b,c,d],faaa25[a,b,c,d],faaa26[a,b,c,d],faaa27[a,b,c,d],faaa28[a,b,c,d],faaa29[a,b,c,d],faaa30[a,b,c,d],faaa31[a,b,c,d],faaa32[a,b,c,d],faaa33[a,b,c,d],faaa34[a,b,c,d],faaa35[a,b,c,d]} tu[u_] := (3u^2-u+3)/u Ac[u_] := {{1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0}, fa[1,1,1,1], fb[1,1,1,1], f[tu[u],1,1,1], fa[tu[u],1,1,1], fb[tu[u],1,1,1], f[1,tu[u],1,1], fa[1,tu[u],1,1], fb[1,tu[u],1,1], fc[1,tu[u],1,1], f[1,1,tu[u],1], fa[1,1,tu[u],1], fb[1,1,tu[u],1], fc[1,1,tu[u],1], f[1,1,1,tu[u]], fa[1,1,1,tu[u]], fb[1,1,1,tu[u]], fc[1,1,1,tu[u]], f[0,0,u,1], fc[0,0,u,1], f[0,u,0,1], fb[0,u,0,1], f[0,u,1,0], fb[0,u,1,0], f[u,0,0,1], fa[u,0,0,1], f[u,0,1,0], f[u,1,0,0], fa[u,1,0,0], f[0,0,1,u], f[0,1,0,u], f[0,1,u,0], f[1,0,0,u], f[1,0,u,0], f[1,u,0,0]} Factor[Det[Ac[u]] - 36 tu[u](tu[u]+3)(tu[u]-1)^(25) u^(12) (u^2-1)^(12) (u^2+1)^2 (12u^4+12u^3+21u^2+10u+9)] (* = 0 *) (* = (36/(u^15)) (u-1)^(12) (u+1)^(12) (u^2+1)^2 (3u^2-2u+3)^(25) (3u^2-u+3)(3u^2+2u+3)(12u^4+12u^3+21u^2+10u+9) *) tu[u_] := (3u^2-u+3)/u Atc[u_] := {f[1,1,1,1], fa[1,1,1,1], fb[1,1,1,1], fc[1,1,1,1], f[tu[u],1,1,1], fa[tu[u],1,1,1], fb[tu[u],1,1,1], fc[tu[u],1,1,1], f[1,tu[u],1,1], fa[1,tu[u],1,1], fb[1,tu[u],1,1], fc[1,tu[u],1,1], f[1,1,tu[u],1], fa[1,1,tu[u],1], fb[1,1,tu[u],1], fc[1,1,tu[u],1], f[1,1,1,tu[u]], fa[1,1,1,tu[u]], fb[1,1,1,tu[u]], fc[1,1,1,tu[u]], f[0,0,u,1], fc[0,0,u,1], f[0,u,0,1], fb[0,u,0,1], f[0,u,1,0], fb[0,u,1,0], f[u,0,0,1], fa[u,0,0,1], f[u,0,1,0], fa[u,0,1,0], f[u,1,0,0], fa[u,1,0,0], f[0,0,1,u], fc[0,0,1,u], f[0,1,0,u], fb[0,1,0,u], f[0,1,u,0], fb[0,1,u,0], f[1,0,0,u], fa[1,0,0,u], f[1,0,u,0], fa[1,0,u,0], f[1,u,0,0], fa[1,u,0,0]} Factor[RowReduce[Atc[u]]] (* = { {1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-1}, {0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2(1+u^2)/u}, {0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2(1+u^2)/u}, {0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2(1+u^2)/u}, {0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-((1+4u^2+u^4)/u^2)}, {0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-((2(3+3u+2u^2+3u^3+3u^4))/(3u^2))}, {0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-((2(3+3u+2u^2+3u^3+3u^4))/(3u^2))}, {0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-((1+4u^2+u^4)/u^2)}, {0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-((2(3+3u+2u^2+3u^3+3u^4))/(3u^2))}, {0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-((1+4u^2+u^4)/u^2)}, {0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,(2(1+u^2))/u}, {0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-((2(3+3u+2u^2+3u^3+3u^4))/(3u^2))}, {0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-((2(3+3u+2u^2+3u^3+3u^4))/(3u^2))}, {0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-((2(3+3u+2u^2+3u^3+3u^4))/(3u^2))}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,(2(15+22u^2+15u^4))/u^2}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-((2(3+3u+2u^2+3u^3+3u^4))/(3u^2))}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,(2(1+u^2))/u}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-((2(3+3u+2u^2+3u^3+3u^4))/(3u^2))}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-((2(3+3u+2u^2+3u^3+3u^4))/(3u^2))}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,(2(1+u^2))/u}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,-1}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,(2(1+u^2))/u}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,(2(1+u^2))/u}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,-((1+4u^2+u^4)/u^2)}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0, 0,-((2(3+3u+2u^2+3u^3+3u^4))/(3u^2))}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,-((1+4u^2+u^4)/u^2)}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,(2(1+u^2))/u}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,-((2(3+3u+2u^2+3u^3+3u^4))/(3u^2))}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,-((2(3+3u+2u^2+3u^3+3u^4))/(3u^2))}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,(2(1+u^2))/u}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,-1}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,(2(1+u^2))/u}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,-((1+4u^2+u^4)/u^2)}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,(2(1+u^2))/u}} *) (*-------------- Similar observation for $(\frak f}_t^{ab}$ -----------------*) FrakFtab[a_,b_,c_,d_,s_] := (1/3)(3 s0[a,b,c,d] - 2(s+1) s1[a,b,c,d] + 2(2s-1) s2[a,b,c,d] + (s^2+3) s3[a,b,c,d]) Factor[FrakFtab[x,1,1,1,t]] (* = (x-t)^2(x-1)^2 *) Factor[3 FrakFtab[0,0,x,1,t]] (* = (x-1)^2 (3x^3 -2(t-2)x + 3) *) Aab[t_] := {f[1,1,1,1], fa[1,1,1,1], fb[1,1,1,1], fc[1,1,1,1], f[t,1,1,1], fa[t,1,1,1], fb[t,1,1,1], fc[t,1,1,1], f[1,t,1,1], fa[1,t,1,1], fb[1,t,1,1], fc[1,t,1,1], f[1,1,t,1], fa[1,1,t,1], fb[1,1,t,1], fc[1,1,t,1], f[1,1,1,t], fa[1,1,1,t], fb[1,1,1,t], fc[1,1,1,t], f[0,0,1,1], fc[0,0,1,1], f[0,1,0,1], fb[0,1,0,1], f[0,1,1,0], fb[0,1,1,0], f[1,0,0,1], fa[1,0,0,1], f[1,0,1,0], fa[1,0,1,0], f[1,1,0,0], fa[1,1,0,0]} Factor[RowReduce[Aab[t]]] (* Answer is: *) RAab[t_] := { {1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-1}, {0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-1,0}, {0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0}, {0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,2(1+t)}, {0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,2}, {0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,((-3+t) t)/(1+t),0,0,0,((-3+t) t)/(1+t),-1-4t+t^2}, {0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-(((-3+t)t)/(1+t)),0,0,0,0,-(-1+t)^2}, {0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,0,0,0,0,2}, {0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-(((-3+t)t)/(1+t)),-(-1+t)^2}, {0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-2,0,0,0,-2,-2-4t}, {0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-1,0}, {0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-(((-3+t)t)/(1+t)),0,0,0,0,-(-1+t)^2}, {0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,((-3+t)t)/(1+t),0,0,0,((-3+t) t)/(1+t),-1-4t+t^2}, {0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-(((-3+t)t)/(1+t)),-(-1+t)^2}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4(1+t^2)}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-(((-3+t)t)/(1+t)),-(-1+t)^2}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,((-3+t)t)/(1+t),0,0,0,((-3+t)t)/(1+t),-1-4t+t^2}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,-(((-3+t)t)/(1+t)),0,0,0,0,-(-1+t)^2}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,1,0,0,0,1,2(1+t)}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,-1}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,1,2(1+t)}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,-1,0,0,0,0,0}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,-2,0,0,0,-2,-2-4t}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,-(((-3+t)t)/(1+t)),-(-1+t)^2}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,2,0,0,0,0,2}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,0,0,1,2(1+t)}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,-(((-3+t)t)/(1+t)),0,0,0,0,-(-1+t)^2}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,((-3+t)t)/(1+t),0,0,0,((-3+t)t)/(1+t),-1-4t+t^2}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,-1}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,-1,0}, {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,2}} Factor[NullSpace[RAab[t]]] (* Base is the following 3 polynomials: *) FrakFtab[a,b,c,d,t] w2[a_, b_, c_, d_,t_] := (t+1)(a-c)(b-d)((a^2+b^2+c^2+d^2)-2(a b+b c+c d+d a)+((-t^2+4t+1)/(t+1))(a c+b d)) w3[a_, b_, c_, d_,t_] := (a-b)(c-d)((t+1)(a^2+b^2+c^2+d^2) - 2(t+1)(a c+b c+a d+b d) + (-t^2+4t+1)(a b+c d)) (*================== Section 4.1: ${\Cal P}_{4,3}^{c0+}$ ====================*) S3[a0_, a1_, a2_, a3_] := a0^3 + a1^3 + a2^3 + a3^3 S210[a0_, a1_, a2_, a3_] := a0^2 a1 + a1^2 a2 + a2^2 a3 + a3^2 a0 S201[a0_, a1_, a2_, a3_] := a0^2 a2 + a1^2 a3 + a2^2 a0 + a3^2 a1 S120[a0_, a1_, a2_, a3_] := a0^2 a3 + a1^2 a0 + a2^2 a1 + a3^2 a2 S111[a0_, a1_, a2_, a3_] := a0 a1 a2 + a0 a1 a3 + a0 a2 a3 + a1 a2 a3 s0[a0_, a1_, a2_, a3_] := S3[a0,a1,a2,a3] - S111[a0,a1,a2,a3] s1[a0_, a1_, a2_, a3_] := S210[a0,a1,a2,a3] - S111[a0,a1,a2,a3] s2[a0_, a1_, a2_, a3_] := S201[a0,a1,a2,a3] - S111[a0,a1,a2,a3] s3[a0_, a1_, a2_, a3_] := S120[a0,a1,a2,a3] - S111[a0,a1,a2,a3] (* Discriminant $\disc_C$ *) discC[p0_,p1_,p3_] := 27 p0^4 + 4 p0 p1^3 + 4 p0 p3^3 - p1^2 p3^2 - 18 p0^2 p1 p3 dC[x_,y_] := If[x>=0 && y>=0, 1, discC[1,x,y]] (* Discriminant $\disc_S$ *) dS[p0_,p2_,q_,r_] := (p0 - p2 - q)^2 (13 p0^2 - 2 p0 p2 + p2^2 + 2 p0 q + 2 p2 q)^2 (104 p0^3 + 100 p0^2 p2 - 4 p0 p2^2 + 36 p0^2 q + 36 p0 p2 q - p0 q^2 - p2 q^2 + 8 q^3) + (17173 p0^7 - 121 p0^6 p2 - 5639 p0^5 p2^2 + 7651 p0^4 p2^3 - 3489 p0^3 p2^4 + 469 p0^2 p2^5 - 45 p0 p2^6 + p2^7+ 6250 p0^6 q + 10028 p0^5 p2 q + 3142 p0^4 p2^2 q - 1368 p0^3 p2^3 q - 746 p0^2 p2^4 q - 20 p0 p2^5 q - 6 p2^6 q + 898 p0^5 q^2 + 7230 p0^4 p2 q^2 + 1748 p0^3 p2^2 q^2 - 1572 p0^2 p2^3 q^2 - 86 p0 p2^4 q^2 - 26 p2^5 q^2 + 2780 p0^4 q^3 - 368 p0^3 p2 q^3 + 1448 p0^2 p2^2 q^3 - 496 p0 p2^3 q^3 + 28 p2^4 q^3 + 518 p0^3 q^4 + 1018 p0^2 p2 q^4 - 190 p0 p2^2 q^4 + 78 p2^3 q^4 + 164 p0^2 q^5 + 168 p0 p2 q^5 + 4 p2^2 q^5) r^2 + (2495 p0^5 - 317 p0^4 p2 - 1886 p0^3 p2^2 + 842 p0^2 p2^3 - 81 p0 p2^4 + 3 p2^5 + 1768 p0^4 q + 4 p0^3 p2 q - 988 p0^2 p2^2 q + 380 p0 p2^3 q - 12 p2^4 q + 291 p0^3 q^2 + 897 p0^2 p2 q^2 - 463 p0 p2^2 q^2 + 83 p2^3 q^2 + 226 p0^2 q^3 + 92 p0 p2 q^3 - 38 p2^2 q^3 - p0 q^4 - p2 q^4) r^4 + (95 p0^3 + 65 p0^2 p2 - 43 p0 p2^2 + 3 p2^3 + 98 p0^2 q - 20 p0 p2 q - 6 p2^2 q - 4 p0 q^2) r^6 + (-3p0 + p2)r^8 discS[p0_,p1_,p2_,p3_] := (1/4) dS[p0, p2, p1+p3, p1-p3] (* Separator $\eta$ *) eta[x_,y_] := 61 + 62 x + 56 y + 32 x^2 + 30 x y - 6 y^2 + 9 x^3 + 4 x^2 y - 6 x y^2 - 16 y^3 + x^4 - 4 x^2 y^2 - 6 x y^3 + y^4 - x^3 y^2 (* Constants $\kappa_1$ and $\kappa_2$. *) fkappa1[x_] := 817808203x^6-546807084x^5+129155640x^4-13342016x^3+556080x^2-10176x+64 fkappa2[x_] := 43042537x^6-4514514x^5-188769x^4-38684x^3+4119x^2-114x+1 Solve[fkappa1[x]==0] //N kappa1 := 0.012907403163057508` Solve[fkappa2[x]==0] //N kappa2 := 0.03189258447607269` (*------------------------- Theorem 4.1(III) --------------------------------*) s03[a_,b_,c_] := a^3+b^3+c^3-3a b c Factor[s0[a,b,c,d] - (1/3)(s03[a,b,c]+s03[b,c,d]+s03[c,d,a]+s03[d,a,b])] Factor[s2[a,b,c,d] - (a-b+c-d)(a c - b d)] Factor[(s0[a,b,c,d]-s2[a,b,c,d])-(1/3)(s03[a,a,c]+s03[b,b,d]+s03[c,c,a]+s03[d,d,b])] sx1[a_,b_,c_] := a^2c+b^3+a c^2-3a b c Factor[(s0[a,b,c,d]+2s2[a,b,c,d])-(sx1[a,b,c]+sx1[b,c,d]+sx1[c,d,a]+sx1[d,a,b])] s13[a_,b_,c_] := a^2b+b^2c+c^2a-3a b c Factor[(2s1[a,b,c,d]+s2[a,b,c,d])-(s13[a,b,c]+s13[b,c,d]+s13[c,d,a]+s13[d,a,b])] s23[a_,b_,c_] := a b^2 + b c^2 + c a^2 - 3a b c Factor[(2s3[a,b,c,d]+s2[a,b,c,d])-(s23[a,b,c]+s23[b,c,d]+s23[c,d,a]+s23[d,a,b])] Factor[(s0[a,b,c,d]-s1[a,b,c,d])-(1/3)(s03[a,a,b]+s03[b,b,c]+s03[c,c,d]+s03[d,d,a])] Factor[(s0[a,b,c,d]-s3[a,b,c,d])-(1/3)(s03[a,b,b]+s03[b,c,c]+s03[c,d,d]+s03[d,a,a])] Factor[(s1[a,b,c,d]+s3[a,b,c,d])-((a+c)(b-d)^2 + (b+d)(a-c)^2)] s1[1/100, 1/2, 1/10, 1] (* = -(229/20000) < 0 *) (*-------------------------- Proposition 4.2 --------------------------------*) s0[a_,b_,c_,d_] := S3[a,b,c,d] - S111[a,b,c,d] s1[a_,b_,c_,d_] := S210[a,b,c,d] - S111[a,b,c,d] s2[a_,b_,c_,d_] := S201[a,b,c,d] - S111[a,b,c,d] s3[a_,b_,c_,d_] := S120[a,b,c,d] - S111[a,b,c,d] s[a_,b_,c_,d_] := {s0[a,b,c,d], s1[a,b,c,d], s2[a,b,c,d], s3[a,b,c,d]} s0a[a_,b_,c_,d_] := 3 a^2 - b c - b d - c d s1a[a_,b_,c_,d_] := 2 a b - b c - b d - c d + d^2 s2a[a_,b_,c_,d_] := 2 a c - b c + c^2 - b d - c d s3a[a_,b_,c_,d_] := b^2 - b c + 2 a d - b d - c d sa[a_,b_,c_,d_] := {s0a[a,b,c,d], s1a[a,b,c,d], s2a[a,b,c,d], s3a[a,b,c,d]} sb[a_,b_,c_,d_] := sa[b,c,d,a] sc[a_,b_,c_,d_] := sa[c,d,a,b] sd[a_,b_,c_,d_] := sa[d,a,b,c] g0h[u_,v_,w_] := (-v(u w v^2 - (u+w)(u^2+w^2)v + u w(u-w)^2)) g1h[u_,v_,w_] := (u v^4 - w(u+2w)v^3 -2u w(u-w)v^2 - u(2u^3+u^2 w-3w^3)v + w(u^2-w^2)^2) g2h[u_,v_,w_] := (v(v^4+(2u^2-3u w+2w^2)v^2 - (u+w)(u^2+w^2)v + (u-w)^2(u^2-u w+w^2))) g3h[u_,v_,w_] := g1h[w,v,u] FrakEh[a_,b_,c_,d_,u_,v_,w_] := g0h[u,v,w] s0[a,b,c,d] + g1h[u,v,w] s1[a,b,c,d] + g2h[u,v,w] s2[a,b,c,d] + g3h[u,v,w] s3[a,b,c,d] g0[s_,t_] := g0h[s,t,1] g1[s_,t_] := g1h[s,t,1] g2[s_,t_] := g2h[s,t,1] g3[s_,t_] := g3h[s,t,1] g[s_,t_] := {g0[s,t], g1[s,t], g2[s,t], g3[s,t]} FrakE[a_,b_,c_,d_,s_,t_] := FrakEh[a,b,c,d,s,t,1] (*------------------------ Proposition4.2 (1) -------------------------------*) Factor[FrakEh[a,b,c,d,u,v,w] - FrakEh[a,b,c,d,w,v,u] - (u-w)(v-u-w)(v+u+w)((u-w)^2+2(u+w)v+v^2) (s1[a,b,c,d] - s3[a,b,c,d])] (* = 0 *) (*------------------------ Proposition4.2 (2) -------------------------------*) Factor[FrakEh[a,b,c,d,t,1,0] - (t FrakE[a,b,c,d,0,t] - (t^2-1)(t^2+1)^2 s2[a,b,c,d])] (* = 0 *) (*------------------------ Proposition4.2 (3) -------------------------------*) A[u_,v_] := {s[0,u,v,1], sb[0,u,v,1], sc[0,u,v,1]} Factor[A[u,v]] {{u^3-u v+v^3+1, v(u^2-u+v), u(1+u-v), v(u v-u+1)}, {3u^2-v, (2u-1)v, 2u-v+1, v(v-1)}, {3v^2-u, u^2-u+2v, -u, 2u v-u+1}} Facvtor[NullSpace[A[u,v]]] Factor[(u - 2 u^3 + u^5 - 2 v - u v + 3 u^3 v - 2 u v^2 + 2 u^2 v^2 - u v^3 - 2 u^2 v^3 + v^4) {( v (-u + 2 u^2 - u^3 + v + u v + u^2 v + u^3 v - u v^2))/( u - 2 u^3 + u^5 - 2 v - u v + 3 u^3 v - 2 u v^2 + 2 u^2 v^2 - u v^3 - 2 u^2 v^3 + v^4), -((-1 + 2 u^2 - u^4 - 3 u v + u^3 v + 2 u^4 v - 2 u v^2 + 2 u^2 v^2 + 2 v^3 + u v^3 - u v^4)/( u - 2 u^3 + u^5 - 2 v - u v + 3 u^3 v - 2 u v^2 + 2 u^2 v^2 - u v^3 - 2 u^2 v^3 + v^4)), (v (1 - 3 u + 4 u^2 - 3 u^3 + u^4 - v - u v - u^2 v - u^3 v + 2 v^2 - 3 u v^2 + 2 u^2 v^2 + v^4))/(u - 2 u^3 + u^5 - 2 v - u v + 3 u^3 v - 2 u v^2 + 2 u^2 v^2 - u v^3 - 2 u^2 v^3 + v^4), 1}.s[a, b, c, d] - FrakE[a, b, c, d, u, v]] (* = 0 *) Factor[Det[{{1,0,0,0}, {1+u^3-u v+v^3, v(-u+u^2+v), u(1+u-v), v(1-u+u v)}, {3u^2-v, (2u-1)v, 1+2u-v, v(v-1)}, {3v^2-u, u^2-u+2v, -u, 1-u+2u v}}] - (v-u-1) g0[u,v]] (* = 0 *) (*------------------------ Proposition4.2 (4) -------------------------------*) A[t_] := {s[0,0,t,1], sb[0,0,t,1], sc[0,0,t,1]} Factor[A[t]] (* = {{t^3+1, t^2, 0, t}, {-t, -t, 1-t, t(t-1)}, {3t^2, 2t, 0, 1}} *) Factor[Det[{{1,0,0,0}, {t^3+1, t^2, 0, t}, {-t, -t, 1-t, t(t-1)}, {3t^2, 2t, 0, 1}}]] (* = t^2(t-1) *) Factor[NullSpace[A[t]]] Factor[(t (-2+t^3)) {t/(-2+t^3), -((-1+2t^3)/(t(-2+t^3))), (1-t+2t^2+t^4)/(-2+t^3), 1}.s[a, b, c, d] - FrakE[a,b,c,d,0,t]] (* = 0 *) (*------------------------ Proposition4.2 (5) -------------------------------*) Factor[FrakE[a,b,c,d,s,s+1] - (s+1)(s^2+1)^2 (a-b+c-d)^2(a+b+c+d)] A1 := {s[0,0,1,1], sa[0,0,1,1], sa[0,1,2,1]} (* A1 = {{2,1,0,1},{-1,0,0,-1},{-5,-4,-1,-4}} *) NullSpace[A1] (*------------------------ Proposition4.2 (6) -------------------------------*) Factor[FrakE[0,0,1,1,s,t] - (s+1)(t-s-1)^2((s-1)^2+t^2)] (*----------------------------- Lemma 4.3 -----------------------------------*) f43c0[x0_,x1_,x2_,x3_] := (x1^3 - x0 x1 x3 + x3^3)^2 - x2 (x1^3 - x0 x1 x3 + x3^3) (x0^2 + 3 x1^2 - 4 x1 x3 + 3 x3^2) + x2^2 (x0^2 (x1^2 - x1 x3 + x3^2) + 2 x0 x1 x3 (x1 + x3) + x1^4 - 7 x1^3 x3 + 9 x1^2 x3^2 - 7 x1 x3^3 + x3^4) + x2^3 (2 x0 x1^2 - x0 (4 x1^2 + x1 x3 + 2 x3^2) + (x1 + x3) (x1^2 - 3 x1 x3 + x3^2)) + x2^4 (x1^2 + x1 x3 + x3^2) (* Proof of (1) *) Factor[s0[a,b,c,a-b+c]] (* = 2(a+c)(a^2-2a b+2b^2-2b c+c^2) *) Factor[s1[a,b,c,a-b+c]] (* = (a+c)(a^2-2a b+2b^2-2b c+c^2) *) Factor[s2[a,b,c,a-b+c]] (* = 0 *) Factor[s3[a,b,c,a-b+c]] (* = (a+c)(a^2-2a b+2b^2-2b c+c^2) *) Factor[s0[a,b,a,b]] (* = 2(a-b)^2(a+b) *) Factor[s1[a,b,a,b]] (* = 0 *) Factor[s2[a,b,a,b]] (* = 2(a-b)^2(a+b) *) Factor[s3[a,b,a,b]] (* = 0 *) (* Proof of (2): Jacobian of $\Phi_{4,3}^{c0} *) JacPhi43c0[a_,b_,c_,d_] := -(a-b+c-d)^3 ((a-c)^2+(b-d)^2)^2 (a+b+c+d) s0[a,b,c,d]^2 Factor[s0[x,y,z,1]^2 D[s1[x,y,z,1]/s0[x,y,z,1],x]] sS1x[x_,y_,z_] := 1 - 2 x^3 - y + 2 x y + 2 x^3 y - x^4 y - x^2 y^2 + y^3 - y^4 + 2 x y^4 - z + 2 x^3 z - 2 y z + 2 x^2 y z + 2 x^3 y z - 2 x y^2 z - 4 x^2 y^2 z - y^4 z - 3 x^2 z^2 + y z^2 + y^2 z^2 + y^3 z^2 + 2 z^3 + 2 x y z^3 - z^4 - y z^4 Factor[s0[x,y,z,1]^2 D[s2[x,y,z,1]/s0[x,y,z,1],x]] sS2x[x_,y_,z_] := -y - 3 x^2 y + 2 x^3 y + y^2 - 3 x^2 y^2 + y^3 - y^4 - z + 2 x z + 2 x^3 z - x^4 z + 2 x^2 y z + 2 x^3 y z + 2 y^2 z + 2 x y^3 z - y^4 z + z^2 - x^2 z^2 - 2 x^3 z^2 - 2 x y z^2 - x^2 y z^2 + y^3 z^2 - 2 y z^3 - z^4 + 2 x z^4 - y z^4 + z^5 Factor[s0[x,y,z,1]^2 D[s3[x,y,z,1]/s0[x,y,z,1],x]] sS3x[x_,y_,z_] := 2 x - x^4 - y - x^2 y + 2 x^3 y + y^2 - 2 x^3 y^2 + 2 x y^3 - y^4 + y^5 - z - 4 x^2 z + 2 x^3 z - 2 x y z + 2 x^2 y z + 2 x^3 y z - 2 y^3 z - y^4 z + z^2 + y z^2 - 3 x^2 y z^2 + y^2 z^2 + 2 x z^3 + 2 y^2 z^3 - z^4 - y z^4 Factor[s0[x,y,z,1]^2 D[s1[x,y,z,1]/s0[x,y,z,1],y]] sS1y[x_,y_,z_] := -x + 2 x^2 - x^4 + x^5 - 3 x y^2 + 2 x y^3 - 2 x^2 y^3 - z + x^2 z - 2 x^3 z - x^4 z + 2 y z + 2 x^3 y z + 2 x y^2 z + 2 y^3 z + 2 x y^3 z - y^4 z + x z^2 - 2 x y z^2 - 4 y^2 z^2 - x y^2 z^2 + z^3 + x^2 z^3 - z^4 - x z^4 + 2 y z^4 Factor[s0[x,y,z,1]^2 D[s2[x,y,z,1]/s0[x,y,z,1],y]] sS2y[x_,y_,z_] := 1 - x + x^3 - x^4 + 2 y + 2 x^3 y - x y^2 - 2 y^3 + 2 x y^3 - y^4 - z - 2 x z - x^4 z - 2 x y z - y^2 z + 2 x y^2 z - 3 x^2 y^2 z + 2 y^3 z + 2 x y^3 z + 2 x^2 z^2 + x^3 z^2 - 3 x y^2 z^2 + z^3 + x^2 z^3 + 2 y z^3 - z^4 - x z^4 Factor[s0[x,y,z,1]^2 D[s3[x,y,z,1]/s0[x,y,z,1],y]] sS3y[x_,y_,z_] := -x + x^3 - x^4 + 2 x y + 2 x^4 y - 4 x^2 y^2 + 2 x y^3 - x y^4 - z + x^2 z - x^4 z - 2 x^2 y z - 3 y^2 z + 2 x y^2 z - x^2 y^2 z + 2 y^3 z + 2 x y^3 z + 2 z^2 + x z^2 + x^3 z^2 - 2 y^3 z^2 - 2 x z^3 + 2 x y z^3 - z^4 - x z^4 + z^5 Factor[s0[x,y,z,1]^2 D[s1[x,y,z,1]/s0[x,y,z,1],z]] sS1z[x_,y_,z_] := -x + x^2 - x^4 - y + x^2 y - x^4 y + y^2 + x^2 y^2 + 2 x^3 y^2 - 2 x y^3 - y^4 - x y^4 + y^5 + 2 z + 2 x^3 z - 2 x y z + 2 y^3 z - 4 x z^2 - y z^2 + 2 x y z^2 - 3 x^2 y z^2 + 2 x z^3 + 2 y z^3 + 2 x y z^3 - 2 y^2 z^3 - z^4 Factor[s0[x,y,z,1]^2 D[s2[x,y,z,1]/s0[x,y,z,1],z]] sS2z[x_,y_,z_] := -x + x^2 - x^4 + x^5 - y - 2 x^3 y - x^4 y + y^2 + 2 x y^2 + y^3 + x^2 y^3 - y^4 - x y^4 + 2 x z + 2 x^4 z - 2 x^2 y z + 2 x y^3 z - x^2 z^2 - 3 y z^2 + 2 x y z^2 - x^2 y z^2 - 3 y^2 z^2 + 2 x z^3 - 2 x^2 z^3 + 2 y z^3 + 2 x y z^3 - x z^4 Factor[s0[x,y,z,1]^2 D[s3[x,y,z,1]/s0[x,y,z,1],z]] sS3z[x_,y_,z_] := 1 - x + 2 x^3 - x^4 - y - 2 x y + x^2 y - x^4 y + x^2 y^2 + y^3 + x^2 y^3 - y^4 - x y^4 + 2 y z + 2 x^3 y z - 2 x y^2 z + 2 y^4 z - 3 x^2 z^2 + 2 x y z^2 - y^2 z^2 - 4 x y^2 z^2 - 2 z^3 + 2 x z^3 + 2 y z^3 + 2 x y z^3 - y z^4 Factor[Det[{{sS1x[x,y,z],sS2x[x,y,z],sS3x[x,y,z]}, {sS1y[x,y,z],sS2y[x,y,z],sS3y[x,y,z]}, {sS1z[x,y,z],sS2z[x,y,z],sS3z[x,y,z]}}] - JacPhi43c0[x,y,z,1]] (* = 0 *) (* Proof of (2): ${\frak f}_{4,3}^{c0}(\Phi_{4,3}^{c0} *) Factor[f43c0[s0[a,b,c,d], s1[a,b,c,d], s2[a,b,c,d], s3[a,b,c,d]] - a b c d(a-b+c-d)^4 (a+b+c+d)^2 ((a-c)^2+(b-d)^2)^4] (* = 0 *) (*----------------------- Graph of $X_{4,3}^{c0+}$ -------------------------*) ContourPlot3D[f43c0[1,x,y,z]==0, {x,-0.2,1}, {y,-0.2,1}, {z,-0.2,1}] Show[ ParametricPlot3D[{s1[0,s,t,1]/s0[0,s,t,1], s2[0,s,t,1]/s0[0,s,t,1], s3[0,s,t,1]/s0[0,s,t,1]}, {s,0,1}, {t,0,1}, PlotStyle->Blue, PlotRange -> {{-0.1, 0.7}, {-0.1, 1.1}, {-0.1, 0.7}}], ParametricPlot3D[{s1[0,1,s t,s]/s0[0,1,s t,s], s2[0,1,s t,s]/s0[0,1,s t,s], s3[0,1,s t,s]/s0[0,1,s t,s]}, {s,0,1}, {t,0,1}, PlotStyle->Red, PlotRange -> {{-0.1, 0.7}, {-0.1, 1.1}, {-0.1, 0.7}}], ParametricPlot3D[{s1[0,s t,1,t]/s0[0,s t,1,t], s2[0,s t,1,t]/s0[0,s t,1,t], s3[0,s t,1,t]/s0[0,s t,1,t]}, {s,0,1}, {t,0,1}, PlotStyle->Yellow, PlotRange -> {{-0.1, 0.7}, {-0.1, 1.1}, {-0.1, 0.7}}], ParametricPlot3D[{s1[0,t,s,s t]/s0[0,t,s,s t], s2[0,t,s,s t]/s0[0,t,s,s t], s3[0,t,s,s t]/s0[0,t,s,s t]}, {s,0,1}, {t,0,1}, PlotStyle->Pink, PlotRange -> {{-0.1, 0.7}, {-0.1, 1.1}, {-0.1, 0.7}}]] ContourPlot[{x==0, (-1 + 2 x - 3 y)==0, (-x^2 + 2 x^3 - y + x^2 y + 2 y^2 - y^3) == 0}, {x, -0.2, 1}, {y, -0.2, 1}] (*----------------------------- Lemma 4.4 -----------------------------------*) Factor[dS[1,y,z,0]] (* = -(-1+y+z)^2 (13 - 2 y + y^2 + 2 z + 2 y z)^2 (-104 - 100 y + 4 y^2 - 36 z - 36 y z + z^2 + y z^2 - 8 z^3) *) Factor[dS[1, y, -2, x]] (* = (12+x^2-4y)(y-3)(x^2+(y-3)^2)^3 *) Factor[s2[a0,a1,a2,a3] - (a0-a1+a2-a3)(a0 a2 - a1 a3)] (* = 0 *) (*----------------------------- Lemma 4.6 -----------------------------------*) Factor[discS[g0[s,t],g1[s,t],g2[s,t],g3[s,t]]] (* = 0 *) Factor[discS[g0[s,t],g3[s,t],g2[s,t],g1[s,t]]] (* = 0 *) (*----------------------------- Lemma 4.7 -----------------------------------*) (* $\Zar({\Cal F}(P_2) \cap {\Cal F}(C))$ *) (* ${\frak e}_c^{P_2}$ *) FrakEP2[a0_,a1_,a2_,a3_,c_] := s0[a0,a1,a2,a3] + c(c-2)s1[a0,a1,a2,a3] - s2[a0,a1,a2,a3] + c(c+2)s3[a0,a1,a2,a3] (* ${\frak e}_c^{P_2}$ is on a parabola $V\big(p_0+p_2, \, 8p_0(p_1+p_3) - (p_1-p_3)^2\big)$. *) Para[x_,y_] := (x-y)^2-8(x+y) Expand[Para[c(c-2),c(c+2)]] c1[u_,v_] := 2(u-1)v(v-u-1) c2[u_,v_] := (u-1)^2+v(u+1) Factor[FrakEP2[0,u,v,1,c] - v c2[u,v] (c + c1[u,v]/(2v c2[u,v]))^2 + (u+1)((u-1)^2+v^2)^2/c2[u,v]] Factor[discS[p0,p1,-p0,p3] - 2 p0 (8 p0 (p1 + p3) - (p1-p3)^2)^3 ((p0-p1)^2 + (p0-p3)^2)] (* = *) (* i.e. $p_0 = p_2$, $8 p_0 (p_1 + p_3) = (p_1-p_3)^2$. *) Para[x_,y_] := (x-y)^2-8(x+y) (* ${\frak e}_c^{P_2} = \lim_{h \to 0} {\frak e}_{ch+1,h}/4h^2$ *) g[s_,t_] := {g0[s,t], g1[s,t], g2[s,t], g3[s,t]} Factor[g[a t+1,t]/t^2] g0a[t_,a_] := 4 - t + 6 a t - a^2 t - a t^2 + 4 a^2 t^2 - a^3 t^2 + a^3 t^3 g1a[t_,a_] := -8a+4a^2-3t-2a t-15a^2t+4a^3t+t^2-a t^2-2a^2t^2-9a^3t^2+a^4t^2+a t^3-2a^4t^3 g2a[t_,a_] := -4+t-6a t+a^2 t+a t^2-4a^2t^2+a^3t^2+t^3+2a^2t^3-a^3t^3+a^4t^3 g3a[t_,a_] := 8 a + 4 a^2 - 3 t + 2 a t + 9 a^2 t + 8 a^3 t + t^2 - 5 a t^2 + 2 a^2 t^2 + 3 a^3 t^2 + 5 a^4 t^2 - 2 a^2 t^3 + a^5 t^3 ga[t_,a_] := {g0a[t,a], g1a[t,a], g2a[t,a], g3a[t,a]} Factor[ga[0,a]] Factor[FrakEP2[0,u,0,1,t]] = (u+1)(u-1)^2 Factor[g0[s,t]+g2[s,t]] (* = t((s-1)^2+t^2)^2 >= 0 *) EP2B[x_,y_,z_,t_] := (2t^2-4t^2x+2t^2x^2-4t y+4t x y+2y^2+z- x z-x^2z+x^3z+2t y z+t^2y z-2t^2x y z- 2t x^2y z+t^2x^2y z - 2t y^2z + t^2y^2z+2t x y^2z+t^2x y^2z+y^3z) Factor[FrakEP2[x z, y z+1, z, 1, t] - z^2 EP2B[x,y,z,t]] (* = 0 *) Factor[EP2B[x,y,0, t] - 2 (t x+y-t)^2] (* = 0 *) (*------------------------- $f_S^{cusp}(x,y)$ -------------------------------*) fScusp[x_,y_] := (260403739669 + 153581431744 x + 102255553008 x^2 + 5758906656 x^3 + 2375407488 x^4 - 2980119168 x^5 + 472233216 x^6 - 115722240 x^7 + 17307648 x^8 - 438272 x^9 + 4096 x^10 + 89440948796 y + 32061417248 x y + 8138124864 x^2 y - 17528885472 x^3 y - 2067065472 x^4 y - 828572544 x^5 y + 1188607488 x^6 y - 112318464 x^7 y - 15593472 x^8 y - 126976 x^9 y + 8192 x^10 y - 223071977286 y^2 - 16231383328 x y^2 - 12833341936 x^2 y^2 + 40377065344 x^3 y^2 + 5505244544 x^4 y^2 + 4819181440 x^5 y^2 - 264563968 x^6 y^2 + 218927104 x^7 y^2 + 9482240 x^8 y^2 + 176128 x^9 y^2 + 4096 x^10 y^2 + 30713189004 y^3 + 8960225536 x y^3 + 17703049984 x^2 y^3 - 2170474624 x^3 y^3 - 7085133440 x^4 y^3 - 4728214912 x^5 y^3 - 1856392192 x^6 y^3 - 112496640 x^7 y^3 - 3928064 x^8 y^3 - 135168 x^9 y^3 + 61229381323 y^4 - 32671427200 x y^4 - 16135419808 x^2 y^4 - 19363454784 x^3 y^4 + 2347438208 x^4 y^4 + 668450944 x^5 y^4 + 1133005568 x^6 y^4 + 47364096 x^7 y^4 + 1464320 x^8 y^4 - 40004520712 y^5 + 14114790976 x y^5 - 921252992 x^2 y^5 + 9081775296 x^3 y^5 + 71177344 x^4 y^5 + 679918976 x^5 y^5 - 112298496 x^6 y^5 - 6821888 x^7 y^5 + 10688483692 y^6 - 1398548800 x y^6 + 3457102112 x^2 y^6 - 1135819904 x^3 y^6 + 55287936 x^4 y^6 - 134577536 x^5 y^6 - 18625280 x^6 y^6 - 870429832 y^7 + 226903552 x y^7 - 733186304 x^2 y^7 - 48610432 x^3 y^7 - 35363712 x^4 y^7 - 12108928 x^5 y^7 - 108565637 y^8 - 133149760 x y^8 + 1725104 x^2 y^8 + 6646560 x^3 y^8 - 2811392 x^4 y^8 + 4147404 y^9 + 9240992 x y^9 + 5649472 x^2 y^9 - 26336 x^3 y^9 + 2233722 y^10 + 1416544 x y^10 + 84944 x^2 y^10 + 121340 y^11 + 16896 x y^11 + 517 y^12) (*----------------------------- Lemma 4.8 -----------------------------------*) Factor[discS[1,x,y,x] - (2x+y-1)^2 (y^2+4x y+4x-2y+13)^2 (16x^3-x^2y+18x y-x^2-y^2+18x+25y+26)] (*---------------------- Proof of Theorem 4.1(I) ----------------------------*) (* Fig 4.1 *) ContourPlot[{dC[x,z]==0, discS[1,x,-1,z]==0}, {x,-7,10},{z,-7,10}] ContourPlot[{dC[x,z]==0, discS[1,x,0,z]==0}, {x,-7,10},{z,-7,10}] ContourPlot[{dC[x,z]==0, discS[1,x,1,z]==0}, {x,-7,10},{z,-7,10}] ContourPlot[{dC[x,z]==0, discS[1,x,2,z]==0}, {x,-7,10},{z,-7,10}] ContourPlot3D[{dC[x,z]==0, discS[1,x,y,z]==0, y==-1}, {x,-20,30}, {y,-20,30}, {z,-20,30}] ContourPlot3D[{discS[1,x,y,z]==0, dC[x,z]==0, eta[x+z,y]==0}, {x,-2000,5000}, {y,-2,50}, {z,-2000,5000}] Show[ParametricPlot3D[{(1-2y^3)/y^2, (1-y+2y^2+y^4)/ y, (y^3-2)/y}, {y,0,10}, PlotRange -> {{-5,5},{-2,6},{-5,5}}], ParametricPlot3D[{(y^3-2)/y, (1-y+2y^2+y^4)/y, (1-2y^3)/y^2}, {y,0,10}, PlotRange -> {{-5,5},{-2,6},{-5,5}}], ContourPlot3D[{discS[1,x,y,z]==0}, {x,-5,5}, {y,-2,6}, {z,-5,5}]] (* Fig 4.2 *) ContourPlot[{dC[x,z]==0, discS[1,x,3,z]==0, (2+x+z)==0}, {x,-7,10},{z,-7,10}] Factor[discS[1,x,3,z]] (* Fig 4.3, 4.4 *) ContourPlot[{dC[x,z]==0, discS[1,x,4,z]==0}, {x,-20,40},{z,-20,40}] ContourPlot[{dC[x,z]==0, discS[1,x,4,z]==0}, {x,-3,1},{z,-3,1}] ContourPlot[{dC[x,z]==0, discS[1,x,4,z]==0}, {x,-2.2,-1.5},{z,-0.5,0.5}] ContourPlot[{dC[x,z]==0, discS[1,x,4,z]==0}, {x,-9.52,-6.5},{z,11,21}] (* Fig 4.5, 4.6 *) ContourPlot[{dC[x,z]==0, discS[1,x,10,z]==0}, {x,-100,400},{z,-100,400}] ContourPlot[{dC[x,z]==0, discS[1,x,10,z]==0}, {x,-5,5},{z,-5,5}] ContourPlot[{dC[x,z]==0, discS[1,x,10,z]==0}, {x,-25,-20},{z,110,140}] ContourPlot[{dC[x,z]==0, discS[1,x,20,z]==0}, {x,-100,500},{z,-100,500}] ContourPlot[{dC[x,z]==0, discS[1,x,20,z]==0}, {x,-7,7},{z,-7,7}] ContourPlot[{dC[x,z]==0, discS[1,x,20,z]==0}, {x,-45,-35},{z,300,500}] ContourPlot[{dC[x,z]==0, discS[1,x,50,z]==0}, {x,-200,3000},{z,-200,3000}] ContourPlot[{dC[x,z]==0, discS[1,x,50,z]==0}, {x,-15,15},{z,-15,15}] ContourPlot[{dC[x,z]==0, discS[1,x,50,z]==0}, {x,-7.1,-6.8},{z,11.5,12.1}] ContourPlot[{dC[x,z]==0, discS[1,x,50,z]==0}, {x,-110,-50},{z,800,2800}] ContourPlot[{dC[x,z]==0, discS[1,x,200,z]==0}, {x,-400,10000},{z,-400,10000}] ContourPlot[{dC[x,z]==0, discS[1,x,200,z]==0}, {x,-30,50},{z,-30,50}] ContourPlot[{dC[x,z]==0, discS[1,x,200,z]==0}, {x,-30,50},{z,-30,50}] ContourPlot[{dC[x,z]==0, discS[1,x,200,z]==0}, {x,-15,-10},{z,25,42}] ContourPlot[{dC[x,z]==0, discS[1,x,200,z]==0}, {x,-500,-100},{z,4000,63000}] (*---------------------- Proof of Theorem 4.1(II) ---------------------------*) (* $f_3^S(x,y) *) f3S[x_,z_] := x^6 - 4 x^5 z + 7 x^4 z^2 - 8 x^3 z^3 + 7 x^2 z^4 - 4 x z^5 + z^6 - 174 x^5 - 342 x^4 z - 508 x^3 z^2 - 508 x^2 z^3 - 342 x z^4 - 174 z^5 - 414 x^4 - 712 x^3 z - 1332 x^2 z^2 - 712 x z^3 - 414 z^4 - 800 x^3 - 4320 x^2 z - 4320 x z^2 - 800 z^3 - 6592 x^2 - 16512 x z - 6592 z^2 - 16384 x - 16384 z - 11776 Factor[discS[1,x,3,z] + 2(x+z+2)^2 f3S[x,z]] (* = 0 *) (*---------------------- Proof of Theorem 4.1(III) --------------------------*) GLx[w_] := (1-2w^3)/w^2 GLy[w_] := (1-w+2w^2+w^4)/w GLz[w_] := (w^3-2)/w specialww[w_]:=w^4-6w^2-8w+1 (* When w^4-6w^2-8w+1=0, x^4 - 76 x^3 + 30 x^2 + 1956 x - 5303 = 0 y^4 - 28 y^3 - 90 y^2 - 92 y + 16353 = 0 z^4 + 4 z^3 - 178 z^2 + 852 z - 1511 = 0 *) Factor[discC[1,GLx[w],GLz[w]]] (* = 0 *) Factor[discS[1,GLx[w],GLy[w],GLz[w]]] (* = 0 *) (* discSx[x_,y_,z_] := D[discS[1,x,y,z], x] *) discSx[x_, y_, z_] := -5915 + 6942 x + 11211 x^2 + 3036 x^3 + 6500 x^4 + 1878 x^5 + 910 x^6 - 16 x^7 + 793 y + 3356 x y + 12108 x^2 y + 14048 x^3 y - 375 x^4 y + 3384 x^5 y + 532 x^6 y + 3749 y^2 + 4626 x y^2 + 9135 x^2 y^2 + 788 x^3 y^2 + 2245 x^4 y^2 - 1014 x^5 y^2 - 14 x^6 y^2 - 575 y^3 + 7224 x y^3 + 2112 x^2 y^3 + 1108 x^3 y^3 - 185 x^4 y^3 + 384 x^5 y^3 + 2039 y^4 - 430 x y^4 + 297 x^2 y^4 + 80 x^3 y^4 + 135 x^4 y^4 - 221 y^5 + 620 x y^5 + 276 x^2 y^5 + 12 x^3 y^5 + 127 y^6 + 62 x y^6 - 3 x^2 y^6 + 3 y^7 - 10231 z + 9922 x z - 8556 x^2 z + 736 x^3 z + 2465 x^4 z + 70 x^6 z + 3477 y z + 4160 x y z + 22356 x^2 y z - 60 x^3 y z + 1885 x^4 y z + 1440 x^5 y z - 14 x^6 y z + 10265 y^2 z + 11986 x y^2 z + 8436 x^2 y^2 z + 11092 x^3 y^2 z + 1155 x^4 y^2 z + 456 x^5 y^2 z - 427 y^3 z + 6960 x y^3 z + 2988 x^2 y^3 z - 1796 x^3 y^3 z + 655 x^4 y^3 z + 3059 y^4 z + 2086 x y^4 z + 984 x^2 y^4 z + 524 x^3 y^4 z + 151 y^5 z + 592 x y^5 z + 96 x^2 y^5 z + 107 y^6 z + 6 x y^6 z - y^7 z + 4961 z^2 + 5516 x z^2 + 3372 x^2 z^2 + 5836 x^3 z^2 + 1300 x^4 z^2 - 144 x^5 z^2 + 2080 y z^2 + 13224 x y z^2 + 1038 x^2 y z^2 + 3200 x^3 y z^2 + 1320 x^4 y z^2 + 48 x^5 y z^2 + 5993 y^2 z^2 - 4628 x y^2 z^2 + 6366 x^2 y^2 z^2 + 308 x^3 y^2 z^2 + 920 x^4 y^2 z^2 + 3480 y^3 z^2 + 9612 x y^3 z^2 + 1074 x^2 y^3 z^2 + 1264 x^3 y^3 z^2 + 1043 y^4 z^2 + 584 x y^4 z^2 + 630 x^2 y^4 z^2 + 296 y^5 z^2 + 140 x y^5 z^2 + 3 y^6 z^2 - 2852 z^3 + 2248 x z^3 + 3114 x^2 z^3 + 488 x^3 z^3 + 190 x^4 z^3 + 7452 y z^3 + 692 x y z^3 + 2802 x^2 y z^3 + 1776 x^3 y z^3 - 70 x^4 y z^3 + 2812 y^2 z^3 + 4244 x y^2 z^3 + 126 x^2 y^2 z^3 + 1016 x^3 y^2 z^3 + 996 y^3 z^3 + 716 x y^3 z^3 + 1350 x^2 y^3 z^3 + 328 y^4 z^3 + 420 x y^4 z^3 + 32 y^5 z^3 + 184 z^4 + 2918 x z^4 + 366 x^2 z^4 - 176 x^3 z^4 - 15 y z^4 + 1600 x y z^4 + 1332 x^2 y z^4 + 64 x^3 y z^4 + 2773 y^2 z^4 + 154 x y^2 z^4 + 762 x^2 y^2 z^4 - 449 y^3 z^4 + 632 x y^3 z^4 + 131 y^4 z^4 + 493 z^5 + 520 x z^5 + 114 x^2 z^5 + 377 y z^5 + 528 x y z^5 - 42 x^2 y z^5 + 231 y^2 z^5 + 368 x y^2 z^5 + 131 y^3 z^5 - 48 x z^6 + 240 y z^6 + 16 x y z^6 + 76 y^2 z^6 + 10 z^7 - 2 y z^7 (* discSy[x_,y_,z_] := D[discS[1,x,y,z],y] *) discSy[x_, y_, z_] := -5915 + 793 x + 1678 x^2 + 4036 x^3 + 3512 x^4 - 75 x^5 + 564 x^6 + 76 x^7 - 4082 y + 7498 x y + 4626 x^2 y + 6090 x^3 y + 394 x^4 y + 898 x^5 y - 338 x^6 y - 4 x^7 y + 14847 y^2 - 1725 x y^2 + 10836 x^2 y^2 + 2112 x^3 y^2 + 831 x^4 y^2 - 111 x^5 y^2 + 192 x^6 y^2 - 8756 y^3 + 8156 x y^3 - 860 x^2 y^3 + 396 x^3 y^3 + 80 x^4 y^3 + 108 x^5 y^3 + 4675 y^4 - 1105 x y^4 + 1550 x^2 y^4 + 460 x^3 y^4 + 15 x^4 y^4 - 978 y^5 + 762 x y^5 + 186 x^2 y^5 - 6 x^3 y^5 + 217 y^6 + 21 x y^6 - 8 y^7 + 793 z + 3477 x z + 2080 x^2 z + 7452 x^3 z - 15 x^4 z + 377 x^5 z + 240 x^6 z - 2 x^7 z + 7498 y z + 20530 x y z + 11986 x^2 y z + 5624 x^3 y z + 5546 x^4 y z + 462 x^5 y z + 152 x^6 y z - 1725 y^2 z - 1281 x y^2 z + 10440 x^2 y^2 z + 2988 x^3 y^2 z - 1347 x^4 y^2 z + 393 x^5 y^2 z + 8156 y^3 z + 12236 x y^3 z + 4172 x^2 y^3 z + 1312 x^3 y^3 z + 524 x^4 y^3 z - 1105 y^4 z + 755 x y^4 z + 1480 x^2 y^4 z + 160 x^3 y^4 z + 762 y^5 z + 642 x y^5 z + 18 x^2 y^5 z + 21 y^6 z - 7 x y^6 z + 1678 z^2 + 2080 x z^2 + 6612 x^2 z^2 + 346 x^3 z^2 + 800 x^4 z^2 + 264 x^5 z^2 + 8 x^6 z^2 + 4626 y z^2 + 11986 x y z^2 - 4628 x^2 y z^2 + 4244 x^3 y z^2 + 154 x^4 y z^2 + 368 x^5 y z^2 + 10836 y^2 z^2 + 10440 x y^2 z^2 + 14418 x^2 y^2 z^2 + 1074 x^3 y^2 z^2 + 948 x^4 y^2 z^2 - 860 y^3 z^2 + 4172 x y^3 z^2 + 1168 x^2 y^3 z^2 + 840 x^3 y^3 z^2 + 1550 y^4 z^2 + 1480 x y^4 z^2 + 350 x^2 y^4 z^2 + 186 y^5 z^2 + 18 x y^5 z^2 + 4036 z^3 + 7452 x z^3 + 346 x^2 z^3 + 934 x^3 z^3 + 444 x^4 z^3 - 14 x^5 z^3 + 6090 y z^3 + 5624 x y z^3 + 4244 x^2 y z^3 + 84 x^3 y z^3 + 508 x^4 y z^3 + 2112 y^2 z^3 + 2988 x y^2 z^3 + 1074 x^2 y^2 z^3 + 1350 x^3 y^2 z^3 + 396 y^3 z^3 + 1312 x y^3 z^3 + 840 x^2 y^3 z^3 + 460 y^4 z^3 + 160 x y^4 z^3 - 6 y^5 z^3 + 3512 z^4 - 15 x z^4 + 800 x^2 z^4 + 444 x^3 z^4 + 16 x^4 z^4 + 394 y z^4 + 5546 x y z^4 + 154 x^2 y z^4 + 508 x^3 y z^4 + 831 y^2 z^4 - 1347 x y^2 z^4 + 948 x^2 y^2 z^4 + 80 y^3 z^4 + 524 x y^3 z^4 + 15 y^4 z^4 - 75 z^5 + 377 x z^5 + 264 x^2 z^5 - 14 x^3 z^5 + 898 y z^5 + 462 x y z^5 + 368 x^2 y z^5 - 111 y^2 z^5 + 393 x y^2 z^5 + 108 y^3 z^5 + 564 z^6 + 240 x z^6 + 8 x^2 z^6 - 338 y z^6 + 152 x y z^6 + 192 y^2 z^6 + 76 z^7 - 2 x z^7 - 4 y z^7 (* discSz[x_,y_,z_] := D[discS[1,x,y,z],z] *) discSz[x_, y_, z_] := -5915 - 10231 x + 4961 x^2 - 2852 x^3 + 184 x^4 + 493 x^5 + 10 x^7 + 793 y + 3477 x y + 2080 x^2 y + 7452 x^3 y - 15 x^4 y + 377 x^5 y + 240 x^6 y - 2 x^7 y + 3749 y^2 + 10265 x y^2 + 5993 x^2 y^2 + 2812 x^3 y^2 + 2773 x^4 y^2 + 231 x^5 y^2 + 76 x^6 y^2 - 575 y^3 - 427 x y^3 + 3480 x^2 y^3 + 996 x^3 y^3 - 449 x^4 y^3 + 131 x^5 y^3 + 2039 y^4 + 3059 x y^4 + 1043 x^2 y^4 + 328 x^3 y^4 + 131 x^4 y^4 - 221 y^5 + 151 x y^5 + 296 x^2 y^5 + 32 x^3 y^5 + 127 y^6 + 107 x y^6 + 3 x^2 y^6 + 3 y^7 - x y^7 + 6942 z + 9922 x z + 5516 x^2 z + 2248 x^3 z + 2918 x^4 z + 520 x^5 z - 48 x^6 z + 3356 y z + 4160 x y z + 13224 x^2 y z + 692 x^3 y z + 1600 x^4 y z + 528 x^5 y z + 16 x^6 y z + 4626 y^2 z + 11986 x y^2 z - 4628 x^2 y^2 z + 4244 x^3 y^2 z + 154 x^4 y^2 z + 368 x^5 y^2 z + 7224 y^3 z + 6960 x y^3 z + 9612 x^2 y^3 z + 716 x^3 y^3 z + 632 x^4 y^3 z - 430 y^4 z + 2086 x y^4 z + 584 x^2 y^4 z + 420 x^3 y^4 z + 620 y^5 z + 592 x y^5 z + 140 x^2 y^5 z + 62 y^6 z + 6 x y^6 z + 11211 z^2 - 8556 x z^2 + 3372 x^2 z^2 + 3114 x^3 z^2 + 366 x^4 z^2 + 114 x^5 z^2 + 12108 y z^2 + 22356 x y z^2 + 1038 x^2 y z^2 + 2802 x^3 y z^2 + 1332 x^4 y z^2 - 42 x^5 y z^2 + 9135 y^2 z^2 + 8436 x y^2 z^2 + 6366 x^2 y^2 z^2 + 126 x^3 y^2 z^2 + 762 x^4 y^2 z^2 + 2112 y^3 z^2 + 2988 x y^3 z^2 + 1074 x^2 y^3 z^2 + 1350 x^3 y^3 z^2 + 297 y^4 z^2 + 984 x y^4 z^2 + 630 x^2 y^4 z^2 + 276 y^5 z^2 + 96 x y^5 z^2 - 3 y^6 z^2 + 3036 z^3 + 736 x z^3 + 5836 x^2 z^3 + 488 x^3 z^3 - 176 x^4 z^3 + 14048 y z^3 - 60 x y z^3 + 3200 x^2 y z^3 + 1776 x^3 y z^3 + 64 x^4 y z^3 + 788 y^2 z^3 + 11092 x y^2 z^3 + 308 x^2 y^2 z^3 + 1016 x^3 y^2 z^3 + 1108 y^3 z^3 - 1796 x y^3 z^3 + 1264 x^2 y^3 z^3 + 80 y^4 z^3 + 524 x y^4 z^3 + 12 y^5 z^3 + 6500 z^4 + 2465 x z^4 + 1300 x^2 z^4 + 190 x^3 z^4 - 375 y z^4 + 1885 x y z^4 + 1320 x^2 y z^4 - 70 x^3 y z^4 + 2245 y^2 z^4 + 1155 x y^2 z^4 + 920 x^2 y^2 z^4 - 185 y^3 z^4 + 655 x y^3 z^4 + 135 y^4 z^4 + 1878 z^5 - 144 x^2 z^5 + 3384 y z^5 + 1440 x y z^5 + 48 x^2 y z^5 - 1014 y^2 z^5 + 456 x y^2 z^5 + 384 y^3 z^5 + 910 z^6 + 70 x z^6 + 532 y z^6 - 14 x y z^6 - 14 y^2 z^6 - 16 z^7 (* Factor[GLx[w] + GLz[w]] GLxz[w_] := (1 - 2 w - 2 w^3 + w^4)/w^2 = GLx[w]+GLz[w] *) Factor[discSx[GLx[w], GLy[w], GLz[w]]] (* = -(((w-1)^6 (w+1)^3 (w^2+1)^6 (1 - 8 w - 6 w^2 + w^4)^3 ((w-1)^2+(w^2+1)^2))/w^(14)) *) Factor[discSy[GLx[w], GLy[w], GLz[w]]] (* = 0 *) Factor[discSx[GLx[w], GLy[w], GLz[w]]] (* = -(((w-1)^6 (w+1)^3 (w^2+1)^6 (1 - 8 w - 6 w^2 + w^4)^3 ((w-1)^2+(w^2+1)^2))/w^(15)) *) Factor[g0[x,0]] (* = 0 *) Factor[discC[g0[0,x], g1[0,x], g3[0,x]]] Solve[t^3+t^2+3t-1==0] //N delta := 0.29559774252208 Factor[g2[0,t]] (*----------------------------- Lemma 4.9 -----------------------------------*) (* $G_x(w)$, $G_y(w)$, $G_z(w)$. GSx[w_] := (1-2w^3)/w^2 GSy[w_] := ((w^2+1)^2 - w)/w GSz[w_] := (w^3-2)/w Factor[GSz[w] - GSx[1/w]] (* = 0 *) (*----------------------------- Lemma 4.10 ----------------------------------*) eta[x_,y_] := 61 + 62 x + 56 y + 32 x^2 + 30 x y - 6 y^2 + 9 x^3 + 4 x^2 y - 6 x y^2 - 16 y^3 + x^4 - 4 x^2 y^2 - 6 x y^3 + y^4 - x^3 y^2 (* (1) *) Factor[eta[GSx[w]+GSz[w], GSy[w]]] (* = 0 *) (* $f_{38}(w)$ *) f38[w_] := (4096 - 53248 w + 481280 w^2 - 854016 w^3 + 13978880 w^4 - 41097344 w^5 + 65036288 w^6 - 202451552 w^7 + 540672592 w^8 - 804267808 w^9 + 1100150149 w^10 - 2254891644 w^11 + 3084561810 w^12 - 2541095484 w^13 + 3389806119 w^14 - 1035461672 w^15 + 2831200612 w^16 - 1867248840 w^17 + 361863981 w^18 - 1120155156 w^19 + 1095627342 w^20 + 608693644 w^21 + 41547111 w^22 - 82695504 w^23 - 417819512 w^24 - 24117328 w^25 - 32466329 w^26 + 27829532 w^27 + 21823118 w^28 + 547996 w^29 + 7975021 w^30 + 92760 w^31 + 912260 w^32 + 113848 w^33 - 57625 w^34 + 64756 w^35 - 12078 w^36 + 2068 w^37 + 517 w^38) Factor[fScusp[GSx[w], GSy[w]] - (1/w^(22))(w-1)^4(w^2+1)^4(w^4-6w^2-8w+1)^2 f38[w]] Solve[f38[w]==0] //N w1 := -8.590880070252275 w2 := -2.4445756284167754 Solve[w^4-6w^2-8w+1==0] //N tau1 := 0.11508799467984865 tau2 := 2.934317165179855 g2[0,tau1]/g0[0,tau1] R1 := 7.920703957438771 g2[0,tau2]/g0[0,tau2] R2 := 30.474537321438845 Eliminate[{R g0[0,w] == g2[0,w], w^4-6w^2-8w+1==0},w] Solve[R^4-28R^3-90R^2-92R+16353==0] //N (* R1, R2 are roots of $R^4-28R^3-90R^2-92R+16353=0$. *) Factor[Solve[{kappa1(GSx[a]+GSz[a])+kappa2 GSy[a]==1, kappa1 (GSx[b]+GSz[b])+kappa2 GSy[b]==1}, {kappa1, kappa2}]] (* kappa1, kappa2 are the following kappa1sol[], kappa2sol[] *) kappa1sol[a_,b_] := (a b (-1 + 2 a b + a^3 b + a^2 b^2 + a b^3))/( 1 - a + 2 a^2 + a^4 - b + 4 a b - 2 a^2 b - 2 a^4 b + 2 b^2 - 2 a b^2 - 2 a^2 b^2 - a^3 b^2 - a^2 b^3 - 2 a^3 b^3 - 2 a^4 b^3 + b^4 - 2 a b^4 - 2 a^3 b^4 + a^4 b^4) kappa2sol[a_,b_] := -((-1 + a b) (a + b - 2 a b + a^2 b + a b^2))/( 1 - a + 2 a^2 + a^4 - b + 4 a b - 2 a^2 b - 2 a^4 b + 2 b^2 - 2 a b^2 - 2 a^2 b^2 - a^3 b^2 - a^2 b^3 - 2 a^3 b^3 - 2 a^4 b^3 + b^4 - 2 a b^4 - 2 a^3 b^4 + a^4 b^4) (* In the above, a=tau1, b=tau2 *) Eliminate[{kappa1==kappa1sol[a,b], s==a+b, t==a b},{a,b}] (* Result of this elimination *) Solve[kappa1 s^4 - 2 kappa1 s^3 t + s^2 (2 kappa1 - 4 kappa1 t - t^2) + kappa1 s (-1 - 2 t + 5 t^2 - 2 t^3) == -kappa1 - t + 2 t^2 - t^3 + 2 kappa1 t^3 - kappa1 t^4, kappa1] c1[s_, t_] := (s^2t^2-t^3+2t^2-t)/(s^4-2s^3t-2s t^3+t^4-4s^2t+5s t^2-2t^3+2s^2-2s t-s+1) Eliminate[{kappa2==kappa2sol[a,b], s==a+b, t==a b},{a,b}] Solve[kappa2 s^4 + kappa2 s^2 (2 - 4 t) - 2 kappa2 s^3 t + s (-1 - kappa2 - 2 kappa2 t + t^2 + 5 kappa2 t^2 - 2 kappa2 t^3) == -kappa2 - 2 t + 2 t^2 + 2 kappa2 t^3 - kappa2 t^4, kappa2] c2[s_, t_] := (-s t^2+2t^2+s-2t)/(s^4-2s^3t-2s t^3+t^4-4s^2t+5s t^2-2t^3+2s^2-2s t-s+1) sf[t_] := (-t^4-6t^3+70t+1)/8 Ft[t_] := t^6+6t^5-t^4-76t^3-t^2+6t+1 Solve[Ft[t]== 0] // N Eliminate[{s+s2==0, t t2==1, t+t2+s s2==-6, t s2+s t2==8}, {s2, t2}] (* This elimination result is Ft[t]=0 and s=sf[t]. Factor[c1[sf[t], t]] c1[t_] := (64 t (-64 + 129 t + 76 t^2 + 4900 t^3 - 12 t^4 - 842 t^5 - 140 t^6 + 36 t^7 + 12 t^8 + t^9))/(3713 - 18936 t + 548280 t^2 + 53896 t^3 + 18351612 t^4 - 129976 t^5 - 6828632 t^6 - 1114872 t^7 + 944006 t^8 + 312152 t^9 - 31416 t^10 - 28584 t^11 - 3460 t^12 + 600 t^13 + 216 t^14 + 24 t^15 + t^16) Factor[c2[sf[t], t]] c2[t_] := (512 (-1 + t) (-1 - 55 t - 70 t^2 + 6 t^3 + 7 t^4 + t^5))/(3713 - 18936 t + 548280 t^2 + 53896 t^3 + 18351612 t^4 - 129976 t^5 - 6828632 t^6 - 1114872 t^7 + 944006 t^8 + 312152 t^9 - 31416 t^10 - 28584 t^11 - 3460 t^12 + 600 t^13 + 216 t^14 + 24 t^15 + t^16) Eliminate[{x == c1[t], Ft[t] == 0}, t] (* Then we obtain fc1[x]=0 *) fc1[x_] := 817808203 x^6 - 546807084 x^5 + 129155640 x^4 - 13342016 x^3 + 556080 x^2 - 10176 x + 64 Eliminate[{x == c2[t], Ft[t] == 0}, t] (* Then we obtain fc2[x]=0 *) fc2[x_] := 43042537 x^6 - 4514514 x^5 - 188769 x^4 - 38684 x^3 + 4119 x^2 - 114 x + 1 546807084 x^5 + 817808203 x^6 Solve[fc1[x]==0] //N Solve[fc2[x]==0] //N (*------------------------- Proposition 4.12 --------------------------------*) (* $d_e^C(s,t) *) deC[s_,t_] := -(1 + 2 s - 3 s^2 - 8 s^3 + 2 s^4 + 12 s^5 + 2 s^6 - 8 s^7 - 3 s^8 + 2 s^9 + s^10 - 8 t - 8 s t + 32 s^2 t + 32 s^3 t - 48 s^4 t - 48 s^5 t + 32 s^6 t + 32 s^7 t - 8 s^8 t - 8 s^9 t - 6 t^2 - 76 s t^2 - 112 s^2 t^2 + 76 s^3 t^2 + 236 s^4 t^2 + 76 s^5 t^2 - 112 s^6 t^2 - 76 s^7 t^2 - 6 s^8 t^2 + 2 t^3 + 22 s t^3 - 78 s^2 t^3 + 54 s^3 t^3 + 54 s^4 t^3 - 78 s^5 t^3 + 22 s^6 t^3 + 2 s^7 t^3 - 15 t^4 - 70 s t^4 - 401 s^2 t^4 - 756 s^3 t^4 - 401 s^4 t^4 - 70 s^5 t^4 - 15 s^6 t^4 - 12 t^5 + 36 s t^5 - 24 s^2 t^5 - 24 s^3 t^5 + 36 s^4 t^5 - 12 s^5 t^5 + t^6 + 96 s t^6 + 238 s^2 t^6 + 96 s^3 t^6 + s^4 t^6 - 6 t^7 + 6 s t^7 + 6 s^2 t^7 - 6 s^3 t^7 - 6 t^8 - 24 s t^8 - 6 s^2 t^8 + t^10) g0h[u_,v_,w_] := (-v(u w v^2 - (u+w)(u^2+w^2)v + u w(u-w)^2)) g1h[u_,v_,w_] := (u v^4 - w(u+2w)v^3 -2u w(u-w)v^2 - u(2u^3+u^2 w-3w^3)v + w(u^2-w^2)^2) g2h[u_,v_,w_] := (v(v^4+(2u^2-3u w+2w^2)v^2 - (u+w)(u^2+w^2)v + (u-w)^2(u^2-u w+w^2))) g3h[u_,v_,w_] := g1h[w,v,u] FrakEh[a_,b_,c_,d_,u_,v_,w_] := g0h[u,v,w] s0[a,b,c,d] + g1h[u,v,w] s1[a,b,c,d] + g2h[u,v,w] s2[a,b,c,d] + g3h[u,v,w] s3[a,b,c,d] g0[s_,t_] := g0h[s,t,1] g1[s_,t_] := g1h[s,t,1] g2[s_,t_] := g2h[s,t,1] g3[s_,t_] := g3h[s,t,1] g[s_,t_] := {g0[s,t], g1[s,t], g2[s,t], g3[s,t]} FrakE[a_,b_,c_,d_,s_,t_] := FrakEh[a,b,c,d,s,t,1] Factor[discC[g0[s,t], g1[s,t], g3[s,t]] - s^2 (t-s-1)^2 ((s-1)^2+t^2)^2 deC[s,t]] Factor[deC[0,t] - (-(t+1)^2 (t^2-t+1)^2 (t^4-6t^2-8t+1))] Solve[t^4-6t^2-8t+1==0] //N tau1 := 0.11508799467984865 tau2 := 2.934317165179855 Factor[deC[s,0] - (-(s-1)^4 (s+1)^6)] Factor[FrakE[a,b,c,d,1,0]] (* = 0 *) (*------------------------ Proposition 4.12(1) ------------------------------*) f[a0_,a1_,a2_,a3_,t_] := s1[a0,a1,a2,a3]+s3[a0,a1,a2,a3]+t s2[a0,a1,a2,a3] Solve[discS[0,1,y,1]==0] // N (* y=0, 16 *) w1[u_] := u+1/u v1[u_,t_] := (u/(2(u+1)))(t+2-w1[u]) r1[u_,t_] := -w1[u]^2+2(3t+2)w1[u]-(t-2)^2 Factor[f[0,u,v,1,t] - ((u+1)(v-v1[u,t])^2 + u^2 r1[u,t]/(4(u+1)))] Factor[f[0,1,v1[1,t],1,t] - r1[1,t]/8] Factor[r1[1,t] - t(16-t)] (*------------------------ Proposition 4.12(2) ------------------------------*) Solve[t^4-3t^3-27t^2-64t+2 == 0] //N xi1 := 0.030847203111101784` xi2 := 7.631998798270698` f[a0_,a1_,a2_,a3_,t_] := s1[a0,a1,a2,a3]+t s2[a0,a1,a2,a3] v2[u_,t_] := u(t+1-u)/2 r2[u_,t_] := -u^3+(2t+2)u^2-(t-1)^2u+4t Factor[f[0,u,v,1,t] - ((v-v2[u,t])^2 + (u/4)r2[u,t])] Factor[f[0,u,0,1,t] - t u(u+1)] Uplus[t_] := (2(t+1) + Sqrt[t^4+14t+1])/3 Uminus[t_] := (2(t+1) - Sqrt[t^4+14t+1])/3 Plot[{Uplus[t], Uminus[t], t+1},{t,0,8}] (* Discriminant of a x^3 + b x^2 + c x + d = 0 *) Disc3[a_,b_,c_,d_] := b^2c^2-4a c^3-4b^3d-27a^2d^2+18a b c d Factor[discC[p0,p1,p3] + Disc3[p0,p1,p3,p0]] Factor[Disc3[-1,2t+2,-(t-1)^2,4] - (-16t(t^4-3t^3-27t^2-64t+2))] Factor[discS[0, 1, t, 0] - (-t^2(t^4-3t^3-27t^2-64t+2))] Factor[discS[0,x,y,z] - discS[0,z,y,x]] (*------------------------ Proposition 4.12(3) ------------------------------*) Solve[mu^4+mu^3-2mu^2-3mu+1 == 0] //N mu1 := 0.28823099624098636 mu4 := 1.458732532276226` Solve[nu^4-7nu^3+13nu^2-20nu+2 == 0] //N nu1 := 0.10702250456543716` nu4 := 5.231938432442872` Solve[nu^4-4nu^3+3nu^2-6nu+2 == 0] //N nu2 := 0.37130810343505805` nu3 := 3.5866331329972363` mu2 := 1/mu4 (* = 0.6855266321095796` *) mu3 := 1/mu1 (* = 3.4694394879165347` *) Eliminate[{r2[u,t]==0, t^4-3t^3-27t^2-64t+2 == 0},t] (* u(u-1)^2 (u^4+u^3-2u^2-3u+1)^2 (u^4-16u^3+48u^2-384u+512) = 0 *) (*------------------------ Proposition 4.12(4) ------------------------------*) Factor[discC[0,x,1-x] - (-x^2(1-x)^2)] (*------------------------------ Fig 4.7 ------------------------------------*) ContourPlot[{discS[0,x,y,1-x]==0, x==0, x==1, y==0}, {x,-1,2}, {y,-5,10}] ContourPlot[{discS[0,x,y,1-x]==0, x==0, x==1, y==0}, {x,-0.1,1.1}, {y,-0.01,0.05}] Factor[discS[0,1/2,y,1/2] - (-(1/4)(y-8) y^2(y+1)^2 (y+2)^2)] Relation1[s_,r_] := ((r^3+1)^2(r^4-6r^2-8r+1) + (r+3)(r^9-5r^8-6r^7-2r^6+6r^5-14r^4-6r^3-2r^2-3r-1) s - 2(r^(10)+12r^8+26r^7-r^6+4r^5-r^4+26r^3+12r^2+1) s^2 + (3r+1)(-r^9-3r^8-2r^7-6r^6-14r^5+6r^4-2r^3-6r^2-5r+1) s^3 + + (r^3+1)^2(r^4-8r^3-6r^2+1)s^4) Relation2[t_,r_] := (2(r-1)^2(r^2+1)^2(r^4+4r^3-6r^2+4r+1) - 2(r-1) (-10 - 14 r - 13 r^2 - 25 r^3 - 17 r^4 + 11 r^5 - 51 r^6 + 9 r^7 - 21 r^8 + 3 r^9) s + (13 + 14 r - 23 r^2 + 28 r^3 - 84 r^5 + 60 r^6 - 4 r^7 - 69 r^8 - 2 r^9 + 3 r^10) s^2 - (7 + 10 r - 14 r^2 + 12 r^4 - 40 r^5 - 14 r^6 + 40 r^7 - 43 r^8 - 26 r^9 + 4 r^10) s^3 + (r^3+1)^2(r^4-8r^3-6r^2+1) s^4) (*---------------------------- Theorem 4.13 ---------------------------------*) g0d[s_,t_] := (-s+2s^2-s^3+t+s t+s^2t+s^3t-s t^2) (* = g0d[s,t]/t *) g2d[s_,t_] := (1-3s+4s^2-3s^3+s^4-t-s t-s^2t-s^3t+2t^2-3s t^2+2s^2t^2+t^4) (* = g2[s,t]/t *) deC[s_,t_] := -(1 + 2 s - 3 s^2 - 8 s^3 + 2 s^4 + 12 s^5 + 2 s^6 - 8 s^7 - 3 s^8 + 2 s^9 + s^10 - 8 t - 8 s t + 32 s^2 t + 32 s^3 t - 48 s^4 t - 48 s^5 t + 32 s^6 t + 32 s^7 t - 8 s^8 t - 8 s^9 t - 6 t^2 - 76 s t^2 - 112 s^2 t^2 + 76 s^3 t^2 + 236 s^4 t^2 + 76 s^5 t^2 - 112 s^6 t^2 - 76 s^7 t^2 - 6 s^8 t^2 + 2 t^3 + 22 s t^3 - 78 s^2 t^3 + 54 s^3 t^3 + 54 s^4 t^3 - 78 s^5 t^3 + 22 s^6 t^3 + 2 s^7 t^3 - 15 t^4 - 70 s t^4 - 401 s^2 t^4 - 756 s^3 t^4 - 401 s^4 t^4 - 70 s^5 t^4 - 15 s^6 t^4 - 12 t^5 + 36 s t^5 - 24 s^2 t^5 - 24 s^3 t^5 + 36 s^4 t^5 - 12 s^5 t^5 + t^6 + 96 s t^6 + 238 s^2 t^6 + 96 s^3 t^6 + s^4 t^6 - 6 t^7 + 6 s t^7 + 6 s^2 t^7 - 6 s^3 t^7 - 6 t^8 - 24 s t^8 - 6 s^2 t^8 + t^10) (* deCh[u_,v_,w_] := Factor[w^(10) deC[u/w, v/w]] *) deCh[u_,v_,w_] := -u^10 + 8 u^9 v + 6 u^8 v^2 - 2 u^7 v^3 + 15 u^6 v^4 + 12 u^5 v^5 - u^4 v^6 + 6 u^3 v^7 + 6 u^2 v^8 - v^10 - 2 u^9 w + 8 u^8 v w + 76 u^7 v^2 w - 22 u^6 v^3 w + 70 u^5 v^4 w - 36 u^4 v^5 w - 96 u^3 v^6 w - 6 u^2 v^7 w + 24 u v^8 w + 3 u^8 w^2 - 32 u^7 v w^2 + 112 u^6 v^2 w^2 + 78 u^5 v^3 w^2 + 401 u^4 v^4 w^2 + 24 u^3 v^5 w^2 - 238 u^2 v^6 w^2 - 6 u v^7 w^2 + 6 v^8 w^2 + 8 u^7 w^3 - 32 u^6 v w^3 - 76 u^5 v^2 w^3 - 54 u^4 v^3 w^3 + 756 u^3 v^4 w^3 + 24 u^2 v^5 w^3 - 96 u v^6 w^3 + 6 v^7 w^3 - 2 u^6 w^4 + 48 u^5 v w^4 - 236 u^4 v^2 w^4 - 54 u^3 v^3 w^4 + 401 u^2 v^4 w^4 - 36 u v^5 w^4 - v^6 w^4 - 12 u^5 w^5 + 48 u^4 v w^5 - 76 u^3 v^2 w^5 + 78 u^2 v^3 w^5 + 70 u v^4 w^5 + 12 v^5 w^5 - 2 u^4 w^6 - 32 u^3 v w^6 + 112 u^2 v^2 w^6 - 22 u v^3 w^6 + 15 v^4 w^6 + 8 u^3 w^7 - 32 u^2 v w^7 + 76 u v^2 w^7 - 2 v^3 w^7 + 3 u^2 w^8 + 8 u v w^8 + 6 v^2 w^8 - 2 u w^9 + 8 v w^9 - w^10 Factor[discC[g0h[u,v,w],g1h[u,v,w],g3h[u,v,w]] - u^2 w^2 (u+w-v)^2 ((u-w)^2+v^2)^2 deCh[u,v,w]] (* = 0 *) Factor[deCh[w,v,u] - deCh[u,v,w]] (* = 0 *) Factor[deCh[t,1,0] - (-(t^3+1)^2(t^4-8t^3-6t^2+1))] (* = 0 *) tau1 := 0.11508799467984844` tau2 := 2.934317165179858` tau3 := 0.34079478928403617` (* = 1/tau2 *) tau4 := 8.689003599218129`, (* = 1/tau1 *) kappa1 := 0.012907403163057508` kappa2 := 0.03189258447607269` L[s_,t_]:=kappa1(g1[s,t]+g3[s,t])+kappa2 g2[s,t] - g0[s,t] ContourPlot[{deC[s,t]==0,g0d[s,t]==0},{s,0,6},{t,0,6}] ContourPlot[{deC[s,t]==0,g0d[s,t]==0,g1[s,t]==0,g3[s,t]==0,t==s+1,s==1}, {s,0,6}, {t,0,6}] ContourPlot[{deC[s,t]==0,g0d[s,t]==0,eta[s,t]==0,g1[s,t]==0,g3[s,t]==0, t==s+1,s==1,s==0}, {s,-1,6}, {t,-1,6}] ContourPlot[{deC[s,t]==0,g0d[s,t]==0, eta[s,t]==0}, {s,-1,6}, {t,-1,6}] ContourPlot[{deC[s,t]==0,g0d[s,t]==0, L[s,t]==0,s==0,t==0}, {s,-1,6}, {t,-1,6}] (*--------------------- Proof of Proposition 1.11 ---------------------------*) f1[a_,b_,c_,d_]:=a^3 f2[a_,b_,c_,d_]:=a^2b f3[a_,b_,c_,d_]:=a^2c f4[a_,b_,c_,d_]:=a^2d f5[a_,b_,c_,d_]:=a b^2 f6[a_,b_,c_,d_]:=a b c f7[a_,b_,c_,d_]:=a b d f8[a_,b_,c_,d_]:=a c^2 f9[a_,b_,c_,d_]:=a c d f10[a_,b_,c_,d_]:=a d^2 f11[a_,b_,c_,d_]:=b^3 f12[a_,b_,c_,d_]:=b^2c f13[a_,b_,c_,d_]:=b^2d f14[a_,b_,c_,d_]:=b c^2 f15[a_,b_,c_,d_]:=b c d f16[a_,b_,c_,d_]:=b d^2 f17[a_,b_,c_,d_]:=c^3 f18[a_,b_,c_,d_]:=c^2d f19[a_,b_,c_,d_]:=c d^2 f20[a_,b_,c_,d_]:=d^3 f[a_,b_,c_,d_]:={f1[a,b,c,d],f2[a,b,c,d],f3[a,b,c,d],f4[a,b,c,d],f5[a,b,c,d],f6[a,b,c,d],f7[a,b,c,d],f8[a,b,c,d],f9[a,b,c,d],f10[a,b,c,d],f11[a,b,c,d],f12[a,b,c,d],f13[a,b,c,d],f14[a,b,c,d],f15[a,b,c,d],f16[a,b,c,d],f17[a,b,c,d],f18[a,b,c,d],f19[a,b,c,d],f20[a,b,c,d]} fa1[a_,b_,c_,d_]:=3a^2 fa2[a_,b_,c_,d_]:=2a b fa3[a_,b_,c_,d_]:=2a c fa4[a_,b_,c_,d_]:=2a d fa5[a_,b_,c_,d_]:=b^2 fa6[a_,b_,c_,d_]:=b c fa7[a_,b_,c_,d_]:=b d fa8[a_,b_,c_,d_]:=c^2 fa9[a_,b_,c_,d_]:=c d fa10[a_,b_,c_,d_]:=d^2 fa11[a_,b_,c_,d_]:=0 fa12[a_,b_,c_,d_]:=0 fa13[a_,b_,c_,d_]:=0 fa14[a_,b_,c_,d_]:=0 fa15[a_,b_,c_,d_]:=0 fa16[a_,b_,c_,d_]:=0 fa17[a_,b_,c_,d_]:=0 fa18[a_,b_,c_,d_]:=0 fa19[a_,b_,c_,d_]:=0 fa20[a_,b_,c_,d_]:=0 fa[a_,b_,c_,d_]:={fa1[a,b,c,d],fa2[a,b,c,d],fa3[a,b,c,d],fa4[a,b,c,d],fa5[a,b,c,d],fa6[a,b,c,d],fa7[a,b,c,d],fa8[a,b,c,d],fa9[a,b,c,d],fa10[a,b,c,d],fa11[a,b,c,d],fa12[a,b,c,d],fa13[a,b,c,d],fa14[a,b,c,d],fa15[a,b,c,d],fa16[a,b,c,d],fa17[a,b,c,d],fa18[a,b,c,d],fa19[a,b,c,d],fa20[a,b,c,d]} fb1[a_,b_,c_,d_]:=0 fb2[a_,b_,c_,d_]:=a^2 fb3[a_,b_,c_,d_]:=0 fb4[a_,b_,c_,d_]:=0 fb5[a_,b_,c_,d_]:=2a b fb6[a_,b_,c_,d_]:=a c fb7[a_,b_,c_,d_]:=a d fb8[a_,b_,c_,d_]:=0 fb9[a_,b_,c_,d_]:=0 fb10[a_,b_,c_,d_]:=0 fb11[a_,b_,c_,d_]:=3b^2 fb12[a_,b_,c_,d_]:=2b c fb13[a_,b_,c_,d_]:=2b d fb14[a_,b_,c_,d_]:=c^2 fb15[a_,b_,c_,d_]:=c d fb16[a_,b_,c_,d_]:=d^2 fb17[a_,b_,c_,d_]:=0 fb18[a_,b_,c_,d_]:=0 fb19[a_,b_,c_,d_]:=0 fb20[a_,b_,c_,d_]:=0 fb[a_,b_,c_,d_]:={fb1[a,b,c,d],fb2[a,b,c,d],fb3[a,b,c,d],fb4[a,b,c,d],fb5[a,b,c,d],fb6[a,b,c,d],fb7[a,b,c,d],fb8[a,b,c,d],fb9[a,b,c,d],fb10[a,b,c,d],fb11[a,b,c,d],fb12[a,b,c,d],fb13[a,b,c,d],fb14[a,b,c,d],fb15[a,b,c,d],fb16[a,b,c,d],fb17[a,b,c,d],fb18[a,b,c,d],fb19[a,b,c,d],fb20[a,b,c,d]} fc1[a_,b_,c_,d_]:=0 fc2[a_,b_,c_,d_]:=0 fc3[a_,b_,c_,d_]:=a^2 fc4[a_,b_,c_,d_]:=0 fc5[a_,b_,c_,d_]:=0 fc6[a_,b_,c_,d_]:=a b fc7[a_,b_,c_,d_]:=0 fc8[a_,b_,c_,d_]:=2a c fc9[a_,b_,c_,d_]:=a d fc10[a_,b_,c_,d_]:=0 fc11[a_,b_,c_,d_]:=0 fc12[a_,b_,c_,d_]:=b^2 fc13[a_,b_,c_,d_]:=0 fc14[a_,b_,c_,d_]:=2b c fc15[a_,b_,c_,d_]:=b d fc16[a_,b_,c_,d_]:=0 fc17[a_,b_,c_,d_]:=3c^2 fc18[a_,b_,c_,d_]:=2c d fc19[a_,b_,c_,d_]:=d^2 fc20[a_,b_,c_,d_]:=0 fc[a_,b_,c_,d_]:={fc1[a,b,c,d],fc2[a,b,c,d],fc3[a,b,c,d],fc4[a,b,c,d],fc5[a,b,c,d],fc6[a,b,c,d],fc7[a,b,c,d],fc8[a,b,c,d],fc9[a,b,c,d],fc10[a,b,c,d],fc11[a,b,c,d],fc12[a,b,c,d],fc13[a,b,c,d],fc14[a,b,c,d],fc15[a,b,c,d],fc16[a,b,c,d],fc17[a,b,c,d],fc18[a,b,c,d],fc19[a,b,c,d],fc20[a,b,c,d]} fd1[a_,b_,c_,d_]:=0 fd2[a_,b_,c_,d_]:=0 fd3[a_,b_,c_,d_]:=0 fd4[a_,b_,c_,d_]:=a^2 fd5[a_,b_,c_,d_]:=0 fd6[a_,b_,c_,d_]:=0 fd7[a_,b_,c_,d_]:=a b fd8[a_,b_,c_,d_]:=0 fd9[a_,b_,c_,d_]:=a c fd10[a_,b_,c_,d_]:=2a d fd11[a_,b_,c_,d_]:=0 fd12[a_,b_,c_,d_]:=0 fd13[a_,b_,c_,d_]:=b^2 fd14[a_,b_,c_,d_]:=0 fd15[a_,b_,c_,d_]:=b c fd16[a_,b_,c_,d_]:=2b d fd17[a_,b_,c_,d_]:=0 fd18[a_,b_,c_,d_]:=c^2 fd19[a_,b_,c_,d_]:=2c d fd20[a_,b_,c_,d_]:=3d^2 fd[a_,b_,c_,d_]:={fd1[a,b,c,d],fd2[a,b,c,d],fd3[a,b,c,d],fd4[a,b,c,d],fd5[a,b,c,d],fd6[a,b,c,d],fd7[a,b,c,d],fd8[a,b,c,d],fd9[a,b,c,d],fd10[a,b,c,d],fd11[a,b,c,d],fd12[a,b,c,d],fd13[a,b,c,d],fd14[a,b,c,d],fd15[a,b,c,d],fd16[a,b,c,d],fd17[a,b,c,d],fd18[a,b,c,d],fd19[a,b,c,d],fd20[a,b,c,d]} Factor[Det[{f[1,1,1,1],f[-1,1,1,1],f[1,-1,1,1],f[1,1,-1,1],f[1,1,1,-1], f[1,1,-1,-1],f[1,-1,1,-1],f[1,-1,-1,1], f[0,s,t,1],f[1,0,s,t],f[t,1,0,s],f[s,t,1,0], f[0,s,t,-1],f[-1,0,s,t],f[t,-1,0,s],f[s,t,-1,0], f[0,s,-t,1],f[1,0,s,-t],f[-t,1,0,s],f[s,-t,1,0]}]] (* = 1048576 s^4 t^4 (1 + s^2 - t^2)^4 ((s^2-1)^2+t^4)^4 Factor[Det[{f[1,1,1,-1], f[1,1,-1,-1], f[1,-1,1,-1], f[1,-1,-1,1], f[0,s,t,1],f[1,0,s,t],f[t,1,0,s],f[s,t,1,0], f[0,s,t,-1],f[-1,0,s,t],f[t,-1,0,s],f[s,t,-1,0], f[0,s,-t,1],f[1,0,s,-t],f[-t,1,0,s],f[s,-t,1,0], f[0,-s,t,1],f[1,0,-s,t],f[t,1,0,-s],f[-s,t,1,0]}]] (* = -524288 s^8 t^8 (1 + s^2 - t^2)^4 ((s^2-1)^2 + t^4)^4 *) (*==================== Section 4.2 ==========================================*) (*============ The PSD Cone {\Cal P}_{4,3}^{c+}$ ===========================*) S3[a0_, a1_, a2_, a3_] := a0^3 + a1^3 + a2^3 + a3^3 S210[a0_, a1_, a2_, a3_] := a0^2 a1 + a1^2 a2 + a2^2 a3 + a3^2 a0 S201[a0_, a1_, a2_, a3_] := a0^2 a2 + a1^2 a3 + a2^2 a0 + a3^2 a1 S120[a0_, a1_, a2_, a3_] := a0^2 a3 + a1^2 a0 + a2^2 a1 + a3^2 a2 S111[a0_, a1_, a2_, a3_] := a0 a1 a2 + a0 a1 a3 + a0 a2 a3 + a1 a2 a3 s0[a0_, a1_, a2_, a3_] := S3[a0,a1,a2,a3] - S111[a0,a1,a2,a3] s1[a0_, a1_, a2_, a3_] := S210[a0,a1,a2,a3] - S111[a0,a1,a2,a3] s2[a0_, a1_, a2_, a3_] := S201[a0,a1,a2,a3] - S111[a0,a1,a2,a3] s3[a0_, a1_, a2_, a3_] := S120[a0,a1,a2,a3] - S111[a0,a1,a2,a3] s4[a0_, a1_, a2_, a3_] := S111[a0,a1,a2,a3] f43c[x0_,x1_,x2_,x3_,x4_] := x1^3 - x0 x1 x3 + x3^3 + x1^2 x2 + x1 x2^2 + x2^2 x3 + x2 x3^2 - x0 x1 x2 - x0 x2 x3 - x1 x2 x3 + x4(x0^2 + 5 x1^2 + x2^2 + 5 x3^2 - 2 x0 x1 - 2 x0 x2 - 2 x0 x3 + 2 x1 x2 - 6 x1 x3 + 2 x2 x3 ) Factor[f43c[s0[a,b,c,d], s1[a,b,c,d], s2[a,b,c,d], s3[a,b,c,d], s4[a,b,c,d]]] (* =0 *) f43c0[s0_, s1_, s2_, s3_] := (s1^3 - s0 s1 s3 + s3^3)^2 - s2 (s1^3 - s0 s1 s3 + s3^3) (s0^2 + 3 s1^2 - 4 s1 s3 + 3 s3^2) + s2^2 (s0^2 (s1^2 - s1 s3 + s3^2) + 2 s0 s1 s3 (s1 + s3) + s1^4 - 7 s1^3 s3 + 9 s1^2 s3^2 - 7 s1 s3^3 + s3^4) + s2^3 (2 s0 s1^2 - s0 (4 s1^2 + s1 s3 + 2 s3^2) + (s1 + s3) (s1^2 - 3 s1 s3 + s3^2)) + s2^4 (s1^2 + s1 s3 + s3^2) (*============================ End of file ==================================*) (* Provided by Tetsuya ANDO, Chiba University. *)