(* Check file for ''Theory of PSD Cones'' for Mathematica *) (*============================== Section 0 =================================*) (* Theorem 0.2 *) sigma1[a0_,a1_,a2_,a3_] := a0+a1+a2+a3 sigma2[a0_,a1_,a2_,a3_] := a0 a1 + a0 a2 + a0 a3 + a1 a2 + a1 a3 + a2 a3 sigma3[a0_,a1_,a2_,a3_] := a1 a2 a3 + a0 a2 a3 + a0 a1 a3 + a0 a1 a2 sigma4[a0_,a1_,a2_,a3_] := a0 a1 a2 a3 f[a0_,a1_,a2_,a3_,p1_,p2_,p3_] := sigma1[a0,a1,a2,a3]^4 + p1 sigma1[a0,a1,a2,a3]^2 sigma2[a0,a1,a2,a3] + p2 sigma2[a0,a1,a2,a3]^2 + p3 sigma1[a0,a1,a2,a3] sigma3[a0,a1,a2,a3] - (256 + 96p1 + 36p2 + 16p3) sigma4[a0,a1,a2,a3] 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] 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) 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 U[x0_,x1_,x2_,x3_]:=x0 x1 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] g[a_,b_,c_,d_,p1_,p2_,p3_] := s0[a,b,c,d] + p1 s1[a,b,c,d] + p2 s2[a,b,c,d] + p3 s3[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]] 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[f[a,b,c,d,p,q,r] - g[a,b,c,d, 4+p, 6+2p+q, 12+5p+2q+r]] Expand[g[a,b,c,d,p,q,r] - f[a,b,c,d, -4+p, 2-2p+q, 4-p-2q+r]] (*============================== Section 2 =================================*) (* Discriminants of x^n + a x^{n-1} + ... *) (* Discriminant of x^3 + a x^2 + b x + c = 0 *) D3[a_,b_,c_] := a^2 b^2 - 4 b^3 - 4 a^3 c + 18 a b c - 27 c^2 disc3[a0_,a1_,a2_,a3_] := -a1^2 a2^2 + 4 a0 a2^3 + 4 a1^3 a3 - 18 a0 a1 a2 a3 + 27 a0^2 a3^2 D4[a_,b_,c_,d_] := a^2 b^2 c^2 - 4 b^3 c^2 - 4 a^3 c^3 + 18 a b c^3 - 27 c^4 - 4 a^2 b^3 d + 16 b^4 d + 18 a^3 b c d - 80 a b^2 c d - 6 a^2 c^2 d + 144 b c^2 d - 27 a^4 d^2 + 144 a^2 b d^2 - 128 b^2 d^2 - 192 a c d^2 + 256 d^3 disc4[p0_,p1_,p2_,p3_,p4_] := p1^2 p2^2 p3^2 - 4 p0 p2^3 p3^2 - 4 p1^3 p3^3 + 18 p0 p1 p2 p3^3 - 27 p0^2 p3^4 - 4 p1^2 p2^3 p4 + 16 p0 p2^4 p4 + 18 p1^3 p2 p3 p4 - 80 p0 p1 p2^2 p3 p4 - 6 p0 p1^2 p3^2 p4 + 144 p0^2 p2 p3^2 p4 - 27 p1^4 p4^2 + 144 p0 p1^2 p2 p4^2 - 128 p0^2 p2^2 p4^2 - 192 p0^2 p1 p3 p4^2 + 256 p0^3 p4^3 D5[a_,b_,c_,d_,e_] := a^2 b^2 c^2 d^2 - 4 b^3 c^2 d^2 - 4 a^3 c^3 d^2 + 18 a b c^3 d^2 - 27 c^4 d^2 - 4 a^2 b^3 d^3 + 16 b^4 d^3 + 18 a^3 b c d^3 - 80 a b^2 c d^3 - 6 a^2 c^2 d^3 + 144 b c^2 d^3 - 27 a^4 d^4 + 144 a^2 b d^4 - 128 b^2 d^4 - 192 a c d^4 + 256 d^5 - 4 a^2 b^2 c^3 e + 16 b^3 c^3 e + 16 a^3 c^4 e - 72 a b c^4 e + 108 c^5 e + 18 a^2 b^3 c d e - 72 b^4 c d e - 80 a^3 b c^2 d e + 356 a b^2 c^2 d e + 24 a^2 c^3 d e - 630 b c^3 d e - 6 a^3 b^2 d^2 e + 24 a b^3 d^2 e + 144 a^4 c d^2 e - 746 a^2 b c d^2 e + 560 b^2 c d^2 e + 1020 a c^2 d^2 e - 36 a^3 d^3 e + 160 a b d^3 e - 1600 c d^3 e - 27 a^2 b^4 e^2 + 108 b^5 e^2 + 144 a^3 b^2 c e^2 - 630 a b^3 c e^2 - 128 a^4 c^2 e^2 + 560 a^2 b c^2 e^2 + 825 b^2 c^2 e^2 - 900 a c^3 e^2 - 192 a^4 b d e^2 + 1020 a^2 b^2 d e^2 - 900 b^3 d e^2 + 160 a^3 c d e^2 - 2050 a b c d e^2 + 2250 c^2 d e^2 - 50 a^2 d^2 e^2 + 2000 b d^2 e^2 + 256 a^5 e^3 - 1600 a^3 b e^3 + 2250 a b^2 e^3 + 2000 a^2 c e^3 - 3750 b c e^3 - 2500 a d e^3 + 3125 e^4 disc5[p0_,p1_,p2_,p3_,p4_,p5_] := p1^2 p2^2 p3^2 p4^2 - 4 p0 p2^3 p3^2 p4^2 - 4 p1^3 p3^3 p4^2 + 18 p0 p1 p2 p3^3 p4^2 - 27 p0^2 p3^4 p4^2 - 4 p1^2 p2^3 p4^3 + 16 p0 p2^4 p4^3 + 18 p1^3 p2 p3 p4^3 - 80 p0 p1 p2^2 p3 p4^3 - 6 p0 p1^2 p3^2 p4^3 + 144 p0^2 p2 p3^2 p4^3 - 27 p1^4 p4^4 + 144 p0 p1^2 p2 p4^4 - 128 p0^2 p2^2 p4^4 - 192 p0^2 p1 p3 p4^4 + 256 p0^3 p4^5 - 4 p1^2 p2^2 p3^3 p5 + 16 p0 p2^3 p3^3 p5 + 16 p1^3 p3^4 p5 - 72 p0 p1 p2 p3^4 p5 + 108 p0^2 p3^5 p5 + 18 p1^2 p2^3 p3 p4 p5 - 72 p0 p2^4 p3 p4 p5 - 80 p1^3 p2 p3^2 p4 p5 + 356 p0 p1 p2^2 p3^2 p4 p5 + 24 p0 p1^2 p3^3 p4 p5 - 630 p0^2 p2 p3^3 p4 p5 - 6 p1^3 p2^2 p4^2 p5 + 24 p0 p1 p2^3 p4^2 p5 + 144 p1^4 p3 p4^2 p5 - 746 p0 p1^2 p2 p3 p4^2 p5 + 560 p0^2 p2^2 p3 p4^2 p5 + 1020 p0^2 p1 p3^2 p4^2 p5 - 36 p0 p1^3 p4^3 p5 + 160 p0^2 p1 p2 p4^3 p5 - 1600 p0^3 p3 p4^3 p5 - 27 p1^2 p2^4 p5^2 + 108 p0 p2^5 p5^2 + 144 p1^3 p2^2 p3 p5^2 - 630 p0 p1 p2^3 p3 p5^2 - 128 p1^4 p3^2 p5^2 + 560 p0 p1^2 p2 p3^2 p5^2 + 825 p0^2 p2^2 p3^2 p5^2 - 900 p0^2 p1 p3^3 p5^2 - 192 p1^4 p2 p4 p5^2 + 1020 p0 p1^2 p2^2 p4 p5^2 - 900 p0^2 p2^3 p4 p5^2 + 160 p0 p1^3 p3 p4 p5^2 - 2050 p0^2 p1 p2 p3 p4 p5^2 + 2250 p0^3 p3^2 p4 p5^2 - 50 p0^2 p1^2 p4^2 p5^2 + 2000 p0^3 p2 p4^2 p5^2 + 256 p1^5 p5^3 - 1600 p0 p1^3 p2 p5^3 + 2250 p0^2 p1 p2^2 p5^3 + 2000 p0^2 p1^2 p3 p5^3 - 3750 p0^3 p2 p3 p5^3 - 2500 p0^3 p1 p4 p5^3 + 3125 p0^4 p5^4 D6[a_,b_,c_,d_,e_,f_] := -a^2 b^2 c^2 d^2 e^2 + 4 b^3 c^2 d^2 e^2 + 4 a^3 c^3 d^2 e^2 - 18 a b c^3 d^2 e^2 + 27 c^4 d^2 e^2 + 4 a^2 b^3 d^3 e^2 - 16 b^4 d^3 e^2 - 18 a^3 b c d^3 e^2 + 80 a b^2 c d^3 e^2 + 6 a^2 c^2 d^3 e^2 - 144 b c^2 d^3 e^2 + 27 a^4 d^4 e^2 - 144 a^2 b d^4 e^2 + 128 b^2 d^4 e^2 + 192 a c d^4 e^2 - 256 d^5 e^2 + 4 a^2 b^2 c^3 e^3 - 16 b^3 c^3 e^3 - 16 a^3 c^4 e^3 + 72 a b c^4 e^3 - 108 c^5 e^3 - 18 a^2 b^3 c d e^3 + 72 b^4 c d e^3 + 80 a^3 b c^2 d e^3 - 356 a b^2 c^2 d e^3 - 24 a^2 c^3 d e^3 + 630 b c^3 d e^3 + 6 a^3 b^2 d^2 e^3 - 24 a b^3 d^2 e^3 - 144 a^4 c d^2 e^3 + 746 a^2 b c d^2 e^3 - 560 b^2 c d^2 e^3 - 1020 a c^2 d^2 e^3 + 36 a^3 d^3 e^3 - 160 a b d^3 e^3 + 1600 c d^3 e^3 + 27 a^2 b^4 e^4 - 108 b^5 e^4 - 144 a^3 b^2 c e^4 + 630 a b^3 c e^4 + 128 a^4 c^2 e^4 - 560 a^2 b c^2 e^4 - 825 b^2 c^2 e^4 + 900 a c^3 e^4 + 192 a^4 b d e^4 - 1020 a^2 b^2 d e^4 + 900 b^3 d e^4 - 160 a^3 c d e^4 + 2050 a b c d e^4 - 2250 c^2 d e^4 + 50 a^2 d^2 e^4 - 2000 b d^2 e^4 - 256 a^5 e^5 + 1600 a^3 b e^5 - 2250 a b^2 e^5 - 2000 a^2 c e^5 + 3750 b c e^5 + 2500 a d e^5 - 3125 e^6 + 4 a^2 b^2 c^2 d^3 f - 16 b^3 c^2 d^3 f - 16 a^3 c^3 d^3 f + 72 a b c^3 d^3 f - 108 c^4 d^3 f - 16 a^2 b^3 d^4 f + 64 b^4 d^4 f + 72 a^3 b c d^4 f - 320 a b^2 c d^4 f - 24 a^2 c^2 d^4 f + 576 b c^2 d^4 f - 108 a^4 d^5 f + 576 a^2 b d^5 f - 512 b^2 d^5 f - 768 a c d^5 f + 1024 d^6 f - 18 a^2 b^2 c^3 d e f + 72 b^3 c^3 d e f + 72 a^3 c^4 d e f - 324 a b c^4 d e f + 486 c^5 d e f + 80 a^2 b^3 c d^2 e f - 320 b^4 c d^2 e f - 356 a^3 b c^2 d^2 e f + 1584 a b^2 c^2 d^2 e f + 108 a^2 c^3 d^2 e f - 2808 b c^3 d^2 e f - 24 a^3 b^2 d^3 e f + 96 a b^3 d^3 e f + 630 a^4 c d^3 e f - 3272 a^2 b c d^3 e f + 2496 b^2 c d^3 e f + 4464 a c^2 d^3 e f - 144 a^3 d^4 e f + 640 a b d^4 e f - 6912 c d^4 e f + 6 a^2 b^3 c^2 e^2 f - 24 b^4 c^2 e^2 f - 24 a^3 b c^3 e^2 f + 108 a b^2 c^3 e^2 f - 162 b c^4 e^2 f - 144 a^2 b^4 d e^2 f + 576 b^5 d e^2 f + 746 a^3 b^2 c d e^2 f - 3272 a b^3 c d e^2 f - 560 a^4 c^2 d e^2 f + 2412 a^2 b c^2 d e^2 f + 4536 b^2 c^2 d e^2 f - 3942 a c^3 d e^2 f - 1020 a^4 b d^2 e^2 f + 5428 a^2 b^2 d^2 e^2 f - 4816 b^3 d^2 e^2 f + 682 a^3 c d^2 e^2 f - 10152 a b c d^2 e^2 f + 9720 c^2 d^2 e^2 f - 248 a^2 d^3 e^2 f + 10560 b d^3 e^2 f + 36 a^3 b^3 e^3 f - 144 a b^4 e^3 f - 160 a^4 b c e^3 f + 682 a^2 b^2 c e^3 f + 120 b^3 c e^3 f + 208 a^3 c^2 e^3 f - 1980 a b c^2 e^3 f + 1350 c^3 e^3 f + 1600 a^5 d e^3 f - 9768 a^3 b d e^3 f + 13040 a b^2 d e^3 f + 12330 a^2 c d e^3 f - 19800 b c d e^3 f - 15600 a d^2 e^3 f - 320 a^4 e^4 f + 1700 a^2 b e^4 f - 1500 b^2 e^4 f - 2250 a c e^4 f + 22500 d e^4 f + 27 a^2 b^2 c^4 f^2 - 108 b^3 c^4 f^2 - 108 a^3 c^5 f^2 + 486 a b c^5 f^2 - 729 c^6 f^2 - 144 a^2 b^3 c^2 d f^2 + 576 b^4 c^2 d f^2 + 630 a^3 b c^3 d f^2 - 2808 a b^2 c^3 d f^2 - 162 a^2 c^4 d f^2 + 4860 b c^4 d f^2 + 128 a^2 b^4 d^2 f^2 - 512 b^5 d^2 f^2 - 560 a^3 b^2 c d^2 f^2 + 2496 a b^3 c d^2 f^2 - 825 a^4 c^2 d^2 f^2 + 4536 a^2 b c^2 d^2 f^2 - 8208 b^2 c^2 d^2 f^2 - 5832 a c^3 d^2 f^2 + 900 a^4 b d^3 f^2 - 4816 a^2 b^2 d^3 f^2 + 4352 b^3 d^3 f^2 + 120 a^3 c d^3 f^2 + 5760 a b c d^3 f^2 + 8640 c^2 d^3 f^2 + 192 a^2 d^4 f^2 - 9216 b d^4 f^2 + 192 a^2 b^4 c e f^2 - 768 b^5 c e f^2 - 1020 a^3 b^2 c^2 e f^2 + 4464 a b^3 c^2 e f^2 + 900 a^4 c^3 e f^2 - 3942 a^2 b c^3 e f^2 - 5832 b^2 c^3 e f^2 + 6318 a c^4 e f^2 - 160 a^3 b^3 d e f^2 + 640 a b^4 d e f^2 + 2050 a^4 b c d e f^2 - 10152 a^2 b^2 c d e f^2 + 5760 b^3 c d e f^2 - 1980 a^3 c^2 d e f^2 + 22896 a b c^2 d e f^2 - 21384 c^3 d e f^2 - 2250 a^5 d^2 e f^2 + 13040 a^3 b d^2 e f^2 - 15264 a b^2 d^2 e f^2 - 16632 a^2 c d^2 e f^2 + 3456 b c d^2 e f^2 + 21888 a d^3 e f^2 + 50 a^4 b^2 e^2 f^2 - 248 a^2 b^3 e^2 f^2 + 192 b^4 e^2 f^2 - 2000 a^5 c e^2 f^2 + 12330 a^3 b c e^2 f^2 - 16632 a b^2 c e^2 f^2 - 15417 a^2 c^2 e^2 f^2 + 27540 b c^2 e^2 f^2 + 1700 a^4 d e^2 f^2 - 8748 a^2 b d e^2 f^2 + 6480 b^2 d e^2 f^2 + 31320 a c d e^2 f^2 - 43200 d^2 e^2 f^2 - 410 a^3 e^3 f^2 + 1800 a b e^3 f^2 - 27000 c e^3 f^2 - 256 a^2 b^5 f^3 + 1024 b^6 f^3 + 1600 a^3 b^3 c f^3 - 6912 a b^4 c f^3 - 2250 a^4 b c^2 f^3 + 9720 a^2 b^2 c^2 f^3 + 8640 b^3 c^2 f^3 + 1350 a^3 c^3 f^3 - 21384 a b c^3 f^3 + 8748 c^4 f^3 - 2000 a^4 b^2 d f^3 + 10560 a^2 b^3 d f^3 - 9216 b^4 d f^3 + 3750 a^5 c d f^3 - 19800 a^3 b c d f^3 + 3456 a b^2 c d f^3 + 27540 a^2 c^2 d f^3 - 3888 b c^2 d f^3 - 1500 a^4 d^2 f^3 + 6480 a^2 b d^2 f^3 + 17280 b^2 d^2 f^3 - 46656 a c d^2 f^3 + 13824 d^3 f^3 + 2500 a^5 b e f^3 - 15600 a^3 b^2 e f^3 + 21888 a b^3 e f^3 - 2250 a^4 c e f^3 + 31320 a^2 b c e f^3 - 46656 b^2 c e f^3 - 15552 a c^2 e f^3 + 1800 a^3 d e f^3 - 31968 a b d e f^3 + 77760 c d e f^3 - 540 a^2 e^2 f^3 + 32400 b e^2 f^3 - 3125 a^6 f^4 + 22500 a^4 b f^4 - 43200 a^2 b^2 f^4 + 13824 b^3 f^4 - 27000 a^3 c f^4 + 77760 a b c f^4 - 34992 c^2 f^4 + 32400 a^2 d f^4 - 62208 b d f^4 - 38880 a e f^4 + 46656 f^5 Factor[disc3[p3,p2,p1,p0] - disc3[p0,p1,p2,p3]] (* = 0 *) Factor[disc3[p0,-p1,p2,-p3] - disc3[p0,p1,p2,p3]] (* = 0 *) Factor[disc3[-p0,p1,-p2,p3] - disc3[p0,p1,p2,p3]] (* = 0 *) Factor[disc3[-p0,-p1,-p2,-p3] - disc3[p0,p1,p2,p3]] (* = 0 *) (* Answer 2.4 & Fig. 2.1. *) ContourPlot3D[D3[a,b,c]==0, {a,-10,10},{b,-20,20},{c,-1,50}] ContourPlot[D3[a,b,1]==0, {a,-10,20},{b,-10,20}] Show[ ParametricPlot[{-2t+1/t^2, t^2-2/t},{t,0.01,10}, PlotRange->{{-10,20},{-10,20}}], ParametricPlot[{-2t+1/t^2, t^2-2/t},{t,-10,-0.01}, PlotRange->{{-10,20},{-10,20}}]] (* Remark 2.6 (2). *) Expand[((2a^3-9a b+27c)^2 - 2^2(a^2-3b)^3) - 27 D3[a,b,c]] (* Proposition 2.7. *) Sep1[a_,b_,c_,d_] := (a-c/Sqrt[d])^2 - 16 (b+2Sqrt[d]) Sep2[a_,b_,c_,d_] := (a+c/Sqrt[d])^2 - 16 (b-2Sqrt[d]) Q1[x_,b_,d_] := x^4 + 2 Sqrt[b+2Sqrt[d]]x^3 + b x^2 - 2 Sqrt[b d+2d Sqrt[d]] x + d (* = (x^2 + Sqrt[b + 2Sqrt[d]] x - Sqrt[d])^2 x = (-Sqrt[b+2Sqrt[d]] \pm Sqrt[b+6Sqrt[d])/2 *) Q2[x_,b_,d_] := x^4 - 2 Sqrt[b+2Sqrt[d]]x^3 + b x^2 + 2 Sqrt[b d+2d Sqrt[d]] x + d (* = (x^2 - Sqrt[b + 2Sqrt[d]] x - Sqrt[d])^2 x = (Sqrt[b+2Sqrt[d]] \pm Sqrt[b+6Sqrt[d])/2 *) Q3[x_,b_,d_] := x^4 - 2 Sqrt[b-2Sqrt[d]]x^3 + b x^2 + 2 Sqrt[b d-2d Sqrt[d]] x + d (* = (x^2 - Sqrt[b - 2Sqrt[d]] x + Sqrt[d])^2 x = (Sqrt[b-2Sqrt[d]] \pm Sqrt[b-6Sqrt[d])/2 *) Q4[x_,b_,d_] := x^4 + 2 Sqrt[b-2Sqrt[d]]x^3 + b x^2 + 2 Sqrt[b d-2d Sqrt[d]] x + d (* = (x^2 + Sqrt[b - 2Sqrt[d]] x + Sqrt[d])^2 x = (-Sqrt[b-2Sqrt[d]] \pm Sqrt[b-6Sqrt[d])/2 *) (* Fig. 2.2. *) Sep1p[a_,b_,c_,d_] := a-c/Sqrt[d] - 4 Sqrt[b+2Sqrt[d]] Sep1m[a_,b_,c_,d_] := a-c/Sqrt[d] + 4 Sqrt[b+2Sqrt[d]] ContourPlot[{D4[a,5,c,1]==0,Sep1p[a,5,c,1]==0,Sep1m[a,5,c,1]==0}, {a,-10,10},{c,-10,10}] Show[ ParametricPlot[{(1/t^3-5/t-3t)/2, (t^3-5t-3/t)/2},{t,0.01,10}, PlotRange->{{-10,10},{-10,10}}], ParametricPlot[{(1/t^3-5/t-3t)/2, (t^3-5t-3/t)/2},{t,-10,-0.01}, PlotRange->{{-10,10},{-10,10}}]] (* Fig. 2.3. *) Sep2p[a_,b_,c_,d_] := a+c/Sqrt[d] - 4 Sqrt[b-2Sqrt[d]] Sep2m[a_,b_,c_,d_] := a+c/Sqrt[d] + 4 Sqrt[b-2Sqrt[d]] ContourPlot[{D4[a,15,c,1]==0,Sep1p[a,15,c,1]==0,Sep1m[a,15,c,1]==0, Sep2p[a,15,c,1]==0,Sep2m[a,15,c,1]==0}, {a,-20,20},{c,-20,20}] Show[ ParametricPlot[{(1/t^3-15/t-3t)/2, (t^3-15t-3/t)/2},{t,0.01,10}, PlotRange->{{-20,20},{-20,20}}], ParametricPlot[{(1/t^3-15/t-3t)/2, (t^3-15t-3/t)/2},{t,-10,-0.01}, PlotRange->{{-20,20},{-20,20}}]] (* Fig. 2.4. *) Sep3m[a_,c_,d_] := a Sqrt[d] + c Sep4m[b_,c_,d_] := c + 2 Sqrt[b d + 2 d Sqrt[d]] Sep5m[a_,b_,d_] := a + 2 Sqrt[b + 2 Sqrt[d]] ContourPlot[{D4[a,15,c,1]==0,Sep2m[a,15,c,1]==0,Sep3m[a,c,1]==0, Sep4m[15,c,1]==0,Sep5m[a,15,1]==0}, {a,-20,20},{c,-20,20}] (* Fig. 2.5. *) ContourPlot[{D4[a,5,c,1]==0,Sep3m[a,c,1]==0,Sep4m[5,c,1]==0, Sep5m[a,5,1]==0}, {a,-10,10},{c,-10,10}] (* Fig. 2.6. *) ContourPlot[{D4[a,-5,c,1]==0,Sep3m[a,c,1]==0}, {a,-10,10},{c,-10,10}] (* Fig. 2.7. *) ContourPlot[{D5[a,12,-1,d,1]==0,Sep3m[a,c,1]==0}, {a,-10,10},{d,-10,10}] fa[t_,b_,c_,e_] := (-4t^5-2b t^3-c t^2+e)/(3 t^4) fd[t_,b_,c_,e_] := (t^5-b t^3-2c t^2-4e)/(3t) Show[ ParametricPlot[{fa[t,12,-1,1], fd[t,12,-1,1]}, {t,0.01,10}, PlotRange->{{-11,20},{-15,8}}], ParametricPlot[{fa[t,12,-1,1], fd[t,12,-1,1]}, {t,-10,-0.01}, PlotRange->{{-11,20},{-15,8}}]] S1[b_,c_,d_]:=(-200000 + 5832 b^5 + 180000 b c - 43200 b^2 c^2 + 1728 b^3 c^3 - 256 c^5 + 128 b c^6 - 16200 b^3 d - 10692 b^4 c d - 82000 c^2 d + 37920 b c^3 d - 2016 b^2 c^4 d - 64 c^7 d - 48000 b d^2 + 47520 b^2 c d^2 + 6048 b^3 c^2 d^2 - 7808 c^4 d^2 + 512 b c^5 d^2 + 2457 b^4 d^3 + 41600 c d^3 - 41608 b c^2 d^3 - 320 b^2 c^3 d^3 + 48 c^6 d^3 - 9168 b^2 d^4 - 2988 b^3 c d^4 + 10096 c^3 d^4 - 408 b c^4 d^4 - 5248 d^5 + 13664 b c d^5 + 782 b^2 c^2 d^5 - 12 c^5 d^5 + 344 b^3 d^6 - 4592 c^2 d^6 + 100 b c^3 d^6 - 1408 b d^7 - 208 b^2 c d^7 + c^4 d^7 + 896 c d^8 - 8 b c^2 d^8 + 16 b^2 d^9 - 64 d^10) S2[a_,c_,d_]:=(3125 + 1728 a^5 - 9000 a^2 c - 432 a^4 c^2 + 6400 a c^3 - 1024 c^5 + 7500 a d - 5040 a^3 c d - 4000 c^2 d + 1152 a^2 c^3 d + 5550 a^2 d^2 + 216 a^4 c d^2 - 2560 a c^2 d^2 + 768 c^4 d^2 + 1132 a^3 d^3 + 200 c d^3 - 832 a^2 c^2 d^3 - 27 a^4 d^4 + 368 a c d^4 - 192 c^3 d^4 - 16 d^5 + 200 a^2 c d^5 - 32 a d^6 + 16 c^2 d^6 - 16 a^2 d^7) S3[a_,b_,d_] := -S2[d,b,a] (* = (-3125 + 16 a^5 - 200 a^3 b + 4000 a b^2 - 16 a^6 b^2 + 192 a^4 b^3 - 768 a^2 b^4 + 1024 b^5 - 7500 a d + 32 a^6 d - 368 a^4 b d + 2560 a^2 b^2 d - 6400 b^3 d - 5550 a^2 d^2 + 16 a^7 d^2 + 9000 b d^2 - 200 a^5 b d^2 + 832 a^3 b^2 d^2 - 1152 a b^3 d^2 - 1132 a^3 d^3 + 5040 a b d^3 + 27 a^4 d^4 - 216 a^2 b d^4 + 432 b^2 d^4 - 1728 d^5) *) S4[a_,b_,c_] := -S1[c,b,a] (*============================== Section 3 =================================*) (*============================= Section 3.4 ================================*) (* Definition 3.12. How to obtain f_{pq}(x,y,z)): Solve the system of equation $f(1,1,1)=0$, $f_x(1,1,1)=0$, $f_y(1,1,1)=0$, $f(0,1,q)=0$, $f_z(0,1,q)=0$, $f(1,0,p)=0$, $f_z(1,0,p)=0$, $f(1,0,0)=0$, $f(0,1,0)=0$, where $f(x,y,z) \in {\Cal H}_{3,3}. *) f1[x_,y_,z_]:=x^3 f2[x_,y_,z_]:=x^2y f3[x_,y_,z_]:=x^2z f4[x_,y_,z_]:=x y^2 f5[x_,y_,z_]:=x y z f6[x_,y_,z_]:=x z^2 f7[x_,y_,z_]:=y^3 f8[x_,y_,z_]:=y^2z f9[x_,y_,z_]:=y z^2 f10[x_,y_,z_]:=z^3 f[x_,y_,z_] := {f1[x,y,z],f2[x,y,z],f3[x,y,z],f4[x,y,z],f5[x,y,z],f6[x,y,z],f7[x,y,z],f8[x,y,z],f9[x,y,z],f10[x,y,z]} fx1[x_,y_,z_]:=3x^2 fx2[x_,y_,z_]:=2x y fx3[x_,y_,z_]:=2x z fx4[x_,y_,z_]:=y^2 fx5[x_,y_,z_]:=y z fx6[x_,y_,z_]:=z^2 fx7[x_,y_,z_]:=0 fx8[x_,y_,z_]:=0 fx9[x_,y_,z_]:=0 fx10[x_,y_,z_]:=0 fx[x_,y_,z_] := {fx1[x,y,z],fx2[x,y,z],fx3[x,y,z],fx4[x,y,z],fx5[x,y,z],fx6[x,y,z],fx7[x,y,z],fx8[x,y,z],fx9[x,y,z],fx10[x,y,z]} fy1[x_,y_,z_]:=0 fy2[x_,y_,z_]:=x^2 fy3[x_,y_,z_]:=0 fy4[x_,y_,z_]:=2x y fy5[x_,y_,z_]:=x z fy6[x_,y_,z_]:=0 fy7[x_,y_,z_]:=3y^2 fy8[x_,y_,z_]:=2y z fy9[x_,y_,z_]:=z^2 fy10[x_,y_,z_]:=0 fy[x_,y_,z_] := {fy1[x,y,z],fy2[x,y,z],fy3[x,y,z],fy4[x,y,z],fy5[x,y,z],fy6[x,y,z],fy7[x,y,z],fy8[x,y,z],fy9[x,y,z],fy10[x,y,z]} fz1[x_,y_,z_]:=0 fz2[x_,y_,z_]:=0 fz3[x_,y_,z_]:=x^2 fz4[x_,y_,z_]:=0 fz5[x_,y_,z_]:=x y fz6[x_,y_,z_]:=2x z fz7[x_,y_,z_]:=0 fz8[x_,y_,z_]:=y^2 fz9[x_,y_,z_]:=2y z fz10[x_,y_,z_]:=3z^2 fz[x_,y_,z_] := {fz1[x,y,z],fz2[x,y,z],fz3[x,y,z],fz4[x,y,z],fz5[x,y,z],fz6[x,y,z],fz7[x,y,z],fz8[x,y,z],fz9[x,y,z],fz10[x,y,z]} A2[p_,q_]:={f[1,1,1],fx[1,1,1],fy[1,1,1], f[0,1,q],fz[0,1,q],f[1,0,p],fz[1,0,p],f[1,0,0],f[0,1,0]} Factor[NullSpace[A2[p,q]]] (* After obaining the solution, we put $f_{p,q}(x,y,y) to be: *) (* gpq[x_,y_,z_,p_,q_] := {0, -(1 + p - q) (-1 + p + q), p^2, (-1 + p - q) (-1 + p + q), -3 + 4 p - p^2 + 4 q - q^2, -2 p, 0, q^2, -2 q, 1}.f[x, y, z] *) gpq[x_,y_,z_,p_,q_] := z^3 + p^2x^2z + q^2y^2z - 2p x z^2 - 2q y z^2 + (1+p-q)(1-p-q)x^2y + (1-p+q)(1-p-q)x y^2 - (p^2+q^2-4p-4q+3)x y z (* Note that: *) e3 := {0,0,1,0,0, 0,0,0,0,0} Det[{e3,f[1,1,1],fx[1,1,1],fy[1,1,1], f[0,1,q],fz[0,1,q],f[1,0,p],fz[1,0,p],f[1,0,0],f[0,1,0]}] (*= p^4 q^2 \ne 0. *) (* Theorem 3.13. Proof (1). *) Factor[gpq[x,x,1,p,q]] (* = (x-1)^2(1-2(p+q-1)x) *) (* Theorem 3.13. Proof (2). *) Factor[gpq[x,y,z,p,1-p]] (* = (p x + q y - z)^2 z *) (* Theorem 3.13. Proof (3). *) g[x_,y_,z_,p_,q_] := (1+p-q)x + (1-p+q)y - 2z Factor[gpq[x,y,z,p,q] - ((1-p-q)y(x-z)g[x,y,z,p,q] + (p x + (1-p)y - z)^2 z)] Factor[gpq[x,y,z,p,q] - ((1-p-q)x(y-z)g[x,y,z,p,q] + ((1-q)x + q y - z)^2 z)] Factor[gpq[y,x,z,q,p] - gpq[x,y,z,p,q]] (* = 0 *) (*============================== Section 3.5 ===============================*) (* Definition 3.14. How to obtain f_{pqr}(x,y,z)): A1[p_,q_,r_]:={f[1,1,1],fx[1,1,1],fy[1,1,1], f[0,p,1],fy[0,p,1], f[1,0,q],fz[1,0,q], f[r,1,0],fx[r,1,0]} Factor[NullSpace[A1[p,q,r]]] (* After obaining the solution, we put $f_{p,q}(x,y,y) to be: *) f0[x_,y_,z_,p_,q_,r_] := {The above solution}.f[x, y, z] a1[p_,q_] := p q-p+1 a2[p_,q_,r_] := p^2q r-p^2r+p q r-p q+2p r+p-r+1 c1[p_,q_,r_] := q^2 a1[p,q] a1[r,p] a2[p,q,r] (* c1[q,r,p] = r^2 a1[r,q] a1[p,q] a2[q,r,p] c1[r,p,q] = p^2 a1[r,p] a1[q,r] a2[r,p,q] *) c2[p_,q_,r_] := - a1[p,q](2p^3q^3r^3 - 2p^3q^2r^3 + 6p^2q^2r^3 - 2p q^3r^3 + 3p q^3r^2 - 6p q^2r^3 + 3p q^2r^2 + 2q^2r^3 - p q^3 - 3q^2r^2 + 3p q^2 - 3p q + q^2 + p - 1) c3[p_,q_,r_] := r a1[p,q](p^3q^3r^3 - p^3q^2r^3 + 3p^2q^2r^3 - p q^3r^3 - 3p q^2r^3 + 3p q^3r + q^2r^3 - 2p q^3 - 3p q^2r + 6p q^2 - 3q^2r - 6p q + 2q^2 + 2p - 2) c4[p_,q_,r_] := -c1[p,q,r]-c1[q,r,p]-c1[r,p,q]- c2[p,q,r]-c2[q,r,p]-c2[r,p,q]-c3[p,q,r]-c3[q,r,p]-c3[r,p,q] fpqr[x_,y_,z_,p_,q_,r_] := c1[p,q,r]x^3 + c1[q,r,p]y^3+ c1[r,p,q]z^3 + c2[p,q,r]x^2y + c3[p,q,r]x y^2 + c2[q,r,p]y^2z + c3[q,r,p]y z^2 + c2[r,p,q]z^2x + c3[r,p,q]z x^2 + c4[p,q,r]x y z Factor[fpqr[x,y,z,p,q,r] - (p^2 a1[r,p] a1[q,r] (1 - q + r - p r + 2 q r + p q r - q r^2 + p q r^2)f0[x,y,z,p,q,r])] (* If not zero, multiply a certain constant! *) (* Some special cases. *) Factor[fpqr[x,y,z,p,q,(1-1/q)]] (* = (1/q^2)(1-p+p q)^4x((q-1)y+z-q x)^2 *) Factor[fpqr[x,y,z,p,q,1/(1-p)]] (* = (1/(p-1)^4)(1-p+p q)^4y((p-1)x+y-p z)^2 *) Factor[fpqr[x,y,z,p,(1-1/p),r]] (* = (1/p^2)(1-r+p r)^4z((p-1)x+y-p z)^2 *) Factor[fpqr[x,y,z,p,1/(1-r),r]] (* = (1/(r-1)^4)(1-r+p r)^4x((r-1)x+z-r z)^2 *) (* In the proof of Lemma 3.15. (1) *) Factor[a2[p,q,r] - (p r a1[p,q] + p a1[q,r]+ a1[r,p])] (* = 0 *) (* In the proof of Lemma 3.15. (2-2) *) b1[p_,q_] := -p^2q + p^2 - p q - 2p + 1 b2[p_,q_] := p^2q^2 - 2 p^2 q - 2 p q + p^2 - 2p + 1 r0[p_,q_] := (1 + p(1-q))/b1[p,q] r2[p_,q_] := (p(1-q)^2-1-q)/(q(p q+(p-1))) Factor[a2[p,q,r] - (-b1[p,q] r + a2[p,q,0])] Factor[a2[q,r,p] - (r q(p q+(p-1)) + (-p q^2 + 2p q - p + q + 1))] Factor[a2[r,p,q] - ((p-1)q r^2 - ((p-1)-(p+2)q)r + (1-q))] Factor[(r2[p,q] - r0[p,q]) - (-a1[p,q] b2[p,q])/(q (p q+(p-1)) b1[p,q])] Factor[a2[r0[p,q],p,q] - (2 a1[p,q] b2[p,q])/(((p-1)^2-p q(p+1))^2)] Factor[a2[r2[p,q],p,q] - 2a1[p,q] b2[p,q]/(((p-1)+p q)^2)] (* In the proof of Theorem 3.16. *) xpqr[t_] := a1[q,r] (t+(p-1))^2 (r^2 a1[p,q] a2[q,r,p] t - ((p^2q^2r^2+1) a1[q,r] + 2q r a1[r,p] + 2p q r^2 a1[p,q])) ypqr[t_] := a1[r,p] ((1-q)t+q)^2 (-((p^2q^2r^2+1)a1[r,p] + 2p r a1[p,q] + 2p^2q r a1[q,r])t + a1[p,q] a2[p,q,r]) zpqr[t_] := (r t-1)^2 a1[p,q] (a1[q,r] a2[q,r,p] t + q^2 a1[r,p] a2[p,q,r]) t1 := ((p^2q^2r^2+1) a1[q,r] + 2q r a1[r,p] + 2p q r^2 a1[p,q]) / (r^2 a1[p,q] a2[q,r,p]) t2 := (a1[p,q] a2[p,q,r]) / ((p^2q^2r^2+1)a1[r,p] + 2p r a1[p,q] + 2p^2q r a1[q,r]) Factor[xpqr[t1]] Factor[ypqr[t2]] Factor[(t1 - t2) - (a2[r,p,q](a1[r,p] + p r a1[p,q] + p^2q r a1[q,r])^2) / ( r^2 a1[p,q] a2[q,r,p] (a1[r,p] + 2p r a1[p,q] + 2p^2q r a1[q,r] + p^2q^2r^2a1[r,p]))] Factor[p^4 q^4 r^4 fpqr[x,y,z,1/p,1/q,1/r] - fpqr[x,z,y,p,r,q]] Factor[p q a1[1/p,1/q] - a1[q,p]] Factor[p^2 q r a2[1/p,1/q,1/r] - a2[p,r,q]] Factor[p^4q^4r^4 c1[1/p,1/q,1/r] - c1[p,r,q]] Factor[p^4q^4r^4 c2[1/p,1/q,1/r] - c3[q,p,r]] Factor[p^4q^4r^4 c3[1/p,1/q,1/r] - c2[q,p,r]] Factor[p^4q^4r^4 c4[1/p,1/q,1/r] - c4[p,r,q]] (*============================== Section 4 =================================*) (*============================ Section 4.1.2 ===============================*) f1[x_,y_,z_]:=x^4 f2[x_,y_,z_]:=x^3y f3[x_,y_,z_]:=x^3z f4[x_,y_,z_]:=x^2y^2 f5[x_,y_,z_]:=x^2y z f6[x_,y_,z_]:=x^2z^2 f7[x_,y_,z_]:=x y^3 f8[x_,y_,z_]:=x y^2z f9[x_,y_,z_]:=x y z^2 f10[x_,y_,z_]:=x z^3 f11[x_,y_,z_]:=y^4 f12[x_,y_,z_]:=y^3z f13[x_,y_,z_]:=y^2z^2 f14[x_,y_,z_]:=y z^3 f15[x_,y_,z_]:=z^4 f[x_,y_,z_] := {f1[x,y,z],f2[x,y,z],f3[x,y,z],f4[x,y,z],f5[x,y,z],f6[x,y,z],f7[x,y,z],f8[x,y,z],f9[x,y,z],f10[x,y,z],f11[x,y,z],f12[x,y,z],f13[x,y,z],f14[x,y,z],f15[x,y,z]} fx1[x_,y_,z_]:=4x^3 fx2[x_,y_,z_]:=3x^2y fx3[x_,y_,z_]:=3x^2z fx4[x_,y_,z_]:=2x y^2 fx5[x_,y_,z_]:=2x y z fx6[x_,y_,z_]:=2x z^2 fx7[x_,y_,z_]:=y^3 fx8[x_,y_,z_]:=y^2z fx9[x_,y_,z_]:=y z^2 fx10[x_,y_,z_]:=z^3 fx11[x_,y_,z_]:=0 fx12[x_,y_,z_]:=0 fx13[x_,y_,z_]:=0 fx14[x_,y_,z_]:=0 fx15[x_,y_,z_]:=0 fx[x_,y_,z_] := {fx1[x,y,z],fx2[x,y,z],fx3[x,y,z],fx4[x,y,z],fx5[x,y,z],fx6[x,y,z],fx7[x,y,z],fx8[x,y,z],fx9[x,y,z],fx10[x,y,z],fx11[x,y,z],fx12[x,y,z],fx13[x,y,z],fx14[x,y,z],fx15[x,y,z]} fy1[x_,y_,z_]:=0 fy2[x_,y_,z_]:=x^3 fy3[x_,y_,z_]:=0 fy4[x_,y_,z_]:=2x^2y fy5[x_,y_,z_]:=x^2 z fy6[x_,y_,z_]:=0 fy7[x_,y_,z_]:=3x y^2 fy8[x_,y_,z_]:=2x y z fy9[x_,y_,z_]:=x z^2 fy10[x_,y_,z_]:=0 fy11[x_,y_,z_]:=4y^3 fy12[x_,y_,z_]:=3y^2z fy13[x_,y_,z_]:=2y z^2 fy14[x_,y_,z_]:=z^3 fy15[x_,y_,z_]:=0 fy[x_,y_,z_] := {fy1[x,y,z],fy2[x,y,z],fy3[x,y,z],fy4[x,y,z],fy5[x,y,z],fy6[x,y,z],fy7[x,y,z],fy8[x,y,z],fy9[x,y,z],fy10[x,y,z],fy11[x,y,z],fy12[x,y,z],fy13[x,y,z],fy14[x,y,z],fy15[x,y,z]} fz1[x_,y_,z_]:=0 fz2[x_,y_,z_]:=0 fz3[x_,y_,z_]:=x^3 fz4[x_,y_,z_]:=0 fz5[x_,y_,z_]:=x^2y fz6[x_,y_,z_]:=2x^2z fz7[x_,y_,z_]:=0 fz8[x_,y_,z_]:=x y^2 fz9[x_,y_,z_]:=2x y z fz10[x_,y_,z_]:=3x z^2 fz11[x_,y_,z_]:=0 fz12[x_,y_,z_]:=y^3 fz13[x_,y_,z_]:=2y^2z fz14[x_,y_,z_]:=3y z^2 fz15[x_,y_,z_]:=4z^3 fz[x_,y_,z_] := {fz1[x,y,z],fz2[x,y,z],fz3[x,y,z],fz4[x,y,z],fz5[x,y,z],fz6[x,y,z],fz7[x,y,z],fz8[x,y,z],fz9[x,y,z],fz10[x,y,z],fz11[x,y,z],fz12[x,y,z],fz13[x,y,z],fz14[x,y,z],fz15[x,y,z]} (* 以下はPSDかも *) AE3[s_,t_,u_,v_] := {f[1,1,1],fx[1,1,1],fy[1,1,1], f[s,t,1],fx[s,t,1],fy[s,t,1], f[1,s,t],fy[1,s,t],fz[1,s,t], f[0,1,u],fz[0,1,u], f[v,0,1],fx[v,0,1], f[0,1,0]} Factor[NullSpace[AE3[2, 3, 3/4, 6/5]]] F412[x_,y_,z_] := 591900050 x^4 + 437205100 x^3 y - 766414561 x^2 y^2 + 217365672 x y^3 - 1650610670 x^3 z - 102695021 x^2 y z + 248518503 x y^2 z + 549666 y^3 z + 1531736792 x^2 z^2 + 118221267 x y z^2 + 101630538 y^2 z^2 - 636743352 x z^3 - 273946320 y z^3 + 183282336 z^4 ContourPlot[{F412[x,y,1]==0, x==0, y==0}, {x,-50,50},{y,-50,50}] Plot3D[F412[x,y,1], {x,0,50},{y,0,50}] F412[1,1,1] F412[2,3,1] F412[1,2,3] F412[0,4,3] F412[6,0,5] F412[0,1,0] (*============================ Section 4.1.3 ===============================*) f1[x_,y_,z_]:=x^5 f2[x_,y_,z_]:=x^4y f3[x_,y_,z_]:=x^4z f4[x_,y_,z_]:=x^3y^2 f5[x_,y_,z_]:=x^3y z f6[x_,y_,z_]:=x^3z^2 f7[x_,y_,z_]:=x^2y^3 f8[x_,y_,z_]:=x^2y^2z f9[x_,y_,z_]:=x^2y z^2 f10[x_,y_,z_]:=x^2z^3 f11[x_,y_,z_]:=x y^4 f12[x_,y_,z_]:=x y^3z f13[x_,y_,z_]:=x y^2z^2 f14[x_,y_,z_]:=x y z^3 f15[x_,y_,z_]:=x z^4 f16[x_,y_,z_]:=y^5 f17[x_,y_,z_]:=y^4z f18[x_,y_,z_]:=y^3z^2 f19[x_,y_,z_]:=y^2z^3 f20[x_,y_,z_]:=y z^4 f21[x_,y_,z_]:=z^5 f[x_,y_,z_] := {f1[x,y,z],f2[x,y,z],f3[x,y,z],f4[x,y,z],f5[x,y,z],f6[x,y,z],f7[x,y,z],f8[x,y,z],f9[x,y,z],f10[x,y,z],f11[x,y,z],f12[x,y,z],f13[x,y,z],f14[x,y,z],f15[x,y,z],f16[x,y,z],f17[x,y,z],f18[x,y,z],f19[x,y,z],f20[x,y,z],f21[x,y,z]} fx1[x_,y_,z_]:=5x^4 fx2[x_,y_,z_]:=4x^3y fx3[x_,y_,z_]:=4x^3z fx4[x_,y_,z_]:=3x^2y^2 fx5[x_,y_,z_]:=3x^2y z fx6[x_,y_,z_]:=3x^2z^2 fx7[x_,y_,z_]:=2x y^3 fx8[x_,y_,z_]:=2x y^2z fx9[x_,y_,z_]:=2x y z^2 fx10[x_,y_,z_]:=2x z^3 fx11[x_,y_,z_]:=y^4 fx12[x_,y_,z_]:=y^3z fx13[x_,y_,z_]:=y^2z^2 fx14[x_,y_,z_]:=y z^3 fx15[x_,y_,z_]:=z^4 fx16[x_,y_,z_]:=0 fx17[x_,y_,z_]:=0 fx18[x_,y_,z_]:=0 fx19[x_,y_,z_]:=0 fx20[x_,y_,z_]:=0 fx21[x_,y_,z_]:=0 fx[x_,y_,z_] := {fx1[x,y,z],fx2[x,y,z],fx3[x,y,z],fx4[x,y,z],fx5[x,y,z],fx6[x,y,z],fx7[x,y,z],fx8[x,y,z],fx9[x,y,z],fx10[x,y,z],fx11[x,y,z],fx12[x,y,z],fx13[x,y,z],fx14[x,y,z],fx15[x,y,z],fx16[x,y,z],fx17[x,y,z],fx18[x,y,z],fx19[x,y,z],fx20[x,y,z],fx21[x,y,z]} fy1[x_,y_,z_]:=0 fy2[x_,y_,z_]:=x^4 fy3[x_,y_,z_]:=0 fy4[x_,y_,z_]:=2x^3y fy5[x_,y_,z_]:=x^3z fy6[x_,y_,z_]:=0 fy7[x_,y_,z_]:=3x^2y^2 fy8[x_,y_,z_]:=2x^2y z fy9[x_,y_,z_]:=x^2z^2 fy10[x_,y_,z_]:=0 fy11[x_,y_,z_]:=4x y^3 fy12[x_,y_,z_]:=3x y^2z fy13[x_,y_,z_]:=2x y z^2 fy14[x_,y_,z_]:=x z^3 fy15[x_,y_,z_]:=0 fy16[x_,y_,z_]:=5y^4 fy17[x_,y_,z_]:=4y^3z fy18[x_,y_,z_]:=3y^2z^2 fy19[x_,y_,z_]:=2y z^3 fy20[x_,y_,z_]:=z^4 fy21[x_,y_,z_]:=0 fy[x_,y_,z_] := {fy1[x,y,z],fy2[x,y,z],fy3[x,y,z],fy4[x,y,z],fy5[x,y,z],fy6[x,y,z],fy7[x,y,z],fy8[x,y,z],fy9[x,y,z],fy10[x,y,z],fy11[x,y,z],fy12[x,y,z],fy13[x,y,z],fy14[x,y,z],fy15[x,y,z],fy16[x,y,z],fy17[x,y,z],fy18[x,y,z],fy19[x,y,z],fy20[x,y,z],fy21[x,y,z]} fz1[x_,y_,z_]:=0 fz2[x_,y_,z_]:=0 fz3[x_,y_,z_]:=x^4 fz4[x_,y_,z_]:=0 fz5[x_,y_,z_]:=x^3y fz6[x_,y_,z_]:=2x^3z fz7[x_,y_,z_]:=0 fz8[x_,y_,z_]:=x^2y^2 fz9[x_,y_,z_]:=2x^2y z fz10[x_,y_,z_]:=3x^2z^2 fz11[x_,y_,z_]:=0 fz12[x_,y_,z_]:=x y^3 fz13[x_,y_,z_]:=2x y^2z fz14[x_,y_,z_]:=3x y z^2 fz15[x_,y_,z_]:=4x z^3 fz16[x_,y_,z_]:=0 fz17[x_,y_,z_]:=y^4 fz18[x_,y_,z_]:=2y^3z fz19[x_,y_,z_]:=3y^2z^2 fz20[x_,y_,z_]:=4y z^3 fz21[x_,y_,z_]:=5z^4 fz[x_,y_,z_] := {fz1[x,y,z],fz2[x,y,z],fz3[x,y,z],fz4[x,y,z],fz5[x,y,z],fz6[x,y,z],fz7[x,y,z],fz8[x,y,z],fz9[x,y,z],fz10[x,y,z],fz11[x,y,z],fz12[x,y,z],fz13[x,y,z],fz14[x,y,z],fz15[x,y,z],fz16[x,y,z],fz17[x,y,z],fz18[x,y,z],fz19[x,y,z],fz20[x,y,z],fz21[x,y,z]} sdash[s_,t_] := ((t+2)(7-t)-s)/((t+2)(5t+1)) sdask[4,4] (* =1/9 *) A4[s_, t_] := {f[t, 1, 1], fx[t, 1, 1], fy[t, 1, 1], f[1, t, 1], fx[1, t, 1], fy[1, t, 1], f[1, 1, t], fx[1, 1, t], fy[1, 1, t], f[sdash[s, t], 1, 1], fx[sdash[s, t], 1, 1], fy[sdash[s, t], 1, 1], f[1, sdash[s, t], 1], fx[1, sdash[s, t], 1], fy[1, sdash[s, t], 1], f[1, 1, sdash[s, t]], fx[1, 1, sdash[s, t]], fy[1, 1, sdash[s, t]], f[1, 0, 0], f[0, 1, 0]} NullSpace[A4[4,4]] (* After find this solution, put *) F413[x_,y_, z_] := 648{0, 31/24, 65/24, -(215/216), -(1909/72), -(581/108), -(215/216), 5969/162, 9797/324, 3287/648, 31/24, -(1909/72), 9797/324, -(5515/324), -(47/18), 0, 65/24, -(581/108), 3287/648, -(47/18), 1}.f[x, y, z] (*============================== Section 4 =================================*) S6[a_,b_,c_]:=(a^6+b^6+c^6) S51[a_,b_,c_]:=(a^5b + b^5c + c^5a) S15[a_,b_,c_]:=(a b^5 + b c^5 + c a^5) S42[a_,b_,c_]:=(a^4b^2 + b^4c^2 + c^4a^2) S24[a_,b_,c_]:=(a^2b^4 + b^2c^4 + c^2a^4) S33[a_,b_,c_]:=(a^3b^3 + b^3c^3 + c^3a^3) US3[a_,b_,c_]:=a b c(a^3 + b^3 + c^3) US21[a_,b_,c_]:=a b c(a^2b + b^2c + c^2a) US12[a_,b_,c_]:=a b c(a b^2 + b c^2+ c a^2) U2[a_,b_,c_]:=(a^2b^2c^2) T51[a_,b_,c_]:=S51[a,b,c]+S15[a,b,c] T42[a_,b_,c_]:=S42[a,b,c]+S24[a,b,c] UT21[a_,b_,c_]:=US21[a,b,c]+US12[a,b,c] S5[a_, b_, c_] := a^5 + b^5 + c^5 S41[a_, b_, c_] := a^4 b + b^4 c + c^4 a S14[a_, b_, c_] := a b^4 + b c^4 + c a^4 S32[a_, b_, c_] := a^3 b^2 + b^3 c^2 + c^3 a^2 S23[a_, b_, c_] := a^2 b^3 + b^2 c^3 + c^2 a^3 T41[a_, b_, c_] := S41[a, b, c] + S14[a, b, c] T32[a_, b_, c_] := S32[a, b, c] + S23[a, b, c] US2[a_, b_, c_] := a b c(a^2+b^2+c^2) US11[a_, b_, c_] := a b c(a b+b c+c a) S4[a_,b_,c_] := (a^4+b^4+c^4) S31[a_,b_,c_] := (a^3b + b^3c + c^3a) S13[a_,b_,c_] := (a b^3 + b c^3 + c a^3) S22[a_,b_,c_] := (a^2b^2 + b^2c^2 + c^2a^2) US1[a_,b_,c_] := a b c(a + b + c) T31[a_, b_, c_] := S31[a, b, c] + S13[a, b, c] T21[a_,b_,c_] := (a^2b+b^2c+c^2a)+(a b^2+b c^2+c a^2) De[a_,b_,c_] := (a-b)(b-c)(c-a) S3[a_,b_,c_] := (a^3+b^3+c^3) S21[a_,b_,c_] := (a^2b + b^2c + c^2a) S12[a_,b_,c_] := (a b^2 + b c^2 + c a^2) U[a_,b_,c_] := a b c S2[a_,b_,c_] := (a^2+b^2+c^2) S11[a_,b_,c_] := (a b + b c + c a) S1[a_,b_,c_] := a + b + c s0[a_,b_,c_] := S4[a,b,c]-US1[a,b,c] s1[a_,b_,c_] := T31[a,b,c]-2US1[a,b,c] s2[a_,b_,c_] := S22[a,b,c]-US1[a,b,c] s3[a_,b_,c_] := US1[a,b,c] D3[a_,b_,c_] := a^2 b^2 - 4 b^3 - 4 a^3 c + 18 a b c - 27 c^2 D4[a_,b_,c_,d_] := a^2 b^2 c^2 - 4 b^3 c^2 - 4 a^3 c^3 + 18 a b c^3 - 27 c^4 - 4 a^2 b^3 d + 16 b^4 d + 18 a^3 b c d - 80 a b^2 c d - 6 a^2 c^2 d + 144 b c^2 d - 27 a^4 d^2 + 144 a^2 b d^2 - 128 b^2 d^2 - 192 a c d^2 + 256 d^3 (*============ Section 4.2 Structure of ${\Cal P}_{3,4}^{s+} ===============*) (* Theorem 4.8 *) f[a_,b_,c_,p1_,p2_,p3_] := s0[a,b,c] + p1 s1[a,b,c] + p2 s2[a,b,c] + p3 s3[a,b,c] Factor[f[x,1,1,p1,p2,v]] (* = x^4 + 2 p1 x^3 -(1+2p1-p2-p3) x^2 -2(1+p1+p2-p3) x + (2+2p1+p2) *) Factor[D4[2p1, -(1+2p1-p2-p3), -2(1+p1+p2-p3), (2+2p1+p2)]/(16 p3)] (* $\disc_4^s(p_1,p_2,p_3) := d_4(p_1,p_2,p_3)/(16 p_3)$. *) disc4s[p1_,p2_,p3_] := 375 + 900 p1 + 345 p1^2 - 708 p1^3 - 720 p1^4 - 192 p1^5 + 600 p2 + 1260 p1 p2 + 639 p1^2 p2 - 168 p1^3 p2 - 144 p1^4 p2 + 270 p2^2 + 396 p1 p2^2 + 99 p1^2 p2^2 - 36 p1^3 p2^2 + 48 p2^3 + 36 p1 p2^3 - 3 p1^2 p2^3 + 3 p2^4 - 388 p3 - 556 p1 p3 + 279 p1^2 p3 + 556 p1^3 p3 + 109 p1^4 p3 - 560 p2 p3 - 504 p1 p2 p3 + 186 p1^2 p2 p3 + 68 p1^3 p2 p3 - 212 p2^2 p3 - 44 p1 p2^2 p3 - 5 p1^2 p2^2 p3 + 8 p2^3 p3 + 162 p3^2 + 12 p1 p3^2 - 177 p1^2 p3^2 - 24 p1^3 p3^2 + 152 p2 p3^2 - 52 p1 p2 p3^2 - p1^2 p2 p3^2 + 6 p2^2 p3^2 - 20 p3^3 + 28 p1 p3^3 + p1^2 p3^3 - p3^4 (* Proposition 4.9 *) FrakP[s_,t_] := -(2 S31[s,t,1]-S13[s,t,1]-US1[s,t,1])/(S22[s,t,1]-US1[s,t,1]) FrakGpqX[a_,b_,c_,p_,q_] := S4[a,b,c] + p S31[a,b,c] + q S13[a,b,c] + ((p^2+p q+q^2)/3-1) S22[a,b,c] - (p+q+(p^2+p q+q^2)/3) US1[a,b,c] FrakGstA[a_,b_,c_,s_,t_] := FrakGpqX[a,b,c,FrakP[s,t],FrakP[t,s]] FrakGt[a_,b_,c_,t_] := s0[a,b,c] - (t+1)s1[a,b,c] + (t^2+2t)s2[a,b,c] Factor[FrakGstA[a,b,c,t,1] - FrakGt[a,b,c,t]] FrakEkX[a_,b_,c_,k_] := s0[a,b,c] - (2/k)s1[a,b,c] + ((2k^2+1)/k^2) s2[a,b,c] + 3(1/k-1)^2 s3[a,b,c] Factor[((a^2+b^2+c^2)-(a b+b c+c a)/k)^2 - FrakEkX[a,b,c,k]] FrakK[s_,t_] := S11[s,t,1]/S2[s,t,1] FrakEstA[a_,b_,c_,s_,t_] := FrakEkX[a,b,c,FrakK[s,t]] Factor[FrakGt[t,1,1,t]] Factor[FrakEstA[t,1,1,t,1]] Factor[FrakEstA[0,t,1,0,t]] (* Cf. Thf following FrakH[a,b,c,t] is also an extremal element of ${\Cal P}_{3,4}^{c0+} *) FrakH[a_,b_,c_,t_] := S31[a,b,c] + t^2 S13[a,b,c] - 2t S22[a,b,c] - (t-1)^2 US1[a,b,c] (* Corollary 4.11 *) (* ${\frak g}_t \in V(\disc_4^s)$ *) Factor[disc4s[-(t+1), (t^2+2t), 0]] (* ${\frak e}_{t,1}^A \in V(\disc_4^s)$ *) Factor[disc4s[-2/FrakK[t,1], ((2FrakK[t,1]^2+1)/FrakK[t,1]^2), 3(1/FrakK[t,1]-1)^2]] (* ${\frak e}_{0,t}^A \in V(4 p_2-8-p_1^2)$ *) DiscP2[p1_,p2_] := 2+2p1+p2 DiscCb[p1_,p2_] := 4 p2-8-p1^2 Factor[DiscCb[-2/FrakK[0,t], ((2FrakK[0,t]^2+1)/FrakK[0,t]^2)]] (* Proof of Theorem 4.8 *) Factor[disc4s[x,y,0]] Pvx[v_] := -2 Sqrt[v/3] - 2 Pvy[v_] := (v + 2 Sqrt[3v]+ 9)/3 (* Fig. 4.1 *) sep[x_,y_,v_] := y - x^2 + (v+2 Sqrt[3v]+1) ContourPlot[{disc4s[p,q,1/2]==0, DiscP2[p,q]==0, sep[p,q,1/2]==0, p==-1/2-1}, {p,-6,4}, {q,-6,10}] Show[ ParametricPlot[{t+(1/2)(2t+1)/(t+2)^3, (t^2-1)+(1/2)(-t^3+2t^2+3t+2)/(t+2)^3}, {t,-1.99,10}, PlotRange->{{-6,4},{-6,10}}], ParametricPlot[{t+(1/2)(2t+1)/(t+2)^3, (t^2-1)+(1/2)(-t^3+2t^2+3t+2)/(t+2)^3}, {t,-10,-2.01}, PlotRange->{{-6,4},{-6,10}}]] (* Fig. 4.2 *) ContourPlot[{disc4s[p,q,15]==0, DiscCb[p,q]==0, DiscP2[p,q]==0, p==-4, p==-2 Sqrt[15/3]-2}, {p,-15,10},{q,0,30}] Show[ ParametricPlot[{t+15(2t+1)/(t+2)^3, (t^2-1)+15(-t^3+2t^2+3t+2)/(t+2)^3}, {t,-1.9,10}, PlotRange->{{-15,10},{0,30}}], ParametricPlot[{t+15(2t+1)/(t+2)^3, (t^2-1)+15(-t^3+2t^2+3t+2)/(t+2)^3}, {t,-10,-2.1}, PlotRange->{{-15,10},{0,30}}]] (* Fig. 4.3 *) ContourPlot[{disc4s[p,q,100]==0, DiscCb[p,q]==0, DiscP2[p,q]==0, p==-4, p==-2 Sqrt[100/3]-2}, {p,-20,20},{q,0,70}] Show[ ParametricPlot[{t+100(2t+1)/(t+2)^3, (t^2-1)+100(-t^3+2t^2+3t+2)/(t+2)^3}, {t,-1.9,100}, PlotRange->{{-20,20},{0,70}}], ParametricPlot[{t+100(2t+1)/(t+2)^3, (t^2-1)+100(-t^3+2t^2+3t+2)/(t+2)^3}, {t,-100,-2.1}, PlotRange->{{-20,20},{0,70}}]] (* Remark 4.13 *) d4s[q0_,q1_,q2_,q3_] := 27 q1^4 q2 - 216 q0 q1^2 q2^2 + 432 q0^2 q2^3 + 36 q1^3 q2 q3 - 144 q0 q1 q2^2 q3 + 16 q1^2 q2^2 q3 - 64 q0 q2^3 q3 + q1^3 q3^2 - 36 q0 q1 q2 q3^2 + 8 q1^2 q2 q3^2 - 48 q0 q2^2 q3^2 + q1^2 q3^3 - 12 q0 q2 q3^3 - q0 q3^4 Factor[disc4s[p,q,v] - d4s[1, -4+p, 2-2p+q, 3-3p-3q+v]] (*============ Section 4.3 Structure of ${\Cal P}_{3,5}^{s+} ===============*) S5[a_, b_, c_] := a^5 + b^5 + c^5 S41[a_, b_, c_] := a^4 b + b^4 c + c^4 a S14[a_, b_, c_] := a b^4 + b c^4 + c a^4 S32[a_, b_, c_] := a^3 b^2 + b^3 c^2 + c^3 a^2 S23[a_, b_, c_] := a^2 b^3 + b^2 c^3 + c^2 a^3 T41[a_, b_, c_] := S41[a, b, c] + S14[a, b, c] T32[a_, b_, c_] := S32[a, b, c] + S23[a, b, c] US2[a_, b_, c_] := a b c(a^2+b^2+c^2) US11[a_, b_, c_] := a b c(a b+b c+c a) s0[a_,b_,c_] := S5[a,b,c]-US11[a,b,c] s1[a_,b_,c_] := T41[a,b,c]-2US11[a,b,c] s2[a_,b_,c_] := T32[a,b,c]-2US11[a,b,c] s3[a_,b_,c_] := US2[a,b,c]-US11[a,b,c] s4[a_,b_,c_] := US11[a,b,c] Eliminate[{p0 s0[0, t, 1] + p1 s1[0, t, 1] + p2 s2[0, t, 1] == 0, 5 t^4 p0 + (1 + 4 t^3) p1 + (2 t + 3 t^2) p2 == 0}, t] /* (5p0-3p1+p2)^2 (p0+p1+p2)(5 p0^2 + 2 p0 p1 + p1^2 - 4 p0 p2) ==0 */ discC0[p0_,p1_,p2_] := 5 p0^2 + 2 p0 p1 + p1^2 - 4 p0 p2 D3[a_,b_,c_] := a^2 b^2 - 4 b^3 - 4 a^3 c + 18 a b c - 27 c^2 disc3[a0_,a1_,a2_,a3_] := -a1^2 a2^2 + 4 a0 a2^3 + 4 a1^3 a3 - 18 a0 a1 a2 a3 + 27 a0^2 a3^2 D4[a_,b_,c_,d_] := a^2 b^2 c^2 - 4 b^3 c^2 - 4 a^3 c^3 + 18 a b c^3 - 27 c^4 - 4 a^2 b^3 d + 16 b^4 d + 18 a^3 b c d - 80 a b^2 c d - 6 a^2 c^2 d + 144 b c^2 d - 27 a^4 d^2 + 144 a^2 b d^2 - 128 b^2 d^2 - 192 a c d^2 + 256 d^3 disc4[p0_,p1_,p2_,p3_,p4_] := p1^2 p2^2 p3^2 - 4 p0 p2^3 p3^2 - 4 p1^3 p3^3 + 18 p0 p1 p2 p3^3 - 27 p0^2 p3^4 - 4 p1^2 p2^3 p4 + 16 p0 p2^4 p4 + 18 p1^3 p2 p3 p4 - 80 p0 p1 p2^2 p3 p4 - 6 p0 p1^2 p3^2 p4 + 144 p0^2 p2 p3^2 p4 - 27 p1^4 p4^2 + 144 p0 p1^2 p2 p4^2 - 128 p0^2 p2^2 p4^2 - 192 p0^2 p1 p3 p4^2 + 256 p0^3 p4^3 D5[a_,b_,c_,d_,e_] := a^2 b^2 c^2 d^2 - 4 b^3 c^2 d^2 - 4 a^3 c^3 d^2 + 18 a b c^3 d^2 - 27 c^4 d^2 - 4 a^2 b^3 d^3 + 16 b^4 d^3 + 18 a^3 b c d^3 - 80 a b^2 c d^3 - 6 a^2 c^2 d^3 + 144 b c^2 d^3 - 27 a^4 d^4 + 144 a^2 b d^4 - 128 b^2 d^4 - 192 a c d^4 + 256 d^5 - 4 a^2 b^2 c^3 e + 16 b^3 c^3 e + 16 a^3 c^4 e - 72 a b c^4 e + 108 c^5 e + 18 a^2 b^3 c d e - 72 b^4 c d e - 80 a^3 b c^2 d e + 356 a b^2 c^2 d e + 24 a^2 c^3 d e - 630 b c^3 d e - 6 a^3 b^2 d^2 e + 24 a b^3 d^2 e + 144 a^4 c d^2 e - 746 a^2 b c d^2 e + 560 b^2 c d^2 e + 1020 a c^2 d^2 e - 36 a^3 d^3 e + 160 a b d^3 e - 1600 c d^3 e - 27 a^2 b^4 e^2 + 108 b^5 e^2 + 144 a^3 b^2 c e^2 - 630 a b^3 c e^2 - 128 a^4 c^2 e^2 + 560 a^2 b c^2 e^2 + 825 b^2 c^2 e^2 - 900 a c^3 e^2 - 192 a^4 b d e^2 + 1020 a^2 b^2 d e^2 - 900 b^3 d e^2 + 160 a^3 c d e^2 - 2050 a b c d e^2 + 2250 c^2 d e^2 - 50 a^2 d^2 e^2 + 2000 b d^2 e^2 + 256 a^5 e^3 - 1600 a^3 b e^3 + 2250 a b^2 e^3 + 2000 a^2 c e^3 - 3750 b c e^3 - 2500 a d e^3 + 3125 e^4 disc5[p0_,p1_,p2_,p3_,p4_,p5_] := p1^2 p2^2 p3^2 p4^2 - 4 p0 p2^3 p3^2 p4^2 - 4 p1^3 p3^3 p4^2 + 18 p0 p1 p2 p3^3 p4^2 - 27 p0^2 p3^4 p4^2 - 4 p1^2 p2^3 p4^3 + 16 p0 p2^4 p4^3 + 18 p1^3 p2 p3 p4^3 - 80 p0 p1 p2^2 p3 p4^3 - 6 p0 p1^2 p3^2 p4^3 + 144 p0^2 p2 p3^2 p4^3 - 27 p1^4 p4^4 + 144 p0 p1^2 p2 p4^4 - 128 p0^2 p2^2 p4^4 - 192 p0^2 p1 p3 p4^4 + 256 p0^3 p4^5 - 4 p1^2 p2^2 p3^3 p5 + 16 p0 p2^3 p3^3 p5 + 16 p1^3 p3^4 p5 - 72 p0 p1 p2 p3^4 p5 + 108 p0^2 p3^5 p5 + 18 p1^2 p2^3 p3 p4 p5 - 72 p0 p2^4 p3 p4 p5 - 80 p1^3 p2 p3^2 p4 p5 + 356 p0 p1 p2^2 p3^2 p4 p5 + 24 p0 p1^2 p3^3 p4 p5 - 630 p0^2 p2 p3^3 p4 p5 - 6 p1^3 p2^2 p4^2 p5 + 24 p0 p1 p2^3 p4^2 p5 + 144 p1^4 p3 p4^2 p5 - 746 p0 p1^2 p2 p3 p4^2 p5 + 560 p0^2 p2^2 p3 p4^2 p5 + 1020 p0^2 p1 p3^2 p4^2 p5 - 36 p0 p1^3 p4^3 p5 + 160 p0^2 p1 p2 p4^3 p5 - 1600 p0^3 p3 p4^3 p5 - 27 p1^2 p2^4 p5^2 + 108 p0 p2^5 p5^2 + 144 p1^3 p2^2 p3 p5^2 - 630 p0 p1 p2^3 p3 p5^2 - 128 p1^4 p3^2 p5^2 + 560 p0 p1^2 p2 p3^2 p5^2 + 825 p0^2 p2^2 p3^2 p5^2 - 900 p0^2 p1 p3^3 p5^2 - 192 p1^4 p2 p4 p5^2 + 1020 p0 p1^2 p2^2 p4 p5^2 - 900 p0^2 p2^3 p4 p5^2 + 160 p0 p1^3 p3 p4 p5^2 - 2050 p0^2 p1 p2 p3 p4 p5^2 + 2250 p0^3 p3^2 p4 p5^2 - 50 p0^2 p1^2 p4^2 p5^2 + 2000 p0^3 p2 p4^2 p5^2 + 256 p1^5 p5^3 - 1600 p0 p1^3 p2 p5^3 + 2250 p0^2 p1 p2^2 p5^3 + 2000 p0^2 p1^2 p3 p5^3 - 3750 p0^3 p2 p3 p5^3 - 2500 p0^3 p1 p4 p5^3 + 3125 p0^4 p5^4 (* Theorem 4.14 *) ell[t_] := 2-t^2 + t Sqrt[(t-1)(t+2)] sm[t_] := (ell[t] - Sqrt[ell[t]^2 - 4])/2 p1A[t_] := -(t+1) p2A[t_] := t p3A[t_] := (t+1)^2 p4A[t_] := 0 FrakFtA[a_,b_,c_,t_] := s0[a,b,c] + p1A[t] s1[a,b,c] + p2A[t] s2[a,b,c] + p3A[t] s3[a,b,c] p1B[t_] := 1-2 ell[t] p2B[t_] := (t^3+2t^2-2) - 2(t^2-1) ell[t] p3B[t_] := (t+1)^2(4 ell[t] - (2t+3)) p4B[t_] := 0 FrakFtB[a_,b_,c_,t_] := s0[a,b,c] + p1B[t] s1[a,b,c] + p2B[t] s2[a,b,c] + p3B[t] s3[a,b,c] FrakFtC[a_,b_,c_,t_] := s1[a,b,c] + (t^2-1) s2[a,b,c] - 2(t+1)^2 s3[a,b,c] (* Corrected Corollary 5.7 of [3], (1) *) Factor[FrakFtC[u,1,1,t] - 2(u-1)^2(u-t)^2] Factor[FrakFtC[0,u,1,t] - u(u+1)((u-1)^2 + t^2 u)] (* Corrected Corollary 5.7 of [3], (2) *) Factor[FrakFtB[u,1,1,t] - (u-t)^2 (u-1)^2 (u + 2(t-Sqrt[(t-1)(t+2)])^2)] Factor[FrakFtB[0,u,1,t] - (u+1) (u^2-(2-t^2+t Sqrt[(t-1)(t+2)])u + 1)^2] (* Corrected Corollary 5.7 of [3], (3) *) Factor[FrakFtA[u,1,1,t] - u(u-1)^2(u-t)^2] Factor[FrakFtA[0,u,1,t] - (u+1)(u-1)^2 (u^2-t u+1)] (* Proposition 4.15 *) p1D[t_,z_] := -2z-3 p2D[t_,z_] := z^2 + 2z + 2 p3D[t_,z_] := -((2t^3+4t^2+5t+1)/(t^2(t+2))) z^2 + (2(4t^2+5t+3)/(t+2)) z - ((3t^3-7t^2-12t-8)/(t+2)) p4D[t_,z_] := (t-1)^3(-z^2 - 2t^2z +t^2(t-2))/(t^2(t+2)) FrakFstD[a_,b_,c_,s_,t_] := s0[a,b,c] + p1D[t,s+1/s-2] s1[a,b,c] + p2D[t,s+1/s-2] s2[a,b,c] + p3D[t,s+1/s-2] s3[a,b,c] + p4D[t,s+1/s-2] s4[a,b,c] Factor[FrakFstD[0,u,1,s,t] - (u+1)(u-s)^2 (u-1/s)^2] ftz[a_,b_,c_,t_,z_] := s0[a,b,c] + p1D[t,z] s1[a,b,c] + p2D[t,z] s2[a,b,c] + p3D[t,z] s3[a,b,c] + p4D[t,z] s4[a,b,c] c0[t_,z_] := t^2(t+2) c1[t_,z_] := 2t^2(t+2)(-2z+t-3) (* Zm[t]>(t-3)/2. c1<0 if (t-3)/20]] Factor[Limit[p2E[s,t] s (1+5t)^3 /(9(t-1)^2(t+2)) , s->0]] Factor[Limit[p3E[s,t] s (1+5t)^3 /(9(t-1)^2(t+2)) , s->0]] Factor[Limit[p4E[s,t] s (1+5t)^3 /(9(t-1)^2(t+2)) , s->0]] (* Remark 4.18 *) Factor[FrakFstE[a,b,c,3(t-1)^2(t+2)/(2t+1),t] - S1[a,b,c](S2[a,b,c]-(S2[t,1,1]/S11[t,1,1])S11[a,b,c])^2] p1G[t_] := (t^2-5t-5)/(7-t) p2G[t_] := - (t^2-6t+2)/(7-t) p3G[t_] := - (t+2)(t^2-3t-2)/(7-t) p4G[t_] := (t-1)^3/(7-t) FrakFtG[a_,b_,c_,t_] := s0[a,b,c] + p1G[t] s1[a,b,c] + p2G[t] s2[a,b,c] + p3G[t] s3[a,b,c] + p4G[t] s4[a,b,c] p1H[t_] := -(t^2+5)/(t+2) p2H[t_] := ((t^2-t+3)/(t+2)) p3H[t_] := (t^4-6t^3+10t^2+18t+13)/(t+2)^2 p4H[t_] := 3(t-1)^4/(t+2)^2 FrakFtH[a_,b_,c_,t_] := s0[a,b,c] + p1H[t] s1[a,b,c] + p2H[t] s2[a,b,c] + p3H[t] s3[a,b,c] + p4H[t] s4[a,b,c] (* Proposition 4.19 *) p3F[t_] := -((4t^2+5t+3)/(t+2)) p4F[t_] := ((t^3-3t^2+3t-1)/(t+2)) FrakFtF[a_,b_,c_,t_] := s1[a,b,c]-s2[a,b,c] + p3F[t] s3[a,b,c] + p4F[t] s4[a,b,c] (* Proposition 4.19 (1) *) Factor[FrakFtF[0,u,1,t] - u(u+1)(u-1)^2] Factor[FrakFtF[u,1,1,t] - u(u-t)^2(2u + (t-7)/(t+2))] (* Proposition 4.19 (2), (3) *) Factor[FrakFtG[a,b,c,t] - FrakFstE[a,b,c,sG[t],t]] Factor[FrakFtH[a,b,c,t] - FrakFstE[a,b,c,sH[t],t]] (* Theorem 4.10 (II-2)(iv) *) Factor[DiscCb[0, p1, -p1, p3, p4]] (* = -p1^2 (2 p1 + p3 + p4)^2 (192 p1^3 + 144 p1^2 p3 + 36 p1 p3^2 + 3 p3^3 + 11 p1^2 p4 - 62 p1 p3 p4 - p3^2 p4 + 16 p1 p4^2) *) (* Theorem 4.10 (III-2)(i) *) Factor[discC0[p0, p1, -p0 - p1]] (* = (3 p0 + p1)^2 *) (* Theorem 4.10 (III-2)(iii) *) Factor[DiscCb[p0, p1, -p0 - p1, p3, 0]] (* = 3 (p0 + 2 p1 + p3)^2 (4 p0 + 4 p1 + p3)^3 (-p1^2 + p0 p3) *) (* Proposition 4.21 (1) & Remark 4.22 *) g[a_,b_,c_,d_] := 219 a^4 b^3 - 5832 a^2 b^4 + 11664 b^5 + 972 a^3 b^3 c - 3888 a b^4 c + 432 a^2 b^4 c - 1728 b^5 c + 27 a^3 b^2 c^2 - 972 a b^3 c^2 + 216 a^2 b^3 c^2 - 1296 b^4 c^2 + 27 a^2 b^2 c^3 - 324 b^3 c^3 - 27 b^2 c^4 + 729 a^4 b^2 d - 7776 a^2 b^3 d - 216 a^3 b^3 d + 19440 b^4 d + 864 a b^4 d + 486 a^4 b c d - 3780 a^2 b^2 c d + 1026 a^3 b^2 c d + 10800 b^3 c d - 3672 a b^3 c d + 576 a^2 b^3 c d - 2304 b^4 c d + 666 a^3 b c^2 d - 3492 a b^2 c^2 d + 544 a^2 b^2 c^2 d - 2752 b^3 c^2 d + 16 a^3 c^3 d - 630 a b c^3 d + 164 a^2 b c^3 d - 1200 b^2 c^3 d + 16 a^2 c^4 d - 228 b c^4 d - 16 c^5 d - 729 a^5 d^2 + 6075 a^3 b d^2 - 13500 a b^2 d^2 - 1998 a^2 b^2 d^2 - 216 a^3 b^2 d^2 + 7560 b^3 d^2 + 864 a b^3 d^2 + 16 a^2 b^3 d^2 - 64 b^4 d^2 - 1053 a^4 c d^2 + 3555 a^2 b c d^2 - 558 a^3 b c d^2 + 6300 b^2 c d^2 + 2740 a b^2 c d^2 + 136 a^2 b^2 c d^2 - 560 b^3 c d^2 + 825 a^2 c^2 d^2 - 300 a^3 c^2 d^2 + 2250 b c^2 d^2 + 1991 a b c^2 d^2 + 65 a^2 b c^2 d^2 - 396 b^2 c^2 d^2 + 340 a c^3 d^2 + 8 a^2 c^3 d^2 - 97 b c^3 d^2 - 8 c^4 d^2 + 2025 a^3 d^3 + 216 a^4 d^3 - 9000 a b d^3 - 954 a^2 b d^3 - 80 b^2 d^3 + 8 a b^2 d^3 + 16 a^2 b^2 d^3 - 64 b^3 d^3 - 3750 a c d^3 - 345 a^2 c d^3 - 132 a^3 c d^3 - 400 b c d^3 + 598 a b c d^3 + 8 a^2 b c d^3 - 48 b^2 c d^3 - 500 c^2 d^3 + 149 a c^2 d^3 + a^2 c^2 d^3 - 12 b c^2 d^3 - c^3 d^3 + 3125 d^4 + 375 a d^4 - 12 a^2 d^4 - 16 a^3 d^4 + 45 b d^4 + 72 a b d^4 - 225 c d^4 + 18 a c d^4 - 27 d^5 Factor[D5[2p1,(2p2+p3), -2(1+2p1+p2+p3-p4), (-1-2p2+ p3+p4), 2(1+p1+p2)] - 16 p4 g[-5+p1, 5-3p1+p2, 5-p1-2p2+p3, -6+3p1-3p2-3p3+p4]] f1[a_,b_,c_,p1_,p2_,p3_,p4_] := s0[a,b,c] + p1 s1[a,b,c] + p2 s2[a,b,c] + p3 s3[a,b,c] + p4 s4[a,b,c] Factor[f1[x,1,1,p1,p2,p3,p4]-(x^5 + 2 p1 x^4 + (2p2+p3) x^3 - 2(1+2p1+p2+p3-p4) x^2 + (-1-2p2+p3+p4) x + 2 (1+p1+p2))] f2[a_,b_,c_,p1_,p2_,p3_,p4_] := S5[a,b,c] + p1 T41[a,b,c] + p2 T32[a,b,c] + p3 US2[a,b,c] + p4 US11[a,b,c] Factor[f2[x,1,1,p1,p2,p3,p4]-(x^5 + 2 p1 x^4 + (2p2+p3) x^3 + 2(p2+p4) x^2 + (2p1+2p3+p4) x + 2 (1+p1+p2))] (* Factor[D5[2p1, (2p2+p3), -2(1+2p1+p2+p3-p4), (-1-2p2+p3+p4), 2(1+p1+p2)]/(16 p4)] Factor[D5[2p1, (2p2+p3), 2(p2+p4), (2p1+2p3+p4), 2(1+p1+p2)]/(16(1+2p1+2p2+p3+p4))] *) (* DiscCb[] is a discriminant of f = p0 s0 + p1 s1 + p2 s2 + p3 s3 + p4 s4 *) DiscCb[p0_,p1_,p2_,p3_,p4_] := 10752 p0^7 + 38400 p0^6 p1 + 44544 p0^5 p1^2 + 10752 p0^4 p1^3 - 12288 p0^3 p1^4 - 6144 p0^2 p1^5 + 49920 p0^6 p2 + 155136 p0^5 p1 p2 + 151296 p0^4 p1^2 p2 + 24576 p0^3 p1^3 p2 - 33792 p0^2 p1^4 p2 - 12288 p0 p1^5 p2 + 94080 p0^5 p2^2 + 244608 p0^4 p1 p2^2 + 187392 p0^3 p1^2 p2^2 + 12288 p0^2 p1^3 p2^2 - 30720 p0 p1^4 p2^2 - 6144 p1^5 p2^2 + 91968 p0^4 p2^3 + 187392 p0^3 p1 p2^3 + 98304 p0^2 p1^2 p2^3 - 6144 p0 p1^3 p2^3 - 9216 p1^4 p2^3 + 49152 p0^3 p2^4 + 69504 p0^2 p1 p2^4 + 16896 p0 p1^2 p2^4 - 4608 p1^3 p2^4 + 13632 p0^2 p2^5 + 9984 p0 p1 p2^5 - 768 p1^2 p2^5 + 1536 p0 p2^6 + 8640 p0^6 p3 + 48768 p0^5 p1 p3 + 106176 p0^4 p1^2 p3 + 100608 p0^3 p1^3 p3 + 22272 p0^2 p1^4 p3 - 24576 p0 p1^5 p3 - 12288 p1^6 p3 + 45120 p0^5 p2 p3 + 185280 p0^4 p1 p2 p3 + 276096 p0^3 p1^2 p2 p3 + 152832 p0^2 p1^3 p2 p3 - 7680 p0 p1^4 p2 p3 - 24576 p1^5 p2 p3 + 81072 p0^4 p2^2 p3 + 239040 p0^3 p1 p2^2 p3 + 222336 p0^2 p1^2 p2^2 p3 + 43776 p0 p1^3 p2^2 p3 - 20736 p1^4 p2^2 p3 + 65376 p0^3 p2^3 p3 + 125760 p0^2 p1 p2^3 p3 + 53376 p0 p1^2 p2^3 p3 - 8448 p1^3 p2^3 p3 + 24432 p0^2 p2^4 p3 + 23232 p0 p1 p2^4 p3 - 1344 p1^2 p2^4 p3 + 3456 p0 p2^5 p3 + 14520 p0^5 p3^2 + 65688 p0^4 p1 p3^2 + 106176 p0^3 p1^2 p3^2 + 67296 p0^2 p1^3 p3^2 + 6144 p0 p1^4 p3^2 - 6144 p1^5 p3^2 + 39276 p0^4 p2 p3^2 + 129600 p0^3 p1 p2 p3^2 + 134640 p0^2 p1^2 p2 p3^2 + 35136 p0 p1^3 p2 p3^2 - 9216 p1^4 p2 p3^2 + 40896 p0^3 p2^2 p3^2 + 87480 p0^2 p1 p2^2 p3^2 + 42336 p0 p1^2 p2^2 p3^2 - 4896 p1^3 p2^2 p3^2 + 18780 p0^2 p2^3 p3^2 + 19632 p0 p1 p2^3 p3^2 - 912 p1^2 p2^3 p3^2 + 3168 p0 p2^4 p3^2 + 6381 p0^4 p3^3 + 20964 p0^3 p1 p3^3 + 21876 p0^2 p1^2 p3^3 + 6144 p0 p1^3 p3^3 - 1152 p1^4 p3^3 + 11550 p0^3 p2 p3^3 + 25080 p0^2 p1 p2 p3^3 + 12504 p0 p1^2 p2 p3^3 - 1152 p1^3 p2 p3^3 + 7197 p0^2 p2^2 p3^3 + 7716 p0 p1 p2^2 p3^3 - 300 p1^2 p2^2 p3^3 + 1512 p0 p2^3 p3^3 + 1161 p0^3 p3^4 + 2496 p0^2 p1 p3^4 + 1248 p0 p1^2 p3^4 - 96 p1^3 p3^4 + 1338 p0^2 p2 p3^4 + 1434 p0 p1 p2 p3^4 - 48 p1^2 p2 p3^4 + 396 p0 p2^2 p3^4 + 96 p0^2 p3^5 + 102 p0 p1 p3^5 - 3 p1^2 p3^5 + 54 p0 p2 p3^5 + 3 p0 p3^6 - 14035 p0^6 p4 - 42300 p0^5 p1 p4 - 46076 p0^4 p1^2 p4 - 22880 p0^3 p1^3 p4 - 704 p0^2 p1^4 p4 + 7680 p0 p1^5 p4 + 3072 p1^6 p4 - 60980 p0^5 p2 p4 - 143544 p0^4 p1 p2 p4 - 112368 p0^3 p1^2 p2 p4 - 29088 p0^2 p1^3 p2 p4 + 10880 p0 p1^4 p2 p4 + 7680 p1^5 p2 p4 - 98890 p0^4 p2^2 p4 - 171024 p0^3 p1 p2^2 p4 - 83960 p0^2 p1^2 p2^2 p4 - 288 p0 p1^3 p2^2 p4 + 9280 p1^4 p2^2 p4 - 72044 p0^3 p2^3 p4 - 82824 p0^2 p1 p2^3 p4 - 17808 p0 p1^2 p2^3 p4 + 5920 p1^3 p2^3 p4 - 21019 p0^2 p2^4 p4 - 13044 p0 p1 p2^4 p4 + 436 p1^2 p2^4 p4 - 872 p0 p2^5 p4 - 16510 p0^5 p3 p4 - 74922 p0^4 p1 p3 p4 - 114268 p0^3 p1^2 p3 p4 - 54992 p0^2 p1^3 p3 p4 + 9536 p0 p1^4 p3 p4 + 7808 p1^5 p3 p4 - 57710 p0^4 p2 p3 p4 - 182090 p0^3 p1 p2 p3 p4 - 159748 p0^2 p1^2 p2 p3 p4 - 14496 p0 p1^3 p2 p3 p4 + 14208 p1^4 p2 p3 p4 - 73206 p0^3 p2^2 p3 p4 - 132590 p0^2 p1 p2^2 p3 p4 - 40276 p0 p1^2 p2^2 p3 p4 + 6352 p1^3 p2^2 p3 p4 - 34322 p0^2 p2^3 p3 p4 - 20510 p0 p1 p2^3 p3 p4 + 708 p1^2 p2^3 p3 p4 - 1852 p0 p2^4 p3 p4 - 16485 p0^4 p3^2 p4 - 49714 p0^3 p1 p3^2 p4 - 42911 p0^2 p1^2 p3^2 p4 - 7064 p0 p1^3 p3^2 p4 + 1488 p1^4 p3^2 p4 - 34508 p0^3 p2 p3^2 p4 - 61480 p0^2 p1 p2 p3^2 p4 - 19022 p0 p1^2 p2 p3^2 p4 + 2040 p1^3 p2 p3^2 p4 - 18677 p0^2 p2^2 p3^2 p4 - 11470 p0 p1 p2^2 p3^2 p4 + 361 p1^2 p2^2 p3^2 p4 - 1430 p0 p2^3 p3^2 p4 - 3438 p0^3 p3^3 p4 - 5658 p0^2 p1 p3^3 p4 - 1545 p0 p1^2 p3^3 p4 + 30 p1^3 p3^3 p4 - 4030 p0^2 p2 p3^3 p4 - 2290 p0 p1 p2 p3^3 p4 + 48 p1^2 p2 p3^3 p4 - 457 p0 p2^2 p3^3 p4 - 162 p0^2 p3^4 p4 - 26 p0 p1 p3^4 p4 - 5 p1^2 p3^4 p4 - 38 p0 p2 p3^4 p4 + 5 p0 p3^5 p4 + 8870 p0^5 p4^2 + 22500 p0^4 p1 p4^2 + 24014 p0^3 p1^2 p4^2 + 8188 p0^2 p1^3 p4^2 - 3408 p0 p1^4 p4^2 - 1664 p1^5 p4^2 + 30420 p0^4 p2 p4^2 + 54716 p0^3 p1 p2 p4^2 + 33148 p0^2 p1^2 p2 p4^2 - 992 p0 p1^3 p2 p4^2 - 3568 p1^4 p2 p4^2 + 35790 p0^3 p2^2 p4^2 + 38324 p0^2 p1 p2^2 p4^2 + 7014 p0 p1^2 p2^2 p4^2 - 2300 p1^3 p2^2 p4^2 + 14584 p0^2 p2^3 p4^2 + 5132 p0 p1 p2^3 p4^2 - 96 p1^2 p2^3 p4^2 + 192 p0 p2^4 p4^2 + 10940 p0^4 p3 p4^2 + 34808 p0^3 p1 p3 p4^2 + 24458 p0^2 p1^2 p3 p4^2 + 150 p0 p1^3 p3 p4^2 - 1488 p1^4 p3 p4^2 + 27310 p0^3 p2 p3 p4^2 + 46090 p0^2 p1 p2 p3 p4^2 + 6998 p0 p1^2 p2 p3 p4^2 - 1606 p1^3 p2 p3 p4^2 + 17146 p0^2 p2^2 p3 p4^2 + 6150 p0 p1 p2^2 p3 p4^2 - 100 p1^2 p2^2 p3 p4^2 + 296 p0 p2^3 p3 p4^2 + 5660 p0^3 p3^2 p4^2 + 6564 p0^2 p1 p3^2 p4^2 + 1684 p0 p1^2 p3^2 p4^2 + 48 p1^3 p3^2 p4^2 + 5488 p0^2 p2 p3^2 p4^2 + 1680 p0 p1 p2 p3^2 p4^2 - 28 p1^2 p2 p3^2 p4^2 + 156 p0 p2^2 p3^2 p4^2 - 192 p0^2 p3^3 p4^2 - 56 p0 p1 p3^3 p4^2 - p1^2 p3^3 p4^2 + 30 p0 p2 p3^3 p4^2 + p0 p3^4 p4^2 - 3045 p0^4 p4^3 - 6700 p0^3 p1 p4^3 - 3726 p0^2 p1^2 p4^3 + 456 p0 p1^3 p4^3 + 325 p1^4 p4^3 - 7580 p0^3 p2 p4^3 - 8844 p0^2 p1 p2 p4^3 - 576 p0 p1^2 p2 p4^3 + 404 p1^3 p2 p4^3 - 4730 p0^2 p2^2 p4^3 - 908 p0 p1 p2^2 p4^3 + 4 p1^2 p2^2 p4^3 - 8 p0 p2^3 p4^3 - 3160 p0^3 p3 p4^3 - 3672 p0^2 p1 p3 p4^3 - 366 p0 p1^2 p3 p4^3 + 34 p1^3 p3 p4^3 - 3470 p0^2 p2 p3 p4^3 - 530 p0 p1 p2 p3 p4^3 + 4 p1^2 p2 p3 p4^3 - 12 p0 p2^2 p3 p4^3 + 55 p0^2 p3^2 p4^3 - 38 p0 p1 p3^2 p4^3 + p1^2 p3^2 p4^3 - 6 p0 p2 p3^2 p4^3 - p0 p3^3 p4^3 + 610 p0^3 p4^4 + 600 p0^2 p1 p4^4 - 6 p0 p1^2 p4^4 - 16 p1^3 p4^4 + 720 p0^2 p2 p4^4 + 36 p0 p1 p2 p4^4 + 90 p0^2 p3 p4^4 + 18 p0 p1 p3 p4^4 - 27 p0^2 p4^5 Factor[DiscCb[1, 5+a1, 10+3a1+a2, 20+7a1+2a2+a3, 81+27a1+9a2+3a3+a4] - g[a1,a2,a3,a4]] Factor[g[(-5+p1), (5-3p1+p2), (5-p1-2p2+p3), (-6+3p1-3p2-3p3+p4)] - DiscCb[1,p1,p2,p3,p4]] (* Proof of ${\frak f}_t^A \in V(\disc(C^b)$ *) p1A[t_] := -(t+1) p2A[t_] := t p3A[t_] := (t+1)^2 Factor[DiscCb[1,p1A[t], p2A[t], p3A[t], 0]] (* Proof of ${\frak f}_t^C \in V(\disc(C^b)$ *) (* FrakFtC[a_,b_,c_,t_] := s1[a,b,c] + (t^2-1) s2[a,b,c] - 2(t+1)^2 s3[a,b,c] *) Factor[DiscCb[0,1, (t^2-1), -2(t+1)^2, 0]] (* Proof of ${\frak f}_{s,t}^D \in V(\disc(C^b)$ *) p1D[t_,z_] := -2z-3 p2D[t_,z_] := z^2 + 2z + 2 p3D[t_,z_] := -((2t^3+4t^2+5t+1)/(t^2(t+2))) z^2 + (2(4t^2+5t+3)/(t+2)) z - ((3t^3-7t^2-12t-8)/(t+2)) p4D[t_,z_] := (t-1)^3(-z^2 - 2t^2z +t^2(t-2))/(t^2(t+2)) Factor[DiscCb[1,p1D[s,t], p2D[s,t], p3D[s,t], p4D[s,t]]] (* Proof of ${\frak f}_{s,t}^E \in V(\disc(C^b)$ *) p1E[s_,t_] := (s^2 - (t+2)(5t^2+t+9) s + 9(t-1)^2(t+2)^2)/(s(5t+1)(t+2)) p2E[s_,t_] := (-t^2 s^3 + (t-1)(7t^3-t^2+11t+1)s^2 + (t+2)(17t^5-25t^4+199t^3-59t^2+76t+8)s + 9(t-1)^4(t+2)^2(t^2-12t-1))/(s(5t+1)^3(t+2)) p3E[s_,t_]:=((2t^3+4t^2+5t+1)s^3 - 2(t+2)(7t^4+42t^3+37t^2+48t+10)s^2 + (t+2)^2(91t^5+125t^4+682t^3+182t^2+523t+125)s - 18(t-1)^2(t+2)^3(t^4+36t^3+34t^2+60t+13))/(s(t+2)^2(5t+1)^3) p4E[s_,t_]:=((t-1)^3(6t^2+6t-12 + s)^3)/(s(t+2)^2(5t+1)^3) Factor[DiscCb[1,p1E[s,t], p2E[s,t], p3E[s,t], p4E[s,t]]] (* Proof of ${\frak f}_t^F \in V(\disc(C^b)$ *) (* FrakFtF[a_,b_,c_,t_] := s1[a,b,c]-s2[a,b,c] + p3F[t] s3[a,b,c] + p4F[t] s4[a,b,c] *) p3F[t_] := -((4t^2+5t+3)/(t+2)) p4F[t_] := ((t^3-3t^2+3t-1)/(t+2)) Factor[DiscCb[0,1,-1, p3F[t], p4F[t]]] (*============ Section 4.4 Structure of ${\Cal P}_{3,6}^{s0+} ==============*) S6[a_,b_,c_]:=(a^6+b^6+c^6) S51[a_,b_,c_]:=(a^5b + b^5c + c^5a) S15[a_,b_,c_]:=(a b^5 + b c^5 + c a^5) S42[a_,b_,c_]:=(a^4b^2 + b^4c^2 + c^4a^2) S24[a_,b_,c_]:=(a^2b^4 + b^2c^4 + c^2a^4) S33[a_,b_,c_]:=(a^3b^3 + b^3c^3 + c^3a^3) US3[a_,b_,c_]:=a b c(a^3 + b^3 + c^3) US21[a_,b_,c_]:=a b c(a^2b + b^2c + c^2a) US12[a_,b_,c_]:=a b c(a b^2 + b c^2+ c a^2) U2[a_,b_,c_]:=(a^2b^2c^2) T51[a_,b_,c_]:=S51[a,b,c]+S15[a,b,c] T42[a_,b_,c_]:=S42[a,b,c]+S24[a,b,c] UT21[a_,b_,c_]:=US21[a,b,c]+US12[a,b,c] S5[a_, b_, c_] := a^5 + b^5 + c^5 S41[a_, b_, c_] := a^4 b + b^4 c + c^4 a S14[a_, b_, c_] := a b^4 + b c^4 + c a^4 S32[a_, b_, c_] := a^3 b^2 + b^3 c^2 + c^3 a^2 S23[a_, b_, c_] := a^2 b^3 + b^2 c^3 + c^2 a^3 T41[a_, b_, c_] := S41[a, b, c] + S14[a, b, c] T32[a_, b_, c_] := S32[a, b, c] + S23[a, b, c] US2[a_, b_, c_] := a b c(a^2+b^2+c^2) US11[a_, b_, c_] := a b c(a b+b c+c a) S4[a_,b_,c_] := (a^4+b^4+c^4) S31[a_,b_,c_] := (a^3b + b^3c + c^3a) S13[a_,b_,c_] := (a b^3 + b c^3 + c a^3) S22[a_,b_,c_] := (a^2b^2 + b^2c^2 + c^2a^2) US1[a_,b_,c_] := a b c(a + b + c) T31[a_, b_, c_] := S31[a, b, c] + S13[a, b, c] T21[a_,b_,c_] := (a^2b+b^2c+c^2a)+(a b^2+b c^2+c a^2) De[a_,b_,c_] := (a-b)(b-c)(c-a) S3[a_,b_,c_] := (a^3+b^3+c^3) S21[a_,b_,c_] := (a^2b + b^2c + c^2a) S12[a_,b_,c_] := (a b^2 + b c^2 + c a^2) U[a_,b_,c_] := a b c S2[a_,b_,c_] := (a^2+b^2+c^2) S11[a_,b_,c_] := (a b + b c + c a) S1[a_,b_,c_] := a + b + c s0[a_,b_,c_] := S6[a,b,c] - 3 U2[a,b,c] s1[a_,b_,c_] := T51[a,b,c] - 6 U2[a,b,c] s2[a_,b_,c_] := T42[a,b,c] - 6 U2[a,b,c] s3[a_,b_,c_] := S33[a,b,c] - 3 U2[a,b,c] s4[a_,b_,c_] := US3[a,b,c] - 3 U2[a,b,c] s5[a_,b_,c_] := UT21[a,b,c] - 6 U2[a,b,c] t0[a_,b_,c_] := S1[a,b,c]^6 - 3^6 U2[a,b,c] t1[a_,b_,c_] := S1[a,b,c]^4 S11[a,b,c] - 3^5 U2[a,b,c] t2[a_,b_,c_] := S1[a,b,c]^2 S11[a,b,c]^2 - 81 U2[a,b,c] t3[a_,b_,c_] := S11[a,b,c]^3 - 27 U2[a,b,c] t4[a_,b_,c_] := S1[a,b,c]^3 U[a,b,c] - 27 U2[a,b,c] t5[a_,b_,c_] := S1[a,b,c] S11[a,b,c] U[a,b,c] - 9 U2[a,b,c] (* Proposition 4.24 *) Fa0v1[p_,q_,r_,p0_,q0_,r0_,v_] := 9 p0(p0^2-3q0) r - (p0^3-27r0 + v p0^3) p q + (p0 q0-9r0 + v p0 q0) p^3 Fa0vw2[p_,q_,r_,p0_,q0_,r0_,v_,w_] := p0^2 (q0 p^2 - p0^2 q)^2 (w p^2 - 3(w+v^2) q) Fa0vw[p_,q_,r_,p0_,q0_,r0_,v_,w_] := Fa0v1[p,q,r,p0,q0,r0,v]^2 + Fa0vw2[p,q,r,p0,q0,r0,v,w] Factor[Fa0vw[1, 1/3-y, 1/27-z, 1,q0,r0,v,w] - ( 6 v(1-3q0)^2 z + (1/3)(w(1-3q0)^2 + (1-3q0)v((1-3q0)v-2(1-27r0))) y + (1-54r0+729r0^2+2v-54r0 v-2v^2+6q0 v^2-2w+6q0 w) y^2 + 18 (1-3q0)(-1 + 27 r0 - v) y z + 81 (1-3q0)^2 z^2 + 3 (v^2 + w) y^3)] (* Discriminant of ${\Cal P_{3.6}^{s0+}$: $\disc(C^0)$. $(0:t:1) in A = \P_+^2$. For $f = p0 s0 + p1 s2 + ... + p5 s5$. $s0=S6-3 U2$... *) DiscC0[p0_,p1_,p2_,p3_] := (108 p0^4 + 9 p0^2 p1^2 + 8 p1^4 - 108 p0^3 p2 - 42 p0 p1^2 p2 + 36 p0^2 p2^2 + p1^2 p2^2 - 4 p0 p2^3 + 54 p0^2 p1 p3 - 4 p1^3 p3 + 18 p0 p1 p2 p3 - 27 p0^2 p3^2) (* Discriminant of ${\Cal P_{3.6}^{s0+}$: $\disc(C^b)$. $(t:1:1) \in A = \P_+^2$ *) DiscCb[p0_,p1_,p2_,p3_,p4_,p5_] := (108 p0^5 p1 + 324 p0^4 p1^2 + 306 p0^3 p1^3 + 40 p0^2 p1^4 + 16 p0 p1^5 + 92 p1^6 + 324 p0^4 p1 p2 + 576 p0^3 p1^2 p2 - 12 p0^2 p1^3 p2 - 272 p0 p1^4 p2 + 128 p1^5 p2 + 360 p0^3 p1 p2^2 + 192 p0^2 p1^2 p2^2 - 360 p0 p1^3 p2^2 + 32 p1^4 p2^2 + 176 p0^2 p1 p2^3 - 64 p0 p1^2 p2^3 - 16 p1^3 p2^3 + 32 p0 p1 p2^4 + 54 p0^5 p3 + 432 p0^4 p1 p3 + 693 p0^3 p1^2 p3 + 218 p0^2 p1^3 p3 - 20 p0 p1^4 p3 + 148 p1^5 p3 + 162 p0^4 p2 p3 + 828 p0^3 p1 p2 p3 + 354 p0^2 p1^2 p2 p3 - 472 p0 p1^3 p2 p3 + 152 p1^4 p2 p3 + 180 p0^3 p2^2 p3 + 384 p0^2 p1 p2^2 p3 - 372 p0 p1^2 p2^2 p3 + 8 p1^3 p2^2 p3 + 88 p0^2 p2^3 p3 - 16 p0 p1 p2^3 p3 - 8 p1^2 p2^3 p3 + 16 p0 p2^4 p3 + 135 p0^4 p3^2 + 486 p0^3 p1 p3^2 + 315 p0^2 p1^2 p3^2 - 50 p0 p1^3 p3^2 + 83 p1^4 p3^2 + 270 p0^3 p2 p3^2 + 396 p0^2 p1 p2 p3^2 - 240 p0 p1^2 p2 p3^2 + 44 p1^3 p2 p3^2 + 144 p0^2 p2^2 p3^2 - 96 p0 p1 p2^2 p3^2 - 4 p1^2 p2^2 p3^2 + 8 p0 p2^3 p3^2 + 108 p0^3 p3^3 + 162 p0^2 p1 p3^3 - 18 p0 p1^2 p3^3 + 16 p1^3 p3^3 + 108 p0^2 p2 p3^3 - 36 p0 p1 p2 p3^3 + 27 p0^2 p3^4 + 54 p0^5 p4 + 270 p0^4 p1 p4 + 441 p0^3 p1^2 p4 + 44 p0^2 p1^3 p4 - 176 p0 p1^4 p4 + 108 p1^5 p4 + 162 p0^4 p2 p4 + 612 p0^3 p1 p2 p4 + 282 p0^2 p1^2 p2 p4 - 488 p0 p1^3 p2 p4 + 80 p1^4 p2 p4 + 180 p0^3 p2^2 p4 + 360 p0^2 p1 p2^2 p4 - 244 p0 p1^2 p2^2 p4 + 88 p0^2 p2^3 p4 + 16 p0 p1 p2^3 p4 - 8 p1^2 p2^3 p4 + 16 p0 p2^4 p4 + 189 p0^4 p3 p4 + 576 p0^3 p1 p3 p4 + 255 p0^2 p1^2 p3 p4 - 250 p0 p1^3 p3 p4 + 94 p1^4 p3 p4 + 432 p0^3 p2 p3 p4 + 540 p0^2 p1 p2 p3 p4 - 464 p0 p1^2 p2 p3 p4 + 44 p1^3 p2 p3 p4 + 276 p0^2 p2^2 p3 p4 - 104 p0 p1 p2^2 p3 p4 - 12 p1^2 p2^2 p3 p4 + 32 p0 p2^3 p3 p4 + 189 p0^3 p3^2 p4 + 234 p0^2 p1 p3^2 p4 - 126 p0 p1^2 p3^2 p4 + 22 p1^3 p3^2 p4 + 216 p0^2 p2 p3^2 p4 - 96 p0 p1 p2 p3^2 p4 - 4 p1^2 p2 p3^2 p4 + 12 p0 p2^2 p3^2 p4 + 54 p0^2 p3^3 p4 - 18 p0 p1 p3^3 p4 + 72 p0^4 p4^2 + 300 p0^3 p1 p4^2 + 131 p0^2 p1^2 p4^2 - 190 p0 p1^3 p4^2 + 59 p1^4 p4^2 + 204 p0^3 p2 p4^2 + 308 p0^2 p1 p2 p4^2 - 268 p0 p1^2 p2 p4^2 + 12 p1^3 p2 p4^2 + 164 p0^2 p2^2 p4^2 - 24 p0 p1 p2^2 p4^2 - 12 p1^2 p2^2 p4^2 + 32 p0 p2^3 p4^2 + 171 p0^3 p3 p4^2 + 222 p0^2 p1 p3 p4^2 - 139 p0 p1^2 p3 p4^2 + 20 p1^3 p3 p4^2 + 210 p0^2 p2 p3 p4^2 - 92 p0 p1 p2 p3 p4^2 - 6 p1^2 p2 p3 p4^2 + 24 p0 p2^2 p3 p4^2 + 72 p0^2 p3^2 p4^2 - 24 p0 p1 p3^2 p4^2 - p1^2 p3^2 p4^2 + 6 p0 p2 p3^2 p4^2 + 73 p0^3 p4^3 + 86 p0^2 p1 p4^3 - 81 p0 p1^2 p4^3 + 4 p1^3 p4^3 + 98 p0^2 p2 p4^3 - 20 p0 p1 p2 p4^3 - 6 p1^2 p2 p4^3 + 24 p0 p2^2 p4^3 + 47 p0^2 p3 p4^3 - 22 p0 p1 p3 p4^3 - p1^2 p3 p4^3 + 8 p0 p2 p3 p4^3 + p0 p3^2 p4^3 + 19 p0^2 p4^4 - 4 p0 p1 p4^4 - p1^2 p4^4 + 8 p0 p2 p4^4 + p0 p3 p4^4 + p0 p4^5 + 108 p0^5 p5 + 540 p0^4 p1 p5 + 846 p0^3 p1^2 p5 + 268 p0^2 p1^3 p5 - 60 p0 p1^4 p5 + 192 p1^5 p5 + 324 p0^4 p2 p5 + 1080 p0^3 p1 p2 p5 + 444 p0^2 p1^2 p2 p5 - 600 p0 p1^3 p2 p5 + 200 p1^4 p2 p5 + 360 p0^3 p2^2 p5 + 480 p0^2 p1 p2^2 p5 - 520 p0 p1^2 p2^2 p5 + 32 p1^3 p2^2 p5 + 176 p0^2 p2^3 p5 - 64 p0 p1 p2^3 p5 - 16 p1^2 p2^3 p5 + 32 p0 p2^4 p5 + 378 p0^4 p3 p5 + 1134 p0^3 p1 p3 p5 + 708 p0^2 p1^2 p3 p5 - 114 p0 p1^3 p3 p5 + 184 p1^4 p3 p5 + 792 p0^3 p2 p3 p5 + 948 p0^2 p1 p2 p3 p5 - 572 p0 p1^2 p2 p3 p5 + 124 p1^3 p2 p3 p5 + 432 p0^2 p2^2 p3 p5 - 272 p0 p1 p2^2 p3 p5 - 8 p1^2 p2^2 p3 p5 + 16 p0 p2^3 p3 p5 + 378 p0^3 p3^2 p5 + 522 p0^2 p1 p3^2 p5 - 60 p0 p1^2 p3^2 p5 + 48 p1^3 p3^2 p5 + 396 p0^2 p2 p3^2 p5 - 108 p0 p1 p2 p3^2 p5 + 108 p0^2 p3^3 p5 + 252 p0^4 p4 p5 + 870 p0^3 p1 p4 p5 + 376 p0^2 p1^2 p4 p5 - 386 p0 p1^3 p4 p5 + 172 p1^4 p4 p5 + 660 p0^3 p2 p4 p5 + 796 p0^2 p1 p2 p4 p5 - 756 p0 p1^2 p2 p4 p5 + 68 p1^3 p2 p4 p5 + 472 p0^2 p2^2 p4 p5 - 176 p0 p1 p2^2 p4 p5 - 24 p1^2 p2^2 p4 p5 + 64 p0 p2^3 p4 p5 + 504 p0^3 p3 p4 p5 + 642 p0^2 p1 p3 p4 p5 - 298 p0 p1^2 p3 p4 p5 + 62 p1^3 p3 p4 p5 + 576 p0^2 p2 p3 p4 p5 - 272 p0 p1 p2 p3 p4 p5 - 8 p1^2 p2 p3 p4 p5 + 24 p0 p2^2 p3 p4 p5 + 198 p0^2 p3^2 p4 p5 - 54 p0 p1 p3^2 p4 p5 + 288 p0^3 p4^2 p5 + 326 p0^2 p1 p4^2 p5 - 248 p0 p1^2 p4^2 p5 + 26 p1^3 p4^2 p5 + 340 p0^2 p2 p4^2 p5 - 128 p0 p1 p2 p4^2 p5 - 12 p1^2 p2 p4^2 p5 + 48 p0 p2^2 p4^2 p5 + 180 p0^2 p3 p4^2 p5 - 68 p0 p1 p3 p4^2 p5 - 2 p1^2 p3 p4^2 p5 + 12 p0 p2 p3 p4^2 p5 + 74 p0^2 p4^3 p5 - 28 p0 p1 p4^3 p5 - 2 p1^2 p4^3 p5 + 16 p0 p2 p4^3 p5 + 2 p0 p3 p4^3 p5 + 2 p0 p4^4 p5 + 234 p0^4 p5^2 + 732 p0^3 p1 p5^2 + 431 p0^2 p1^2 p5^2 - 100 p0 p1^3 p5^2 + 128 p1^4 p5^2 + 546 p0^3 p2 p5^2 + 632 p0^2 p1 p2 p5^2 - 404 p0 p1^2 p2 p5^2 + 80 p1^3 p2 p5^2 + 320 p0^2 p2^2 p5^2 - 176 p0 p1 p2^2 p5^2 - 4 p1^2 p2^2 p5^2 + 8 p0 p2^3 p5^2 + 432 p0^3 p3 p5^2 + 606 p0^2 p1 p3 p5^2 - 66 p0 p1^2 p3 p5^2 + 48 p1^3 p3 p5^2 + 468 p0^2 p2 p3 p5^2 - 108 p0 p1 p2 p3 p5^2 + 162 p0^2 p3^2 p5^2 + 375 p0^3 p4 p5^2 + 448 p0^2 p1 p4 p5^2 - 208 p0 p1^2 p4 p5^2 + 40 p1^3 p4 p5^2 + 392 p0^2 p2 p4 p5^2 - 176 p0 p1 p2 p4 p5^2 - 4 p1^2 p2 p4 p5^2 + 12 p0 p2^2 p4 p5^2 + 234 p0^2 p3 p4 p5^2 - 54 p0 p1 p3 p4 p5^2 + 116 p0^2 p4^2 p5^2 - 44 p0 p1 p4^2 p5^2 - p1^2 p4^2 p5^2 + 6 p0 p2 p4^2 p5^2 + p0 p4^3 p5^2 + 178 p0^3 p5^3 + 246 p0^2 p1 p5^3 - 24 p0 p1^2 p5^3 + 16 p1^3 p5^3 + 180 p0^2 p2 p5^3 - 36 p0 p1 p2 p5^3 + 108 p0^2 p3 p5^3 + 90 p0^2 p4 p5^3 - 18 p0 p1 p4 p5^3 + 27 p0^2 p5^4) (* Main Discriminant of ${\Cal P_{3.6}^{s0+}$: $\disc((X_{3,6}^{s0+})^{\circ}$ *) DiscMain[p0_,p1_,p2_,p3_,p4_,p5_] := (-233280 p0^6 p1 - 264384 p0^5 p1^2 - 191376 p0^4 p1^3 - 37044 p0^3 p1^4 - 63720 p0^2 p1^5 - 37624 p0 p1^6 - 13072 p1^7 - 419904 p0^6 p2 - 793152 p0^5 p1 p2 - 679104 p0^4 p1^2 p2 + 202608 p0^3 p1^3 p2 - 90648 p0^2 p1^4 p2 - 60504 p0 p1^5 p2 - 61196 p1^6 p2 - 419904 p0^5 p2^2 - 388800 p0^4 p1 p2^2 + 950400 p0^3 p1^2 p2^2 + 172512 p0^2 p1^3 p2^2 + 283920 p0 p1^4 p2^2 - 77296 p1^5 p2^2 + 139968 p0^4 p2^3 + 872640 p0^3 p1 p2^3 - 26496 p0^2 p1^2 p2^3 + 510656 p0 p1^3 p2^3 - 35136 p1^4 p2^3 + 171072 p0^3 p2^4 - 276480 p0^2 p1 p2^4 + 237696 p0 p1^2 p2^4 + 30976 p1^3 p2^4 - 31104 p0^2 p2^5 + 5760 p0 p1 p2^5 + 37952 p1^2 p2^5 - 20736 p0 p2^6 + 4864 p1 p2^6 + 4608 p2^7 - 186624 p0^6 p3 - 373248 p0^5 p1 p3 - 493776 p0^4 p1^2 p3 - 101088 p0^3 p1^3 p3 - 146556 p0^2 p1^4 p3 - 37098 p0 p1^5 p3 - 23060 p1^6 p3 - 466560 p0^5 p2 p3 - 917568 p0^4 p1 p2 p3 + 64800 p0^3 p1^2 p2 p3 - 477144 p0^2 p1^3 p2 p3 + 121932 p0 p1^4 p2 p3 - 59112 p1^5 p2 p3 - 171072 p0^4 p2^2 p3 + 518400 p0^3 p1 p2^2 p3 - 948672 p0^2 p1^2 p2^2 p3 + 310320 p0 p1^3 p2^2 p3 - 76632 p1^4 p2^2 p3 + 464832 p0^3 p2^3 p3 - 818208 p0^2 p1 p2^3 p3 + 77472 p0 p1^2 p2^3 p3 - 24000 p1^3 p2^3 p3 - 143424 p0^2 p2^4 p3 - 98208 p0 p1 p2^4 p3 - 6144 p1^2 p2^4 p3 - 576 p0 p2^5 p3 - 22656 p1 p2^5 p3 + 3200 p2^6 p3 - 139968 p0^5 p3^2 - 256608 p0^4 p1 p3^2 - 36936 p0^3 p1^2 p3^2 - 141912 p0^2 p1^3 p3^2 + 37125 p0 p1^4 p3^2 - 3348 p1^5 p3^2 - 81648 p0^4 p2 p3^2 + 229392 p0^3 p1 p2 p3^2 - 406296 p0^2 p1^2 p2 p3^2 + 151740 p0 p1^3 p2 p3^2 - 4509 p1^4 p2 p3^2 + 509328 p0^3 p2^2 p3^2 - 338256 p0^2 p1 p2^2 p3^2 + 3240 p0 p1^2 p2^2 p3^2 + 10224 p1^3 p2^2 p3^2 + 16848 p0^2 p2^3 p3^2 - 92880 p0 p1 p2^3 p3^2 - 1224 p1^2 p2^3 p3^2 + 49680 p0 p2^4 p3^2 - 18432 p1 p2^4 p3^2 - 720 p2^5 p3^2 + 11664 p0^4 p3^3 + 46656 p0^3 p1 p3^3 - 15552 p0^2 p1^2 p3^3 + 37908 p0 p1^3 p3^3 + 6939 p1^4 p3^3 + 209952 p0^3 p2 p3^3 + 60264 p0^2 p1 p2 p3^3 - 15552 p0 p1^2 p2 p3^3 + 16686 p1^3 p2 p3^3 + 167184 p0^2 p2^2 p3^3 - 49896 p0 p1 p2^2 p3^3 + 16632 p1^2 p2^2 p3^3 + 26784 p0 p2^3 p3^3 + 2376 p1 p2^3 p3^3 - 432 p2^4 p3^3 + 32076 p0^3 p3^4 + 37908 p0^2 p1 p3^4 - 9234 p0 p1^2 p3^4 + 1755 p1^3 p3^4 + 84564 p0^2 p2 p3^4 - 27216 p0 p1 p2 p3^4 + 5184 p1^2 p2 p3^4 - 5832 p0 p2^2 p3^4 + 1944 p1 p2^2 p3^4 + 108 p2^3 p3^4 + 8748 p0^2 p3^5 - 7290 p0 p1 p3^5 - 243 p1^2 p3^5 - 2916 p0 p2 p3^5 - 486 p1 p2 p3^5 + 729 p0 p3^6 - 186624 p0^6 p4 - 513216 p0^5 p1 p4 - 307152 p0^4 p1^2 p4 + 31104 p0^3 p1^3 p4 - 31860 p0^2 p1^4 p4 - 54810 p0 p1^5 p4 - 23942 p1^6 p4 - 606528 p0^5 p2 p4 - 497664 p0^4 p1 p2 p4 + 553824 p0^3 p1^2 p2 p4 + 241056 p0^2 p1^3 p2 p4 + 61812 p0 p1^4 p2 p4 - 55300 p1^5 p2 p4 + 62208 p0^4 p2^2 p4 + 946080 p0^3 p1 p2^2 p4 + 95472 p0^2 p1^2 p2^2 p4 + 329616 p0 p1^3 p2^2 p4 - 28296 p1^4 p2^2 p4 + 449280 p0^3 p2^3 p4 - 400896 p0^2 p1 p2^3 p4 + 240480 p0 p1^2 p2^3 p4 - 28512 p1^3 p2^3 p4 - 231552 p0^2 p2^4 p4 + 57312 p0 p1 p2^4 p4 - 29728 p1^2 p2^4 p4 + 37440 p0 p2^5 p4 - 1344 p1 p2^5 p4 - 1408 p2^6 p4 - 279936 p0^5 p3 p4 - 427680 p0^4 p1 p3 p4 - 138672 p0^3 p1^2 p3 p4 - 103032 p0^2 p1^3 p3 p4 + 16920 p0 p1^4 p3 p4 - 5925 p1^5 p3 p4 - 233280 p0^4 p2 p3 p4 + 51840 p0^3 p1 p2 p3 p4 - 578016 p0^2 p1^2 p2 p3 p4 + 105192 p0 p1^3 p2 p3 p4 + 16224 p1^4 p2 p3 p4 + 482112 p0^3 p2^2 p3 p4 - 727056 p0^2 p1 p2^2 p3 p4 + 32400 p0 p1^2 p2^2 p3 p4 - 12600 p1^3 p2^2 p3 p4 - 222912 p0^2 p2^3 p3 p4 - 29088 p0 p1 p2^3 p3 p4 - 19200 p1^2 p2^3 p3 p4 + 39744 p0 p2^4 p3 p4 + 8304 p1 p2^4 p3 p4 - 2304 p2^5 p3 p4 - 58320 p0^4 p3^2 p4 + 15552 p0^3 p1 p3^2 p4 - 85536 p0^2 p1^2 p3^2 p4 + 45252 p0 p1^3 p3^2 p4 + 19377 p1^4 p3^2 p4 + 303264 p0^3 p2 p3^2 p4 - 81648 p0^2 p1 p2 p3^2 p4 + 15552 p0 p1^2 p2 p3^2 p4 + 20520 p1^3 p2 p3^2 p4 + 132192 p0^2 p2^2 p3^2 p4 - 47952 p0 p1 p2^2 p3^2 p4 + 18252 p1^2 p2^2 p3^2 p4 - 5616 p0 p2^3 p3^2 p4 + 12816 p1 p2^3 p3^2 p4 + 58320 p0^3 p3^3 p4 + 29160 p0^2 p1 p3^3 p4 - 8748 p0 p1^2 p3^3 p4 + 1188 p1^3 p3^3 p4 + 139968 p0^2 p2 p3^3 p4 - 44712 p0 p1 p2 p3^3 p4 - 540 p1^2 p2 p3^3 p4 - 19440 p0 p2^2 p3^3 p4 - 1944 p1 p2^2 p3^3 p4 + 432 p2^3 p3^3 p4 + 26244 p0^2 p3^4 p4 - 12150 p0 p1 p3^4 p4 - 3321 p1^2 p3^4 p4 - 2592 p1 p2 p3^4 p4 + 2916 p0 p3^5 p4 + 243 p1 p3^5 p4 - 202176 p0^5 p4^2 - 247536 p0^4 p1 p4^2 + 56808 p0^3 p1^2 p4^2 + 43776 p0^2 p1^3 p4^2 - 15222 p0 p1^4 p4^2 - 15475 p1^5 p4^2 - 176256 p0^4 p2 p4^2 + 185328 p0^3 p1 p2 p4^2 + 50976 p0^2 p1^2 p2 p4^2 + 52176 p0 p1^3 p2 p4^2 - 16629 p1^4 p2 p4^2 + 280800 p0^3 p2^2 p4^2 - 103248 p0^2 p1 p2^2 p4^2 + 39960 p0 p1^2 p2^2 p4^2 - 10160 p1^3 p2^2 p4^2 - 123408 p0^2 p2^3 p4^2 + 8736 p0 p1 p2^3 p4^2 - 8776 p1^2 p2^3 p4^2 + 27264 p0 p2^4 p4^2 - 3024 p1 p2^4 p4^2 - 2768 p2^5 p4^2 - 120528 p0^4 p3 p4^2 - 119232 p0^3 p1 p3 p4^2 - 119880 p0^2 p1^2 p3 p4^2 + 19260 p0 p1^3 p3 p4^2 + 13155 p1^4 p3 p4^2 + 95904 p0^3 p2 p3 p4^2 - 193752 p0^2 p1 p2 p3 p4^2 - 28080 p0 p1^2 p2 p3 p4^2 + 19236 p1^3 p2 p3 p4^2 + 3888 p0^2 p2^2 p3 p4^2 - 21600 p0 p1 p2^2 p3 p4^2 + 9504 p1^2 p2^2 p3 p4^2 + 6624 p0 p2^3 p3 p4^2 + 3984 p1 p2^3 p3 p4^2 - 816 p2^4 p3 p4^2 + 29160 p0^3 p3^2 p4^2 + 13608 p0^2 p1 p3^2 p4^2 - 2430 p0 p1^2 p3^2 p4^2 + 4698 p1^3 p3^2 p4^2 + 126360 p0^2 p2 p3^2 p4^2 - 17172 p0 p1 p2 p3^2 p4^2 - 648 p1^2 p2 p3^2 p4^2 - 14256 p0 p2^2 p3^2 p4^2 + 648 p1 p2^2 p3^2 p4^2 + 1296 p2^3 p3^2 p4^2 + 31104 p0^2 p3^3 p4^2 - 13284 p0 p1 p3^3 p4^2 - 5076 p1^2 p3^3 p4^2 + 648 p0 p2 p3^3 p4^2 - 1134 p1 p2 p3^3 p4^2 + 216 p2^2 p3^3 p4^2 + 4860 p0 p3^4 p4^2 + 810 p1 p3^4 p4^2 - 81 p2 p3^4 p4^2 - 85104 p0^4 p4^3 - 42336 p0^3 p1 p4^3 + 12456 p0^2 p1^2 p4^3 + 2972 p0 p1^3 p4^3 - 2888 p1^4 p4^3 + 20736 p0^3 p2 p4^3 + 3744 p0^2 p1 p2 p4^3 - 2424 p0 p1^2 p2 p4^3 + 4124 p1^3 p2 p4^3 + 24336 p0^2 p2^2 p4^3 - 6528 p0 p1 p2^2 p4^3 + 5472 p1^2 p2^2 p4^3 - 10528 p0 p2^3 p4^3 + 1168 p1 p2^3 p4^3 + 1088 p2^4 p4^3 - 12528 p0^3 p3 p4^3 - 26568 p0^2 p1 p3 p4^3 - 4896 p0 p1^2 p3 p4^3 + 8882 p1^3 p3 p4^3 + 40176 p0^2 p2 p3 p4^3 - 13896 p0 p1 p2 p3 p4^3 + 2076 p1^2 p2 p3 p4^3 - 10944 p0 p2^2 p3 p4^3 - 840 p1 p2^2 p3 p4^3 + 944 p2^3 p3 p4^3 + 18144 p0^2 p3^2 p4^3 - 6804 p0 p1 p3^2 p4^3 - 5526 p1^2 p3^2 p4^3 + 4536 p0 p2 p3^2 p4^3 - 1764 p1 p2 p3^2 p4^3 - 612 p2^2 p3^2 p4^3 + 4644 p0 p3^3 p4^3 + 756 p1 p3^3 p4^3 - 324 p2 p3^3 p4^3 + 27 p3^4 p4^3 - 17172 p0^3 p4^4 - 4104 p0^2 p1 p4^4 + 3060 p0 p1^2 p4^4 + 1206 p1^3 p4^4 + 12744 p0^2 p2 p4^4 - 1656 p0 p1 p2 p4^4 - 306 p1^2 p2 p4^4 - 3096 p0 p2^2 p4^4 + 144 p1 p2^2 p4^4 + 360 p2^3 p4^4 + 2916 p0^2 p3 p4^4 - 5778 p0 p1 p3 p4^4 - 1530 p1^2 p3 p4^4 + 1188 p0 p2 p3 p4^4 + 180 p1 p2 p3 p4^4 - 72 p2^2 p3 p4^4 + 2673 p0 p3^2 p4^4 + 270 p1 p3^2 p4^4 - 135 p2 p3^2 p4^4 + 81 p3^3 p4^4 - 1620 p0^2 p4^5 - 594 p0 p1 p4^5 + 54 p1^2 p4^5 + 1188 p0 p2 p4^5 - 216 p2^2 p4^5 + 648 p0 p3 p4^5 - 189 p1 p3 p4^5 - 108 p2 p3 p4^5 + 81 p3^2 p4^5 - 54 p0 p4^6 - 27 p1 p4^6 + 27 p2 p4^6 + 27 p3 p4^6 - 233280 p0^6 p5 - 995328 p0^5 p1 p5 - 918864 p0^4 p1^2 p5 - 115992 p0^3 p1^3 p5 - 182844 p0^2 p1^4 p5 - 142560 p0 p1^5 p5 - 65882 p1^6 p5 - 1353024 p0^5 p2 p5 - 1816992 p0^4 p1 p2 p5 + 707616 p0^3 p1^2 p2 p5 + 118872 p0^2 p1^3 p2 p5 + 121488 p0 p1^4 p2 p5 - 176460 p1^5 p2 p5 - 295488 p0^4 p2^2 p5 + 2206656 p0^3 p1 p2^2 p5 + 326160 p0^2 p1^2 p2^2 p5 + 1030560 p0 p1^3 p2^2 p5 - 92432 p1^4 p2^2 p5 + 1090368 p0^3 p2^3 p5 - 696672 p0^2 p1 p2^3 p5 + 709248 p0 p1^2 p2^3 p5 + 20384 p1^3 p2^3 p5 - 349056 p0^2 p2^4 p5 + 59520 p0 p1 p2^4 p5 + 54624 p1^2 p2^4 p5 + 2304 p0 p2^5 p5 + 2368 p1 p2^5 p5 + 7168 p2^6 p5 - 653184 p0^5 p3 p5 - 1244160 p0^4 p1 p3 p5 - 452952 p0^3 p1^2 p3 p5 - 508140 p0^2 p1^3 p3 p5 - 37800 p0 p1^4 p3 p5 - 57639 p1^5 p3 p5 - 940896 p0^4 p2 p3 p5 + 369360 p0^3 p1 p2 p3 p5 - 1448280 p0^2 p1^2 p2 p3 p5 + 336960 p0 p1^3 p2 p3 p5 - 69810 p1^4 p2 p3 p5 + 1280448 p0^3 p2^2 p3 p5 - 1713312 p0^2 p1 p2^2 p3 p5 + 136080 p0 p1^2 p2^2 p3 p5 - 59208 p1^3 p2^2 p3 p5 - 411264 p0^2 p2^3 p3 p5 - 301248 p0 p1 p2^3 p3 p5 - 7632 p1^2 p2^3 p3 p5 + 27072 p0 p2^4 p3 p5 - 41904 p1 p2^4 p3 p5 + 3552 p2^5 p3 p5 - 303264 p0^4 p3^2 p5 - 1944 p0^3 p1 p3^2 p5 - 337284 p0^2 p1^2 p3^2 p5 + 107622 p0 p1^3 p3^2 p5 + 17019 p1^4 p3^2 p5 + 773712 p0^3 p2 p3^2 p5 - 338256 p0^2 p1 p2 p3^2 p5 + 83592 p0 p1^2 p2 p3^2 p5 + 32490 p1^3 p2 p3^2 p5 + 314928 p0^2 p2^2 p3^2 p5 - 250128 p0 p1 p2^2 p3^2 p5 + 34236 p1^2 p2^2 p3^2 p5 + 66960 p0 p2^3 p3^2 p5 - 18936 p1 p2^3 p3^2 p5 - 576 p2^4 p3^2 p5 + 169128 p0^3 p3^3 p5 + 88452 p0^2 p1 p3^3 p5 + 27054 p0 p1^2 p3^3 p5 + 14661 p1^3 p3^3 p5 + 392688 p0^2 p2 p3^3 p5 - 100116 p0 p1 p2 p3^3 p5 + 20250 p1^2 p2 p3^3 p5 + 25920 p0 p2^2 p3^3 p5 + 3132 p1 p2^2 p3^3 p5 - 216 p2^3 p3^3 p5 + 90396 p0^2 p3^4 p5 - 22842 p0 p1 p3^4 p5 - 324 p1^2 p3^4 p5 - 3888 p0 p2 p3^4 p5 + 810 p1 p2 p3^4 p5 - 1458 p0 p3^5 p5 - 730944 p0^5 p4 p5 - 1192320 p0^4 p1 p4 p5 + 70632 p0^3 p1^2 p4 p5 + 67032 p0^2 p1^3 p4 p5 - 90570 p0 p1^4 p4 p5 - 83655 p1^5 p4 p5 - 764640 p0^4 p2 p4 p5 + 1296000 p0^3 p1 p2 p4 p5 + 410616 p0^2 p1^2 p2 p4 p5 + 417048 p0 p1^3 p2 p4 p5 - 88194 p1^4 p2 p4 p5 + 1419552 p0^3 p2^2 p4 p5 - 427248 p0^2 p1 p2^2 p4 p5 + 525456 p0 p1^2 p2^2 p4 p5 - 34360 p1^3 p2^2 p4 p5 - 615744 p0^2 p2^3 p4 p5 + 76128 p0 p1 p2^3 p4 p5 - 61392 p1^2 p2^3 p4 p5 + 95712 p0 p2^4 p4 p5 + 4368 p1 p2^4 p4 p5 - 3616 p2^5 p4 p5 - 567648 p0^4 p3 p4 p5 - 259200 p0^3 p1 p3 p4 p5 - 547236 p0^2 p1^2 p3 p4 p5 + 66816 p0 p1^3 p3 p4 p5 + 26313 p1^4 p3 p4 p5 + 664848 p0^3 p2 p3 p4 p5 - 1108080 p0^2 p1 p2 p3 p4 p5 + 12096 p0 p1^2 p2 p3 p4 p5 + 46872 p1^3 p2 p3 p4 p5 - 321408 p0^2 p2^2 p3 p4 p5 - 128736 p0 p1 p2^2 p3 p4 p5 - 26928 p1^2 p2^2 p3 p4 p5 + 41760 p0 p2^3 p3 p4 p5 + 24000 p1 p2^3 p3 p4 p5 - 3600 p2^4 p3 p4 p5 + 169128 p0^3 p3^2 p4 p5 - 36936 p0^2 p1 p3^2 p4 p5 + 46818 p0 p1^2 p3^2 p4 p5 + 32940 p1^3 p3^2 p4 p5 + 373248 p0^2 p2 p3^2 p4 p5 - 47304 p0 p1 p2 p3^2 p4 p5 + 5346 p1^2 p2 p3^2 p4 p5 - 38880 p0 p2^2 p3^2 p4 p5 + 15336 p1 p2^2 p3^2 p4 p5 + 216 p2^3 p3^2 p4 p5 + 140940 p0^2 p3^3 p4 p5 - 33696 p0 p1 p3^3 p4 p5 - 11097 p1^2 p3^3 p4 p5 - 21060 p0 p2 p3^3 p4 p5 - 4212 p1 p2 p3^3 p4 p5 + 108 p2^2 p3^3 p4 p5 + 3888 p0 p3^4 p4 p5 - 405 p1 p3^4 p4 p5 - 392688 p0^4 p4^2 p5 - 87048 p0^3 p1 p4^2 p5 + 78192 p0^2 p1^2 p4^2 p5 + 6552 p0 p1^3 p4^2 p5 - 33508 p1^4 p4^2 p5 + 311904 p0^3 p2 p4^2 p5 + 9288 p0^2 p1 p2 p4^2 p5 + 57960 p0 p1^2 p2 p4^2 p5 - 1052 p1^3 p2 p4^2 p5 - 98064 p0^2 p2^2 p4^2 p5 - 5904 p0 p1 p2^2 p4^2 p5 - 2520 p1^2 p2^2 p4^2 p5 + 19584 p0 p2^3 p4^2 p5 - 4912 p1 p2^3 p4^2 p5 - 2336 p2^4 p4^2 p5 - 52488 p0^3 p3 p4^2 p5 - 232308 p0^2 p1 p3 p4^2 p5 - 30024 p0 p1^2 p3 p4^2 p5 + 43110 p1^3 p3 p4^2 p5 + 57672 p0^2 p2 p3 p4^2 p5 - 54864 p0 p1 p2 p3 p4^2 p5 + 8712 p1^2 p2 p3 p4^2 p5 - 3456 p0 p2^2 p3 p4^2 p5 + 1224 p1 p2^2 p3 p4^2 p5 + 576 p2^3 p3 p4^2 p5 + 113724 p0^2 p3^2 p4^2 p5 - 1782 p0 p1 p3^2 p4^2 p5 - 14256 p1^2 p3^2 p4^2 p5 + 3888 p0 p2 p3^2 p4^2 p5 - 1134 p1 p2 p3^2 p4^2 p5 + 972 p2^2 p3^2 p4^2 p5 + 5346 p0 p3^3 p4^2 p5 + 1323 p1 p3^3 p4^2 p5 + 54 p2 p3^3 p4^2 p5 - 67176 p0^3 p4^3 p5 - 21960 p0^2 p1 p4^3 p5 + 7188 p0 p1^2 p4^3 p5 + 1578 p1^3 p4^3 p5 + 57960 p0^2 p2 p4^3 p5 + 552 p0 p1 p2 p4^3 p5 + 3720 p1^2 p2 p4^3 p5 - 16896 p0 p2^2 p4^3 p5 + 744 p1 p2^2 p4^3 p5 + 1248 p2^3 p4^3 p5 + 18468 p0^2 p3 p4^3 p5 - 19296 p0 p1 p3 p4^3 p5 + 1050 p1^2 p3 p4^3 p5 - 5904 p0 p2 p3 p4^3 p5 + 48 p1 p2 p3 p4^3 p5 + 240 p2^2 p3 p4^3 p5 + 7614 p0 p3^2 p4^3 p5 - 900 p1 p3^2 p4^3 p5 - 846 p2 p3^2 p4^3 p5 - 27 p3^3 p4^3 p5 - 2484 p0^2 p4^4 p5 - 1656 p0 p1 p4^4 p5 + 630 p1^2 p4^4 p5 + 936 p0 p2 p4^4 p5 + 216 p1 p2 p4^4 p5 + 72 p2^2 p4^4 p5 + 864 p0 p3 p4^4 p5 - 711 p1 p3 p4^4 p5 + 18 p2 p3 p4^4 p5 + 189 p3^2 p4^4 p5 + 54 p0 p4^5 p5 - 27 p1 p4^5 p5 - 54 p2 p4^5 p5 - 27 p3 p4^5 p5 - 606528 p0^5 p5^2 - 1411344 p0^4 p1 p5^2 - 249264 p0^3 p1^2 p5^2 - 134964 p0^2 p1^3 p5^2 - 127389 p0 p1^4 p5^2 - 105686 p1^5 p5^2 - 1181952 p0^4 p2 p5^2 + 1025568 p0^3 p1 p2 p5^2 + 243432 p0^2 p1^2 p2 p5^2 + 514932 p0 p1^3 p2 p5^2 - 110770 p1^4 p2 p5^2 + 1546128 p0^3 p2^2 p5^2 - 250560 p0^2 p1 p2^2 p5^2 + 723888 p0 p1^2 p2^2 p5^2 + 19608 p1^3 p2^2 p5^2 - 521856 p0^2 p2^3 p5^2 - 720 p0 p1 p2^3 p5^2 + 9808 p1^2 p2^3 p5^2 + 45072 p0 p2^4 p5^2 - 256 p1 p2^4 p5^2 + 2784 p2^5 p5^2 - 781488 p0^4 p3 p5^2 - 352512 p0^3 p1 p3 p5^2 - 738072 p0^2 p1^2 p3 p5^2 + 5688 p0 p1^3 p3 p5^2 - 15981 p1^4 p3 p5^2 + 813888 p0^3 p2 p3 p5^2 - 1081512 p0^2 p1 p2 p3 p5^2 + 34344 p0 p1^2 p2 p3 p5^2 + 16734 p1^3 p2 p3 p5^2 - 242352 p0^2 p2^2 p3 p5^2 - 338904 p0 p1 p2^2 p3 p5^2 - 15192 p1^2 p2^2 p3 p5^2 + 29376 p0 p2^3 p3 p5^2 - 16248 p1 p2^3 p3 p5^2 + 528 p2^4 p3 p5^2 + 159408 p0^3 p3^2 p5^2 - 78732 p0^2 p1 p3^2 p5^2 + 54918 p0 p1^2 p3^2 p5^2 + 31635 p1^3 p3^2 p5^2 + 472392 p0^2 p2 p3^2 p5^2 - 113076 p0 p1 p2 p3^2 p5^2 + 20358 p1^2 p2 p3^2 p5^2 + 16848 p0 p2^2 p3^2 p5^2 - 1188 p1 p2^2 p3^2 p5^2 + 144 p2^3 p3^2 p5^2 + 202176 p0^2 p3^3 p5^2 - 16848 p0 p1 p3^3 p5^2 + 702 p1^2 p3^3 p5^2 + 2592 p0 p2 p3^3 p5^2 - 540 p1 p2 p3^3 p5^2 + 1215 p0 p3^4 p5^2 - 760752 p0^4 p4 p5^2 - 101952 p0^3 p1 p4 p5^2 + 84348 p0^2 p1^2 p4 p5^2 + 24108 p0 p1^3 p4 p5^2 - 81952 p1^4 p4 p5^2 + 934416 p0^3 p2 p4 p5^2 + 97200 p0^2 p1 p2 p4 p5^2 + 337680 p0 p1^2 p2 p4 p5^2 - 6636 p1^3 p2 p4 p5^2 - 389664 p0^2 p2^2 p4 p5^2 + 29664 p0 p1 p2^2 p4 p5^2 - 33372 p1^2 p2^2 p4 p5^2 + 61008 p0 p2^3 p4 p5^2 + 7712 p1 p2^3 p4 p5^2 - 2256 p2^4 p4 p5^2 + 66096 p0^3 p3 p4 p5^2 - 490536 p0^2 p1 p3 p4 p5^2 - 40608 p0 p1^2 p3 p4 p5^2 + 60048 p1^3 p3 p4 p5^2 - 89424 p0^2 p2 p3 p4 p5^2 - 87048 p0 p1 p2 p3 p4 p5^2 - 11484 p1^2 p2 p3 p4 p5^2 - 7776 p0 p2^2 p3 p4 p5^2 + 13320 p1 p2^2 p3 p4 p5^2 - 1584 p2^3 p3 p4 p5^2 + 185652 p0^2 p3^2 p4 p5^2 + 32076 p0 p1 p3^2 p4 p5^2 - 11637 p1^2 p3^2 p4 p5^2 - 23652 p0 p2 p3^2 p4 p5^2 + 2700 p1 p2 p3^2 p4 p5^2 - 108 p2^2 p3^2 p4 p5^2 - 5508 p0 p3^3 p4 p5^2 + 270 p1 p3^3 p4 p5^2 - 40176 p0^3 p4^2 p5^2 - 34236 p0^2 p1 p4^2 p5^2 + 9846 p0 p1^2 p4^2 p5^2 - 10374 p1^3 p4^2 p5^2 + 32184 p0^2 p2 p4^2 p5^2 + 26676 p0 p1 p2 p4^2 p5^2 + 5610 p1^2 p2 p4^2 p5^2 - 5256 p0 p2^2 p4^2 p5^2 - 5952 p1 p2^2 p4^2 p5^2 + 312 p2^3 p4^2 p5^2 + 3240 p0^2 p3 p4^2 p5^2 - 31320 p0 p1 p3 p4^2 p5^2 + 9036 p1^2 p3 p4^2 p5^2 - 3456 p0 p2 p3 p4^2 p5^2 - 2646 p1 p2 p3 p4^2 p5^2 + 1224 p2^2 p3 p4^2 p5^2 + 12798 p0 p3^2 p4^2 p5^2 - 1053 p1 p3^2 p4^2 p5^2 + 3492 p0^2 p4^3 p5^2 - 1884 p0 p1 p4^3 p5^2 + 372 p1^2 p4^3 p5^2 - 2424 p0 p2 p4^3 p5^2 + 936 p1 p2 p4^3 p5^2 - 12 p2^2 p4^3 p5^2 - 792 p0 p3 p4^3 p5^2 + 24 p1 p3 p4^3 p5^2 - 300 p2 p3 p4^3 p5^2 + 9 p3^2 p4^3 p5^2 + 63 p0 p4^4 p5^2 + 72 p1 p4^4 p5^2 + 36 p2 p4^4 p5^2 + 9 p3 p4^4 p5^2 - 511056 p0^4 p5^3 - 187272 p0^3 p1 p5^3 - 71676 p0^2 p1^2 p5^3 + 7422 p0 p1^3 p5^3 - 53818 p1^4 p5^3 + 568080 p0^3 p2 p5^3 + 69264 p0^2 p1 p2 p5^3 + 259776 p0 p1^2 p2 p5^3 + 19570 p1^3 p2 p5^3 - 205344 p0^2 p2^2 p5^3 - 44016 p0 p1 p2^2 p5^3 - 7780 p1^2 p2^2 p5^3 + 23248 p0 p2^3 p5^3 + 520 p1 p2^3 p5^3 + 336 p2^4 p5^3 + 42552 p0^3 p3 p5^3 - 297540 p0^2 p1 p3 p5^3 - 44262 p0 p1^2 p3 p5^3 + 28195 p1^3 p3 p5^3 + 31536 p0^2 p2 p3 p5^3 - 108828 p0 p1 p2 p3 p5^3 - 5538 p1^2 p2 p3 p5^3 + 4320 p0 p2^2 p3 p5^3 - 540 p1 p2^2 p3 p5^3 - 40 p2^3 p3 p5^3 + 154224 p0^2 p3^2 p5^3 + 17280 p0 p1 p3^2 p5^3 - 396 p1^2 p3^2 p5^3 + 1080 p0 p2 p3^2 p5^3 + 180 p1 p2 p3^2 p5^3 - 540 p0 p3^3 p5^3 + 50328 p0^3 p4 p5^3 - 31752 p0^2 p1 p4 p5^3 + 26154 p0 p1^2 p4 p5^3 - 13460 p1^3 p4 p5^3 - 40176 p0^2 p2 p4 p5^3 + 35928 p0 p1 p2 p4 p5^3 + 1310 p1^2 p2 p4 p5^3 + 7632 p0 p2^2 p4 p5^3 + 408 p1 p2^2 p4 p5^3 - 376 p2^3 p4 p5^3 + 324 p0^2 p3 p4 p5^3 - 20016 p0 p1 p3 p4 p5^3 + 4173 p1^2 p3 p4 p5^3 - 12204 p0 p2 p3 p4 p5^3 - 12 p1 p2 p3 p4 p5^3 + 36 p2^2 p3 p4 p5^3 + 1836 p0 p3^2 p4 p5^3 - 90 p1 p3^2 p4 p5^3 + 2628 p0^2 p4^2 p5^3 + 1410 p0 p1 p4^2 p5^3 - 1078 p1^2 p4^2 p5^3 + 696 p0 p2 p4^2 p5^3 - 246 p1 p2 p4^2 p5^3 + 124 p2^2 p4^2 p5^3 + 630 p0 p3 p4^2 p5^3 + 141 p1 p3 p4^2 p5^3 - 6 p2 p3 p4^2 p5^3 - 106 p0 p4^3 p5^3 - 44 p1 p4^3 p5^3 - 10 p2 p4^3 p5^3 - p3 p4^3 p5^3 + 31428 p0^3 p5^4 - 24120 p0^2 p1 p5^4 + 9708 p0 p1^2 p5^4 + 2074 p1^3 p5^4 - 20268 p0^2 p2 p5^4 - 9324 p0 p1 p2 p5^4 - 1230 p1^2 p2 p5^4 + 3576 p0 p2^2 p5^4 + 172 p1 p2^2 p5^4 + 4 p2^3 p5^4 + 25812 p0^2 p3 p5^4 - 2070 p0 p1 p3 p5^4 + 93 p1^2 p3 p5^4 - 828 p0 p2 p3 p5^4 - 30 p1 p2 p3 p5^4 + 135 p0 p3^2 p5^4 - 2952 p0^2 p4 p5^4 + 618 p0 p1 p4 p5^4 + 354 p1^2 p4 p5^4 - 300 p0 p2 p4 p5^4 - 108 p1 p2 p4 p5^4 - 4 p2^2 p4 p5^4 - 144 p0 p3 p4 p5^4 + 15 p1 p3 p4 p5^4 + 54 p0 p4^2 p5^4 + 11 p1 p4^2 p5^4 + p2 p4^2 p5^4 + 612 p0^2 p5^5 - 294 p0 p1 p5^5 - 8 p1^2 p5^5 + 120 p0 p2 p5^5 + 2 p1 p2 p5^5 - 18 p0 p3 p5^5 - 12 p0 p4 p5^5 - p1 p4 p5^5 + p0 p5^6) (* Fig. 4.14 *) ContourPlot[D3[1,q,r] == 0, {q,0,1/3}, {r,0,1/27}] (* q = -(t-9)(5t-9)/(12 t^2), r = (t-9)^2(4t-9)/(108 t^3) *) ParametricPlot[{-(t-9)(5t-9)/(12 t^2), 9 ((t-9)^2(4t-9)/(108 t^3))}, {t,9/5,9}, PlotRange->{{0,1/3},{0,1/3}}] (*============ Section 5: $\P_{\R}^3/{\frak S}_4$, $\P_+^3/{\frak S}_4$ ================*) (* Proposition 5.3 *) s1[a_,b_,c_,d_]:=a+b+c+d s2[a_,b_,c_,d_]:=a b+a c+a d+b c+b d+c d s3[a_,b_,c_,d_]:=b c d + a c d + a b d + a b c s4[a_,b_,c_,d_]:=a b c d (* 3 s1^2 - 8 s2 = \sum (a-b)^2 \geq 0. s2/s1^2 \leq 3/8 s3/s1^3 \leq 1/16, s4/s1^4 \leq 1/256 *) F[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) Factor[F[s1[s,t,1,1],s2[s,t,1,1],s3[s,t,1,1],s4[s,t,1,1]]] (* = 0 *) Expand[((a-b)(a-c)(a-d)(b-c)(b-d)(c-d))^2 - F[s1[a,b,c,d],s2[a,b,c,d],s3[a,b,c,d],s4[a,b,c,d]]] 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[F[1,x,y,z]==0,{x,0,3/8},{y,0,1/16},{z,0,1/256}] ContourPlot3D[F[1,x,y,z]==0,{x,-2,3/8},{y,-2,1/4},{z,-1/2,2}] ContourPlot3D[F[1,x,y,z]==0,{x,-1,3/8},{y,-1,1/4},{z,-1/5,1}] ContourPlot3D[{F[1,x,y,z]==0, G[1,x,y,z]==0},{x,0,3/8},{y,0,1/16},{z,0,1/256}] ContourPlot3D[{F[1,x,y,z]==0, G[1,x,y,z]==0},{x,-2,3/8},{y,-2,1/4},{z,-1/2,2}] ContourPlot3D[{F[1,x,y,z]==0, G[1,x,y,z]==0},{x,-1,3/8},{y,-1,1/4},{z,-1/5,1}] Show[ ParametricPlot3D[{s2[s,t,1,1]/s1[s,t,1,1]^2, s3[s,t,1,1]/s1[s,t,1,1]^3, s4[s,t,1,1]/s1[s,t,1,1]^4},{s,-4,5},{t,-4,5}], ParametricPlot3D[{s2[s,1,1,1]/s1[s,1,1,1]^2, s3[s,1,1,1]/s1[s,1,1,1]^3, s4[s,1,1,1]/s1[s,1,1,1]^4}, {s,-40,40}], ParametricPlot3D[{s2[s,s,1,1]/s1[s,s,1,1]^2, s3[s,s,1,1]/s1[s,s,1,1]^3, s4[s,s,1,1]/s1[s,s,1,1]^4}, {s,-1,1}], PlotRange -> {{-2, 3/8}, {-2, 1/4}, {-1/2, 2}}] 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}}] (* $\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}] (*============ The PSD Cone {\Cal P}_{4,4}^{s0+}$ ===========================*) (* Theorem 5.4. *) 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) 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 U[x0_,x1_,x2_,x3_]:=x0 x1 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] 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] FrakGinf[a_,b_,c_,d_] := s2[a,b,c,d] (* Lemma 5.5. *) 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 (3 S2[a,b,c,d] - 2 S11[a,b,c,d])^2)] g2[x0_,x1_,x2_,x3_] := (x1-x3)^2 + 2x_2^2 - 3x2 x0 (* Lemma 5.6. *) b2[a1_,a2_,a3_] := (1/2)((a1-a2)^2+(a2-a3)^2+(a3-a1)^2) T21[a_,b_,c_] := (a^2b + b^2c + c^2a)+(a b^2 + b c^2 + c a^2) b3[a1_,a2_,a3_] := T21[a1,a2,a3] - 6 a1 a2 a3 Factor[(s2[a0,a1,a2,a3]-s3[a0,a1,a2,a3]) - (b2[a1,a2,a3] (a0 - b3[a1,a2,a3]/(2 b2[a1,a2,a3]))^2 + 3(a1-a2)^2(a2-a3)^2(a3-a1)^2/(4 b2[a1,a2,a3]))] (* Lemma 5.7. *) Factor[f44s0[(x1^2+2x2^2-2x1 x3+x3^2)/(3 x2),x1,x2,x3]] (* Lemma 5.9. *) 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] FrakGinf[a_,b_,c_,d_] := s2[a,b,c,d] (* Theorem 5.11. *) Ftab[a_,b_,c_,d_,t_] := 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] Ftc[a_,b_,c_,d_,t_] := 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] (* Lemma 5.13. *) 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 5.14. *) t1[u_] := (3u^2-u+3)/u f4[x0_,x1_,x2_,x3_] := 3 x0 x2 - 3 x1^2 + 6 x2^2 + 6 x0 x3 + 6 x1 x3 + 4 x2 x3 - 19 x3^2 (* Lemma 5.14(1). *) Factor[f4[s0[t,1,1,1] + 20 v, s1[t,1,1,1] + 3 v, s2[t,1,1,1] - 6 v, s3[t,1,1,1] + 3v]] (* = 0 *) Factor[f4[s0[0,0,u,1] + 20 v, s1[0,0,u,1] + 3 v, s2[0,0,u,1] - 6 v, s3[0,0,u,1] + 3v]] (* = 0 *) (* Lemma 5.14(2). *) g[a_,b_,c_,d_] := 2c(3a+d)(a-b)^2(a-c)^2(b-d)^2 + (20/3)d^2 (a-b)^2(a-c)^2(b-c)^2 gs[a_,b_,c_,d_] := (g[a,b,c,d] + g[a,b,d,c] + g[a,c,b,d] + g[a,c,d,b] + g[a,d,b,c] + g[a,d,c,b] + g[b,a,c,d] + g[b,a,d,c] + g[b,c,a,d] + g[b,c,d,a] + g[b,d,a,c] + g[b,d,c,a] + g[c,a,b,d] + g[c,a,d,b] + g[c,b,a,d] + g[c,b,d,a] + g[c,d,a,b] + g[c,d,b,a] + g[d,a,b,c] + g[d,a,c,b] + g[d,b,a,c] + g[d,b,c,a] + g[d,c,a,b] + g[d,c,b,a]) Expand[f4[s0[a,b,c,d], s1[a,b,c,d], s2[a,b,c,d], s3[a,b,c,d]] - gs[a,b,c,d]] (* Cf. *) Factor[f4[s0[a,b,1,1], s1[a,b,1,1], s2[a,b,1,1], s3[a,b,1,1]]] (* = 8 (a-1)^2 (b-1)^2 (4 a + 8 a^2 + 3 a^3 + 4 b + a^2 b + 8 b^2 + a b^2 + 3 b^3 -32a b) *) Factor[f4[s0[0,s,1,1], s1[0,s,1,1], s2[0,s,1,1], s3[0,s,1,1]]] (* = 8 (-1 + s)^2 s (2 + s) (2 + 3 s) *) Factor[f4[s0[0,a,b,c], s1[0,a,b,c], s2[0,a,b,c], s3[0,a,b,c]]] (* = 4 a b (1 + a + b) (3 T31[0,a,b,c] - 2 S22[0,a,b,c] - 4 T211[0,a,b,c]) *) (* Lemma 5.15. *) f5[x0_,x1_,x2_,x3_] := 3 x0 x3 - x1^2 + 4 x1 x2 - 4 x2^2 - 2 x1 x3 - 2 x2 x3 + 3 x3^2 (* Lemma 5.15(1). *) Factor[f5[s0[t,1,1,1] v + 2(1-v), s1[t,1,1,1] v + 2(1-v), s2[t,1,1,1] v + (1-v), s3[t,1,1,1] v]] (* = 0 *) (* Lemma 3.15(3). *) Factor[f44s0[s0[t,1,1,1] v + 2(1-v), s1[t,1,1,1] v + 2(1-v), s2[t,1,1,1] v + (1-v), s3[t,1,1,1] v]] (* = -(1-t)^6 (1-v)^2 v^2 (16(9-t)(3+5t) + v(243-402t-1603t^2-252t^3+1101t^4-114t^5+3t^6)) alpha[t_]:=(243 - 402t - 1603t^2 - 252t^3 + 1101t^4 - 114t^5 + 3t^6) *) Plot[16(-9+t)(3+5t)/alpha[t] - 1, {t, 0, 5}] Factor[1 - (16(-9+t)(3+5t)/alpha[t])] (* = 3(t-1)^2(t^2-18t-15)^2 / alpha[t] *) Factor[G3[s0[t,1,1,1] v + 2(1-v), s1[t,1,1,1] v + 2(1-v), s2[t,1,1,1] v + (1-v), s3[t,1,1,1] v]] (* = -(1-t)^3 v ((9-t) + v(-9-35t+36t^2)) *) Factor[G4[s0[t,1,1,1] v + 2(1-v), s1[t,1,1,1] v + 2(1-v), s2[t,1,1,1] v + (1-v), s3[t,1,1,1] v]] (* = (1-t)^3 t v (4(1-v) + 9 v t(1-t)) \geq 0 *) f[t_, v_] := G4[s0[t,1,1,1] v + 2(1-v), s1[t,1,1,1] v + 2(1-v), s2[t,1,1,1] v + (1-v), s3[t,1,1,1] v] Factor[f[t,(-9+t)/(-9-35t+36t^2)]] (* = (9(25-t)(9-t)(1-st^4 t^2)/(-9-35t+36t^2)^2 \geq 0 交点は X_4^{s0+} の外部 *) (* Lemma 5.16. *) Factor[s1[a,b,c,d]-2 s2[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)] (* = 0 *) (* How to obtain Ftab[a_,b_,c_,d_,t_] *) D[f5[x0, x1, x2, x3], x0] hv0[x0_, x1_, x2_, x3_] := 3 x3 Factor[hv0[s0[t,1,1,1], s1[t,1,1,1], s2[t,1,1,1], s3[t,1,1,1]]] (* = 9(t-1)^2 *) D[f5[x0, x1, x2, x3], x1] hv1[x0_, x1_, x2_, x3_] := - 2 x1 + 4 x2 - 2 x3 Factor[hv1[s0[t,1,1,1], s1[t,1,1,1], s2[t,1,1,1], s3[t,1,1,1]]] (* = -6(t-1)^2(t+1) *) D[f5[x0, x1, x2, x3], x2] hv2[x0_, x1_, x2_, x3_] := 4 x1 - 8 x2 - 2 x3 Factor[hv2[s0[t,1,1,1], s1[t,1,1,1], s2[t,1,1,1], s3[t,1,1,1]]] (* = 6(t-1)^2(2t-1) *) D[f5[x0, x1, x2, x3], x3] hv3[x0_, x1_, x2_, x3_] := 3 x0 - 2 x1 - 2 x2 + 6 x3 Factor[hv3[s0[t,1,1,1], s1[t,1,1,1], s2[t,1,1,1], s3[t,1,1,1]]] (* = 3 (t-1)^2 (3+t^2) *) (* (9(t-1)^2 : -6(t-1)^2 (t+1) : 6 (t-1)^2 (2t-1) : 3 (t-1)^2 (t^2+3)) = (3 : -2(st1) : 2(2t-1) : (t^2+3)) *) (* Thus, we have *) FrakFtab[a_,b_,c_,d_,s_] := 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] (* How to obtain Ftc[a_,b_,c_,d_,t_] *) D[f4[x0, x1, x2, x3], x0] hw0[x0_, x1_, x2_, x3_] := 3 x2 + 6 x3 D[f4[x0, x1, x2, x3], x1] hw1[x0_, x1_, x2_, x3_] := -6 x1 + 6 x3 D[f4[x0, x1, x2, x3], x2] hw2[x0_, x1_, x2_, x3_] := 3 x0 + 12 x2 + 4 x3 D[f4[x0, x1, x2, x3], x3] hw3[x0_, x1_, x2_, x3_] := 6 x0 + 6 x1 + 4 x2 - 38 x3 Factor[hw0[s0[t,1,1,1], s1[t,1,1,1], s2[t,1,1,1], s3[t,1,1,1]]] (* = 27 (t-1)^2 *) Factor[hw1[s0[t,1,1,1], s1[t,1,1,1], s2[t,1,1,1], s3[t,1,1,1]]] Factor[hw2[s0[t,1,1,1], s1[t,1,1,1], s2[t,1,1,1], s3[t,1,1,1]]] Factor[hw3[s0[t,1,1,1], s1[t,1,1,1], s2[t,1,1,1], s3[t,1,1,1]]] (* (27(t-1)^2 : -18 (t-1)^2 (t+1) : 3 (t-1)^2 (19+2t+t^2) : 6(t-1)^2(-8+5t+t^2)) = (9 : -6(t+1) : (t^2+2t+19) : 2(t^2+5t-8)). Thus, we have *) Ftc[a_,b_,c_,d_,t_] := 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] (* How to obtain Gtc[a_,b_,c_,d_,s_] *) Factor[hw0[s0[0,0,u,1], s1[0,0,u,1], s2[0,0,u,1], s3[0,0,u,1]]] Factor[hw1[s0[0,0,u,1], s1[0,0,u,1], s2[0,0,u,1], s3[0,0,u,1]]] Factor[hw2[s0[0,0,u,1], s1[0,0,u,1], s2[0,0,u,1], s3[0,0,u,1]]] Factor[hw3[s0[0,0,u,1], s1[0,0,u,1], s2[0,0,u,1], s3[0,0,u,1]]] (* Thus we have *) Guc[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] (* Lemma 5.17. *) (* Lemma 5.17(4). *) Factor[3 Guc[a,b,c,d,u] - u^2 Ftc[a,b,c,d, (3u^2-u+3)/u]] (* =0 *) (* Lemma 3.17(5). *) Factor[Ftab[t,1,1,1,t]] (* = 0 *) Factor[Ftab[0,0,1,1,t]] (* = 0 *) Factor[Ftc[t,1,1,1,t]] (* = 0 *) Factor[Ftc[0,0,a,1,t]] (* = (3 - a + 3 a^2 - a s)^2 *) Factor[Guc[0,0,u,1,u]] (* = 0 *) Factor[Guc[a,1,1,1,t]] (* = 3(a-1)^2 (-3 + t + a t - 5 t^2) (-3 + t + a t - t^2) *) (* Lemma 5.19. *) (* Lemma 5.19(4). *) Eliminate[{p==-6u(u^2+1)/(3u^2), q==(u^4+4u^2+1)/u^2, r==2(3u^4+3u^3+2u^2+3u+3)/(3u^2) + v}, {u, v}] DiscC6[p_,q_,r_] := - p^2 + 4 q - 8 Plot[-6u(u^2+1)/(3u^2),{u,0.01,1}] (* Lemma 3.19(5). *) Eliminate[{p==-6(t+1)/9, q==(t^2+2t+19)/9+u, r==2(t^2+5t-8)/9-u}, {t, u}] DiscC1[p_,q_,r_] := - 9 p^2 + 12 p + 12 q + 12 r + 8 (* Cf. *) Eliminate[{p==-2(t+1)/3, q==2(2t-1)/3+u, r==(t^2+3)/3-u}, {t, u}] (* Lemma 5.20. *) (* Lemma 5.20(2). *) DiscP9[p_,q_,r_] := 2p+q+r+1 (* Ftab[a,b,c,d,0] = 3 s0[a,b,c,d] - 2 s1[a,b,c,d] - 2 s2[a,b,c,d] + 3 s3[a,b,c,d] *) DiscP9[-2/3, -2/3, 3/3] (* = 0 *) (* Lemma 3.20(3). *) Eliminate[{p==-2(t+1)/3 + v, q==2(2t-1)/3 - 2v, r==(t^2+3)/3+u}, {t, v, u}] DiscP8[p_,q_,r_] := 2p+q+2 (* Some graphes *) (* Image of $X_4^{0+}$ *) (* \P_+^3 上では s0 \geq 0, s1 \geq 0, s2 \geq 0, s3 \geq 0 である ことに注意して, 不要な範囲を描かないように注意する *) 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,0,10}, {b,0,10}, PlotRange -> {{0, 2}, {0, 1.1}, {0, 1.1}}, RegionFunction -> Function[{a, b}, (a^2 - 1)^2 + (b^2 - 1)^2 > 0.00001]], ParametricPlot3D[{s1[a,b,0,1]/s0[a,b,0,1], s2[a,b,0,1]/s0[a,b,0,1], s3[a,b,0,1]/s0[a,b,0,1]}, {a,0,10}, {b,0,10}, PlotRange -> {{0, 2}, {0, 1.1}, {0, 1.1}}]] (* Frame of $X_4^{s0+}$ *) Show[ ParametricPlot3D[{s1[s,1,1,1]/s0[s,1,1,1], s2[s,1,1,1]/s0[s,1,1,1], s3[s,1,1,1]/s0[s,1,1,1]}, {s,0,10}, PlotRange -> {{0,2},{0,1.1},{0,1.1}}], ParametricPlot3D[{s1[0,0,s,1]/s0[0,0,s,1], s2[0,0,s,1]/s0[0,0,s,1], s3[0,0,s,1]/s0[0,0,s,1]}, {s,0,10}, PlotRange -> {{0,2},{0,1.1},{0,1.1}}], ParametricPlot3D[{s1[0,s,1,1]/s0[0,s,1,1], s2[0,s,1,1]/s0[0,s,1,1], s3[0,s,1,1]/s0[0,s,1,1]}, {s,0,10}, PlotRange -> {{0,2},{0,1.1},{0,1.1}}], ParametricPlot3D[{s1[s,s,1,1]/s0[s,s,1,1], s2[s,s,1,1]/s0[s,s,1,1], s3[s,s,1,1]/s0[s,s,1,1]}, {s,0,1}, PlotRange -> {{0,2},{0,1.1},{0,1.1}}], ParametricPlot3D[{21 s/38 + (1 - s), 3 s/38 + (1 - s)/2, 3 s/38}, {s,0,1}, PlotRange -> {{0,2}, {0,1.1}, {0,1.1}}]] (* Image of $\Zar(X_4^{0+})$ *) 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,0,10}, {b,0,10}, PlotRange -> {{0, 2}, {0, 3/2}, {0, 2}}, RegionFunction -> Function[{a, b}, (a^2 - 1)^2 + (b^2 - 1)^2 > 0.00001]], ContourPlot3D[{F5[1,x,y,z] == 0}, {x,0,2}, {y,0,3/2}, {z,0,2}], ParametricPlot3D[{s1[a,b,0,1]/s0[a,b,0,1], s2[a,b,0,1]/s0[a,b,0,1], s3[a,b,0,1]/s0[a,b,0,1]}, {a,0,10}, {b,0,10}, PlotRange -> {{0, 2}, {0, 3/2}, {0, 2}}], ContourPlot3D[{G3[1,x,y,z] == 0}, {x,0,2}, {y,0,3/2}, {z,0,2}]] (* ${\Cal S}_4^+$ *) Show[ParametricPlot3D[{-6 (t + 1)/9, (t^2 + 2 t + 19)/9 + u, 2 (t^2 + 5 t - 8)/9 - u}, {t, 5, 20}, {u, 0, 20}, PlotRange -> {{-10, 20}, {-10, 20}, {-20, 40}}], ParametricPlot3D[{-2 (t + 1)/3, 2 (2 t - 1)/3 + u, (t^2 + 3)/3 - u}, {t, 0, 5}, {u, 0, 20}, PlotRange -> {{-10, 20}, {-10, 20}, {-20, 40}}], ContourPlot3D[{r == -1 - 2 p - q}, {p, -2/3, 18}, {q, -8, 18}, {r, -18, 38}], ParametricPlot3D[{-6 u (u^2 + 1)/(3 u^2), (u^4 + 4 u^2 + 1)/u^2, 2 (3 u^4 + 3 u^3 + 2 u^2 + 3 u + 3)/(3 u^2) + v}, {u, 0, 1}, {v, 0, 200}, PlotRange -> {{-10, 20}, {-10, 20}, {-20, 40}}], ContourPlot3D[{q == -2 - 2 p}, {p, -4, 18}, {q, -8, 18}, {r, -18, 38}], ParametricPlot3D[{-6(t+1)/9, (t^2+2t+19)/9, 2 (t^2+5t-8)/9}, {t,5,20}, PlotRange -> {{-10, 20}, {-10, 22}, {-20, 40}}], ParametricPlot3D[{-2(t+1)/3, 2(2t-1)/3, (t^2+3)/3}, {t, 0, 5}, PlotRange -> {{-10, 20}, {-10, 20}, {-20, 40}}], ParametricPlot3D[{-6u(u^2+1)/(3u^2), (u^4+4u^2+1)/u^2, 2(3u^4+3u^3+2u^2+3u+3)/(3 u^2)}, {u, 0, 1}, PlotRange -> {{-10, 20}, {-10, 20}, {-20, 40}}]] (* Image of $V(f4)$ *) Show[ ParametricPlot3D[{s1[s,1,1,1]/s0[s,1,1,1], s2[s,1,1,1]/s0[s,1,1,1], s3[s,1,1,1]/s0[s,1,1,1]}, {s,0,10}, PlotRange -> {{0,2},{0,1.1},{0,1.1}}], ParametricPlot3D[{s1[0,0,s,1]/s0[0,0,s,1], s2[0,0,s,1]/s0[0,0,s,1], s3[0,0,s,1]/s0[0,0,s,1]}, {s,0,10}, PlotRange -> {{0,2},{0,1.1},{0,1.1}}], ParametricPlot3D[{s1[0,s,1,1]/s0[0,s,1,1], s2[0,s,1,1]/s0[0,s,1,1], s3[0,s,1,1]/s0[0,s,1,1]}, {s,0,10}, PlotRange -> {{0,2},{0,1.1},{0,1.1}}], ContourPlot3D[f4[1,x,y,z]==0,{x,0,2},{y,0,1.1},{z,0,1.1}]] 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,0,10}, {b,0,10}, PlotRange -> {{0, 2}, {0, 1.1}, {0, 1.1}}, RegionFunction -> Function[{a, b}, (a^2 - 1)^2 + (b^2 - 1)^2 > 0.00001]], ParametricPlot3D[{s1[a,b,0,1]/s0[a,b,0,1], s2[a,b,0,1]/s0[a,b,0,1], s3[a,b,0,1]/s0[a,b,0,1]}, {a,0,10}, {b,0,10}, PlotRange -> {{0, 2}, {0, 1.1}, {0, 1.1}}], ContourPlot3D[{f4[1,x,y,z]==0,y==z,x==2y,z==0},{x,0,2},{y,0,1.1},{z,0,1.1}]] (* Image of $V(f5)$ *) 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,0,10}, {b,0,10}, PlotRange -> {{0, 2}, {0, 1.1}, {0, 1.1}}, RegionFunction -> Function[{a, b}, (a^2 - 1)^2 + (b^2 - 1)^2 > 0.00001]], ParametricPlot3D[{s1[a,b,0,1]/s0[a,b,0,1], s2[a,b,0,1]/s0[a,b,0,1], s3[a,b,0,1]/s0[a,b,0,1]}, {a,0,10}, {b,0,10}, PlotRange -> {{0, 2}, {0, 1.1}, {0, 1.1}}], ContourPlot3D[f5[1,x,y,z]==0, {x,0,2}, {y,0,1.1}, {z,0,1.1}]] (* Image of $V(G3)$ *) 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+2a+3), 3/(a^2+2a+3), 3/(a^2+2a+3)}}, {a, 0, 10}, {b, 0, 10}, PlotRange -> {{0, 2}, {0, 1.1}, {0, 1.1}}, RegionFunction -> Function[{a, b}, (a^2 - 1)^2 + (b^2 - 1)^2 > 0.00001]], ParametricPlot3D[{s1[a,b,0,1]/s0[a,b,0,1], s2[a,b,0,1]/s0[a,b,0,1], s3[a,b,0,1]/s0[a,b,0,1]}, {a,0,10}, {b,0,10}, PlotRange -> {{0, 2}, {0, 1.1}, {0, 1.1}}], ContourPlot3D[{G3[1,x,y,z] == 0}, {x,-2,2}, {y,-3/2,3/2}, {z,0,2}]] (* MISC *) Guc[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] Factor[FrakG[a,b,c,d,t] - Ftab[a,b,c,d,t] -(t-1)^2(s2[a,b,c,d]-s3[a,b,c,d])] (* =0 *) Factor[3 FrakG[a,b,c,d,t] - Ftc[a,b,c,d,t] - 2 (t^2+2t-11)(s2[a,b,c,d]-s3[a,b,c,d])] (* =0 *) Factor[s0[x,y,z,1]^2 D[s1[x,y,z,1]/s0[x,y,z,1],x]] s1x[x_,y_,z_]:=1 + 3 x^2 - 3 x^4 - x^6 + 3 x^2 y - 4 x^3 y - x^6 y + y^3 - 4 x^3 y^3 - 3 x^4 y^3 + y^4 + 3 x^2 y^4 + 3 x^2 y^5 + y^7 + 3 x^2 z - 4 x^3 z - x^6 z - 12 y z - 8 x^3 y z + 36 x^4 y z + 4 y^2 z - 8 x^3 y^2 z - 4 x^3 y^3 z + 4 y^4 z + 3 x^2 y^4 z - 12 y^5 z + 4 y z^2 - 8 x^3 y z^2 + 4 y^4 z^2 + z^3 - 4 x^3 z^3 - 3 x^4 z^3 - 4 x^3 y z^3 + y^4 z^3 + z^4 + 3 x^2 z^4 + 4 y z^4 + 3 x^2 y z^4 + 4 y^2 z^4 + y^3 z^4 + 3 x^2 z^5 - 12 y z^5 + z^7 Factor[s0[x,y,z,1]^2 D[s2[x,y,z,1]/s0[x,y,z,1],x]] s2x[x_,y_,z_]:=-2 (-x + x^5 - x y^2 + 2 x^3 y^2 + x^5 y^2 - x y^4 - x y^6 + 3 y z + 2 x^2 y z - 9 x^4 y z - 2 y^3 z + 2 x^2 y^3 z + 3 y^5 z - x z^2 + 2 x^3 z^2 + x^5 z^2 + 2 x^3 y^2 z^2 - x y^4 z^2 - 2 y z^3 + 2 x^2 y z^3 - 2 y^3 z^3 - x z^4 - x y^2 z^4 + 3 y z^5 - x z^6) Factor[s0[x,y,z,1]^2 D[s3[x,y,z,1]/s0[x,y,z,1],x]] s3x[x_,y_,z_]:=y + 2 x y - 3 x^4 y - 2 x^5 y + y^2 - 3 x^4 y^2 + y^5 + 2 x y^5 + y^6 + z + 2 x z - 3 x^4 z - 2 x^5 z - 12 y z + 2 x y z - 4 x^3 y z + 36 x^4 y z - 2 x^5 y z + y^2 z - 4 x^2 y^2 z - 4 x^3 y^2 z - 3 x^4 y^2 z + y^4 z + 2 x y^4 z - 12 y^5 z + 2 x y^5 z + y^6 z + z^2 - 3 x^4 z^2 + y z^2 - 4 x^2 y z^2 - 4 x^3 y z^2 - 3 x^4 y z^2 + 4 y^2 z^2 - 4 x^2 y^2 z^2 + 4 y^3 z^2 + y^4 z^2 + y^5 z^2 + 4 y^2 z^3 + y z^4 + 2 x y z^4 + y^2 z^4 + z^5 + 2 x z^5 - 12 y z^5 + 2 x y z^5 + y^2 z^5 + z^6 + y z^6 Factor[s0[x,y,z,1]^2 D[s4[x,y,z,1]/s0[x,y,z,1],x]] s4x[x_,y_,z_]:=-y z (-1 + 3 x^4 - y^4 - z^4) Factor[s0[x,y,z,1]^2 D[s1[x,y,z,1]/s0[x,y,z,1],y]] s1y[x_,y_,z_]:=1 + x^3 + x^4 + x^7 + 3 y^2 + 3 x y^2 + 3 x^4 y^2 + 3 x^5 y^2 - 4 x y^3 - 4 x^3 y^3 - 3 y^4 - 3 x^3 y^4 - y^6 - x y^6 - 12 x z + 4 x^2 z + 4 x^4 z - 12 x^5 z + 3 y^2 z + 3 x^4 y^2 z - 4 y^3 z - 8 x y^3 z - 8 x^2 y^3 z - 4 x^3 y^3 z + 36 x y^4 z - y^6 z + 4 x z^2 + 4 x^4 z^2 - 8 x y^3 z^2 + z^3 + x^4 z^3 - 4 y^3 z^3 - 4 x y^3 z^3 - 3 y^4 z^3 + z^4 + 4 x z^4 + 4 x^2 z^4 + x^3 z^4 + 3 y^2 z^4 + 3 x y^2 z^4 - 12 x z^5 + 3 y^2 z^5 + z^7 Factor[s0[x,y,z,1]^2 D[s2[x,y,z,1]/s0[x,y,z,1],y]] s2y[x_,y_,z_]:=2 (y + x^2 y + x^4 y + x^6 y - 2 x^2 y^3 - y^5 - x^2 y^5 - 3 x z + 2 x^3 z - 3 x^5 z - 2 x y^2 z - 2 x^3 y^2 z + 9 x y^4 z + y z^2 + x^4 y z^2 - 2 y^3 z^2 - 2 x^2 y^3 z^2 - y^5 z^2 + 2 x z^3 + 2 x^3 z^3 - 2 x y^2 z^3 + y z^4 + x^2 y z^4 - 3 x z^5 + y z^6) Factor[s0[x,y,z,1]^2 D[s3[x,y,z,1]/s0[x,y,z,1],y]] s3y[x_,y_,z_]:=x + x^2 + x^5 + x^6 + 2 x y + 2 x^5 y - 3 x y^4 - 3 x^2 y^4 - 2 x y^5 + z - 12 x z + x^2 z + x^4 z - 12 x^5 z + x^6 z + 2 y z + 2 x y z + 2 x^4 y z + 2 x^5 y z - 4 x^2 y^2 z - 4 x y^3 z - 4 x^2 y^3 z - 3 y^4 z + 36 x y^4 z - 3 x^2 y^4 z - 2 y^5 z - 2 x y^5 z + z^2 + x z^2 + 4 x^2 z^2 + 4 x^3 z^2 + x^4 z^2 + x^5 z^2 - 4 x y^2 z^2 - 4 x^2 y^2 z^2 - 4 x y^3 z^2 - 3 y^4 z^2 - 3 x y^4 z^2 + 4 x^2 z^3 + x z^4 + x^2 z^4 + 2 x y z^4 + z^5 - 12 x z^5 + x^2 z^5 + 2 y z^5 + 2 x y z^5 + z^6 + x z^6 Factor[s0[x,y,z,1]^2 D[s4[x,y,z,1]/s0[x,y,z,1],y]] s4y[x_,y_,z_]:=x z (1 + x^4 - 3 y^4 + z^4) Factor[s0[x,y,z,1]^2 D[s1[x,y,z,1]/s0[x,y,z,1],z]] s1z[x_,y_,z_]:=1 + x^3 + x^4 + x^7 - 12 x y + 4 x^2 y + 4 x^4 y - 12 x^5 y + 4 x y^2 + 4 x^4 y^2 + y^3 + x^4 y^3 + y^4 + 4 x y^4 + 4 x^2 y^4 + x^3 y^4 - 12 x y^5 + y^7 + 3 z^2 + 3 x z^2 + 3 x^4 z^2 + 3 x^5 z^2 + 3 y z^2 + 3 x^4 y z^2 + 3 y^4 z^2 + 3 x y^4 z^2 + 3 y^5 z^2 - 4 x z^3 - 4 x^3 z^3 - 4 y z^3 - 8 x y z^3 - 8 x^2 y z^3 - 4 x^3 y z^3 - 8 x y^2 z^3 - 4 y^3 z^3 - 4 x y^3 z^3 - 3 z^4 - 3 x^3 z^4 + 36 x y z^4 - 3 y^3 z^4 - z^6 - x z^6 - y z^6 Factor[s0[x,y,z,1]^2 D[s2[x,y,z,1]/s0[x,y,z,1],z]] s2z[x_,y_,z_]:=2 (-3 x y + 2 x^3 y - 3 x^5 y + 2 x y^3 + 2 x^3 y^3 - 3 x y^5 + z + x^2 z + x^4 z + x^6 z + y^2 z + x^4 y^2 z + y^4 z + x^2 y^4 z + y^6 z - 2 x y z^2 - 2 x^3 y z^2 - 2 x y^3 z^2 - 2 x^2 z^3 - 2 y^2 z^3 - 2 x^2 y^2 z^3 + 9 x y z^4 - z^5 - x^2 z^5 - y^2 z^5) Factor[s0[x,y,z,1]^2 D[s3[x,y,z,1]/s0[x,y,z,1],z]] s3z[x_,y_,z_]:=x + x^2 + x^5 + x^6 + y - 12 x y + x^2 y + x^4 y - 12 x^5 y + x^6 y + y^2 + x y^2 + 4 x^2 y^2 + 4 x^3 y^2 + x^4 y^2 + x^5 y^2 + 4 x^2 y^3 + x y^4 + x^2 y^4 + y^5 - 12 x y^5 + x^2 y^5 + y^6 + x y^6 + 2 x z + 2 x^5 z + 2 y z + 2 x y z + 2 x^4 y z + 2 x^5 y z + 2 x y^4 z + 2 y^5 z + 2 x y^5 z - 4 x^2 y z^2 - 4 x y^2 z^2 - 4 x^2 y^2 z^2 - 4 x y z^3 - 4 x^2 y z^3 - 4 x y^2 z^3 - 3 x z^4 - 3 x^2 z^4 - 3 y z^4 + 36 x y z^4 - 3 x^2 y z^4 - 3 y^2 z^4 - 3 x y^2 z^4 - 2 x z^5 - 2 y z^5 - 2 x y z^5 Factor[s0[x,y,z,1]^2 D[s4[x,y,z,1]/s0[x,y,z,1],z]] s4z[x_,y_,z_]:=x y (1 + x^4 + y^4 - 3 z^4) Factor[Det[{{s1x[x,y,z],s2x[x,y,z],s3x[x,y,z]}, {s1y[x,y,z],s2y[x,y,z],s3y[x,y,z]}, {s1z[x,y,z],s2z[x,y,z],s3z[x,y,z]}}]] (* = -4 (-1 + x) (x - y) (-1 + y) (x - z) (y - z) (-1 + z) (1 + x + y + z)^2 (3 - 2 x + 3 x^2 - 2 y - 2 x y + 3 y^2 - 2 z - 2 x z - 2 y z + 3 z^2)^2 (1 + x^4 + y^4 - 4 x y z + z^4)^2 = -4 Π(a_i-a_j) S_1^2 (3S_2 - 2_{1,1}) (S_4-4U) *) Factor[Det[{{s1x[x,y,z],s2x[x,y,z],s4x[x,y,z]}, {s1y[x,y,z],s2y[x,y,z],s4y[x,y,z]}, {s1z[x,y,z],s2z[x,y,z],s4z[x,y,z]}}]] (* = 2 (-1 + x) (x - y) (-1 + y) (x - z) (y - z) (-1 + z) (1 + x + y + z)^2 (1 + x^2 + y^2 + z^2) (1 - x + x^2 - y - x y + y^2 - z - x z - y z + z^2) (1 + x^4 + y^4 - 4 x y z + z^4)^2 *) (* Lemma 5.5 and Lemma 5.12(1). *) f3101[x0_,x1_,x2_] := x1^2 - 2x1 x2 - 3x0 x2 + 3x2^2 Factor[f3101[s0[t,1,1,1], s1[t,1,1,1], s2[t,1,1,1]]] (* Lemma 5.10(3). *) f3103[x0_,x1_,x2_] := x1^2 - 2 x2^2 - x0 x2 Factor[f3103[s0[0,0,t,1], s1[0,0,t,1], s2[0,0,t,1]]] (*============ The PSD Cone {\Cal P}_{4,4}^{s0}$ ============================*) (* Theorem 5.4 *) 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] t0[x0_,x1_,x2_,x3_]:=S4[x0,x1,x2,x3] + 2 S22[x0,x1,x2,x3] (* = (a^2+b^2+c^2+d^2)^2 *) t1[x0_,x1_,x2_,x3_]:=T31[x0,x1,x2,x3] + T211[x0,x1,x2,x3] (* = (a b+a c+a d+b c+b d+c d) (a^2+b^2+c^2+d^2) *) t2[x0_,x1_,x2_,x3_]:=S22[x0,x1,x2,x3] + 2 T211[x0,x1,x2,x3] + 6 U[x0,x1,x2,x3] (* = (a b+a c+a d+b c+ b d+c d)^2 *) Factor[t0[a,b,c,d] t2[a,b,c,d] - t1[a,b,c,d]^2] FrakG[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] (* Determine $T_{F,P}^{\vee}$. F=\Reg(\partial X_4^0) ds0[a_, b_, c_, d_] := 4 (a^3 - b c d) ds1[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 ds2[a_, b_, c_, d_] := 2 (a b^2 + a c^2 - 3 b c d + a d^2) ds3[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 dsw0[a_, b_] := 4 (a^3 - b) dsw1[a_, b_] := 2 + 6 a^2 - 12 b + 3 a^2 b + b^3 dsw2[a_, b_] := 2 (2 a - 3 b + a b^2) dsw3[a_, b_] := 2 (1 + a - 5 b + 2 a b + b^2) Solve[{x0 dsw0[a, b] + x1 dsw1[a, b] + x2 dsw2[a, b] + x3 dsw3[a, b] == 0, x0 dsw0[b, a] + x1 dsw1[b, a] + x2 dsw2[b, a] + x3 dsw3[b, a] == 0, x0 s0[a,b,1,1] + x1 s1[a,b,1,1] + x2 s2[a,b,1,1] + x3 s3[a,b,1,1] == 0, x0 == 1}, {x1, x2, x3}] *) p0[a_,b_] := a^4 b^2 + 2 a^3 b^3 + a^2 b^4 + 4 a^4 b + 4 a b^4 + 4 a^4 + 4 b^4 - 30 a^3 b - 30 a b^3 - 8 a^3 + 32 a^2 b + 32 a b^2 - 8 b^3 + 21 a^2 - 14 a b + 21 b^2 - 28 a - 28 b + 20 p1[a_,b_] := 2(- a^5 b - 2 a^4 b^2 - 2 a^3 b^3 - 2 a^2 b^4 - a b^5 - 2 a^5 + 6 a^4 b + 4 a^3 b^2 + 4 a^2 b^3 + 6 a b^4 - 2 b^5 + 5 a^4 - 2 a^2 b^2 + 5 b^4 - 8 a^3 - 8 a^2 b - 8 a b^2 - 8 b^3 + 2 a^2 + 4 a b + 2 b^2 + 8 a + 8 b - 8) p2[a_,b_] := a^6 + 2 a^5 b + 5 a^4 b^2 + 8 a^3 b^3 + 5 a^2 b^4 + 2 a b^5 + b^6 - 12 a^5 - 4 a^4 b - 24 a^3 b^2 - 24 a^2 b^3 - 4 a b^4 - 12 b^5 + 8 a^4 + 44 a^3 b - 32 a^2 b^2 + 44 a b^3 + 8 b^4 + 16 a^3 + 16 b^3 - 50 a^2 + 12 a b - 50 b^2 + 24 a + 24 b -8 p3[a_,b_] := 2(a^6 + a^5 b + a^4 b^2 + 2 a^3 b^3 + a^2 b^4 + a b^5 + b^6 + 4 a^5 - 12 a^4 b - 12 a b^4 + 4 b^5 - 7 a^4 - 8 a^3 b + 22 a^2 b^2 - 8 a b^3 - 7 b^4 + 8 a^3 + 8 a^2 b + 8 a b^2 + 8 b^3 + 6 a^2 - 20 a b + 6 b^2 - 8 a - 8 b + 8) FrakF[s_,t_,x0_,x1_,x2_,x3_] := p0[s,t] s0[x0,x1,x2,x3] + p1[s,t] s1[x0,x1,x2,x3] + p2[s,t] s2[x0,x1,x2,x3] + p3[s,t] s3[x0,x1,x2,x3] (* Lemma 5.5. *) (* Examine that V(f_{4,4}^{s0}) = \partial_a X(\P^3$, ${\Cal H}_{4,4}^0). *) 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}] (* C_1 = \Phi \{(s:1:1:1) | s \in \R \} *) Factor[s0[s, 1, 1, 1]] (* = (-1 + s)^2 (3 + 2 s + s^2) *) Factor[s1[s, 1, 1, 1]] (* = 3 (-1 + s)^2 (2 + s) *) Factor[s2[s, 1, 1, 1]] (* = 3 (-1 + s)^2 *) Factor[s3[s, 1, 1, 1]] (* = 3 (-1 + s)^2 *) (* $\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$. *) Factor[f44s0[1, t, 1/2, t - 1]] (* 特異点: a=b, c=d=1 のとき *) (* (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 \} *) Factor[s0[-a-b-c,a,b,c] - 2 s2[-a-b-c,a,b,c]] (* = 0 *) Factor[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 *) G2[x0_,x1_,x2_,x3_] := (x1-x3)^2 + 2x2^2 - 3x2 x0 Factor[G2[s0[t,1,1,1], s1[t,1,1,1], s2[t,1,1,1], s3[t,1,1,1]]] (* = 0 *) (* Lemma 5.6. *) (* 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]))] (* Lemma 5.7. *) Solve[G2[x0,x1,x2,x3]==0, x0] Factor[f44s0[(x1^2 + 2 x2^2 - 2 x1 x3 + x3^2)/(3 x2), x1, xx2, x3]] (* = -((4 (x1 - 2 x2 - x3)^2 (x2 - x3)^2 (x1 + 2 x2 - x3)^4)/(9 x2^3)) *) (* Lemma 5.9. *) FrakG[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] FrakG[-1,-1,1,1,t] (* Discriminant of ${\Cal E}(C)$ for f = s_0 + p s_1 + q s_2 + r s_3 *) Eliminate[{p == -2(s+1)/3, q == (s^2+2s-1)/3 + t, r == 2(s+1)/3 - t}, {s, t}] Disc1[p_,q_,r_] := -9p^2 + 12(p+q+r) + 8 Factor[Disc1[-2(t+1)/3, (t^2+2t-1)/3 + alpha, 2(t+1)/3 - alpha]] (* = 0 *) (*============ The PSD Cone {\Cal P}_{4,3}^{c0+}$ ============================*) (* Theorem 6.1. *) 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] discC[a0_,a1_,a3_] := 27 a0^4 + 4 a0 a1^3 + 4 a0 a3^3 - a1^2 a3^2 - 18 a0^2 a1 a3 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 dds0[a0_,a2_,x_,y_] := (a0 - a2 - x)^2 (13 a0^2 - 2 a0 a2 + a2^2 + 2 a0 x + 2 a2 x)^2 (104 a0^3 + 100 a0^2 a2 - 4 a0 a2^2 + 36 a0^2 x + 36 a0 a2 x - a0 x^2 - a2 x^2 + 8 x^3) + (17173 a0^7 - 121 a0^6 a2 - 5639 a0^5 a2^2 + 7651 a0^4 a2^3 - 3489 a0^3 a2^4 + 469 a0^2 a2^5 - 45 a0 a2^6 + a2^7+ 6250 a0^6 x + 10028 a0^5 a2 x + 3142 a0^4 a2^2 x - 1368 a0^3 a2^3 x - 746 a0^2 a2^4 x - 20 a0 a2^5 x - 6 a2^6 x + 898 a0^5 x^2 + 7230 a0^4 a2 x^2 + 1748 a0^3 a2^2 x^2 - 1572 a0^2 a2^3 x^2 - 86 a0 a2^4 x^2 - 26 a2^5 x^2 + 2780 a0^4 x^3 - 368 a0^3 a2 x^3 + 1448 a0^2 a2^2 x^3 - 496 a0 a2^3 x^3 + 28 a2^4 x^3 + 518 a0^3 x^4 + 1018 a0^2 a2 x^4 - 190 a0 a2^2 x^4 + 78 a2^3 x^4 + 164 a0^2 x^5 + 168 a0 a2 x^5 + 4 a2^2 x^5) y^2 + (2495 a0^5 - 317 a0^4 a2 - 1886 a0^3 a2^2 + 842 a0^2 a2^3 - 81 a0 a2^4 + 3 a2^5 + 1768 a0^4 x + 4 a0^3 a2 x - 988 a0^2 a2^2 x + 380 a0 a2^3 x - 12 a2^4 x + 291 a0^3 x^2 + 897 a0^2 a2 x^2 - 463 a0 a2^2 x^2 + 83 a2^3 x^2 + 226 a0^2 x^3 + 92 a0 a2 x^3 - 38 a2^2 x^3 - a0 x^4 - a2 x^4) y^4 + (95 a0^3 + 65 a0^2 a2 - 43 a0 a2^2 + 3 a2^3 + 98 a0^2 x - 20 a0 a2 x - 6 a2^2 x - 4 a0 x^2) y^6 + (-3a0 + a2)y^8 discS[a0_,a1_,a2_,a3_] := (1/4) dds0[a0, a2, a1+a3, a1-a3] (* Lemme 6.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]}}]] (* = -(-1 + x - y + z)^3 (1 + x + y + z) (1 + x^2 - 2 y + y^2 - 2 x z + z^2)^2 (1 + x^3 - x y + y^3 - x z - y z - x y z + z^3)^2 = (a_0-a_1+a_2-a_3)^3 S_1 ((a_0-a_2)^2+(a_1-a_3)^2)(S3-S_{1,1,1})^2 *) (* Lemme 6.2(2) *) f3c0[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) Factor[f3c0[s0[a0,a1,a2,a3], s1[a0,a1,a2,a3], s2[a0,a1,a2,a3], s3[a0,a1,a2,a3]]] (* = a0 a1 a2 a3 (a0 - a1 + a2 - a3)^4 (a0 + a1 + a2 + a3)^2 ((a0-a2)^2 + (a1-a3)^2)^4 *) (* Lemme 6.2(4) *) g0[x_,y_] := y (- x + 2 x^2 - x^3 + y + x y + x^2 y + x^3 y - x y^2) g1[x_,y_] := 1 - 2 x^2 + x^4 + 3 x y - x^3 y - 2 x^4 y + 2 x y^2 - 2 x^2 y^2 - 2 y^3 - x y^3 + x y^4 g2[x_,y_] := y (1 - 3 x + 4 x^2 - 3 x^3 + x^4 - y - x y - x^2 y - x^3 y + 2 y^2 - 3 x y^2 + 2 x^2 y^2 + y^4) g3[x_,y_] := x - 2 x^3 + x^5 - 2 y - x y + 3 x^3 y - 2 x y^2 + 2 x^2 y^2 - x y^3 - 2 x^2 y^3 + y^4 g4[x_,y_] := -(1 + x - 2 x^2 - 2 x^3 + x^4 + x^5 - y - 2 x y + 6 x^2 y - 2 x^3 y - x^4 y - 6 x y^3 + y^4 + x y^4 + y^5) FrakF4[a0_,a1_,a2_,a3_,s_,t_] := g0[s,t] s0[a0,a1,a2,a3] + g1[s,t] s1[a0,a1,a2,a3] + g2[s,t] s2[a0,a1,a2,a3] + g3[s,t] s3[a0,a1,a2,a3] (* f6i = (F_{4,3}^{c0b})_i := \frac{\partial}{\partial x_i} F_{4,3}^{c0b}. Ex. f60 = Factor[D[f3c0[s0, s1, s2, s3], s0]] *) Factor[D[f3c0[s0, s1, s2, s3], s0]] f0[s0_, s1_, s2_, s3_] := -2 s0 s1^3 s2 + 2 s0 s1^2 s2^2 - 2 s1^2 s2^3 - 2 s1^4 s3 + 3 s0^2 s1 s2 s3 + 3 s1^3 s2 s3 - 2 s0 s1 s2^2 s3 + 2 s1^2 s2^2 s3 - s1 s2^3 s3 + 2 s0 s1^2 s3^2 - 4 s1^2 s2 s3^2 + 2 s0 s2^2 s3^2 + 2 s1 s2^2 s3^2 - 2 s2^3 s3^2 - 2 s0 s2 s3^3 + 3 s1 s2 s3^3 - 2 s1 s3^4 Factor[D[f3c0[s0, s1, s2, s3], s1]] f1[s0_, s1_, s2_, s3_] := 6 s1^5 - 3 s0^2 s1^2 s2 - 15 s1^4 s2 + 2 s0^2 s1 s2^2 + 4 s1^3 s2^2 - 4 s0 s1 s2^3 + 3 s1^2 s2^3 + 2 s1 s2^4 - 8 s0 s1^3 s3 + s0^3 s2 s3 + 9 s0 s1^2 s2 s3 + 16 s1^3 s2 s3 - s0^2 s2^2 s3 + 4 s0 s1 s2^2 s3 - 21 s1^2 s2^2 s3 - s0 s2^3 s3 - 4 s1 s2^3 s3 + s2^4 s3 + 2 s0^2 s1 s3^2 - 8 s0 s1 s2 s3^2 - 9 s1^2 s2 s3^2 + 2 s0 s2^2 s3^2 + 18 s1 s2^2 s3^2 - 2 s2^3 s3^2 + 6 s1^2 s3^3 + 3 s0 s2 s3^3 - 6 s1 s2 s3^3 - 7 s2^2 s3^3 - 2 s0 s3^4 + 4 s2 s3^4 Factor[D[f3c0[s0, s1, s2, s3], s2]] f2[s0_, s1_, s2_, s3_] := -s0^2 s1^3 - 3 s1^5 + 2 s0^2 s1^2 s2 + 2 s1^4 s2 - 6 s0 s1^2 s2^2 + 3 s1^3 s2^2 + 4 s1^2 s2^3 + s0^3 s1 s3 + 3 s0 s1^3 s3 + 4 s1^4 s3 - 2 s0^2 s1 s2 s3 + 4 s0 s1^2 s2 s3 - 14 s1^3 s2 s3 - 3 s0 s1 s2^2 s3 - 6 s1^2 s2^2 s3 + 4 s1 s2^3 s3 - 4 s0 s1^2 s3^2 - 3 s1^3 s3^2 + 2 s0^2 s2 s3^2 + 4 s0 s1 s2 s3^2 + 18 s1^2 s2 s3^2 - 6 s0 s2^2 s3^2 - 6 s1 s2^2 s3^2 + 4 s2^3 s3^2 - s0^2 s3^3 + 3 s0 s1 s3^3 - 3 s1^2 s3^3 - 14 s1 s2 s3^3 + 3 s2^2 s3^3 + 4 s1 s3^4 + 2 s2 s3^4 - 3 s3^5 Factor[D[f3c0[s0, s1, s2, s3], s3]] f3[s0_, s1_, s2_, s3_] := -2 s0 s1^4 + s0^3 s1 s2 + 3 s0 s1^3 s2 + 4 s1^4 s2 - s0^2 s1 s2^2 + 2 s0 s1^2 s2^2 - 7 s1^3 s2^2 - s0 s1 s2^3 - 2 s1^2 s2^3 + s1 s2^4 + 2 s0^2 s1^2 s3 - 8 s0 s1^2 s2 s3 - 6 s1^3 s2 s3 + 2 s0^2 s2^2 s3 + 4 s0 s1 s2^2 s3 + 18 s1^2 s2^2 s3 - 4 s0 s2^3 s3 - 4 s1 s2^3 s3 + 2 s2^4 s3 + 6 s1^3 s3^2 - 3 s0^2 s2 s3^2 + 9 s0 s1 s2 s3^2 - 9 s1^2 s2 s3^2 - 21 s1 s2^2 s3^2 + 3 s2^3 s3^2 - 8 s0 s1 s3^3 + 16 s1 s2 s3^3 + 4 s2^2 s3^3 - 15 s2 s3^4 + 6 s3^5 h0[x_,y_] := f0[s0[0,x,y,1], s1[0,x,y,1], s2[0,x,y,1], s3[0,x,y,1]] h1[x_,y_] := f1[s0[0,x,y,1], s1[0,x,y,1], s2[0,x,y,1], s3[0,x,y,1]] h2[x_,y_] := f2[s0[0,x,y,1], s1[0,x,y,1], s2[0,x,y,1], s3[0,x,y,1]] h3[x_,y_] := f3[s0[0,x,y,1], s1[0,x,y,1], s2[0,x,y,1], s3[0,x,y,1]] gc[x_,y_] := x y (1 + x - y)^2 (1 + x + y) (1 - 2 x + x^2 + y^2)^2 Expand[h0[x,y] - g0[x,y] gc[x,y]] (* = 0 *) Expand[h1[x,y] - g1[x,y] gc[x,y]] (* = 0 *) Expand[h2[x,y] - g2[x,y] gc[x,y]] (* = 0 *) Expand[h3[x,y] - g3[x,y] gc[x,y]] (* = 0 *) Expand[g0[x,y] + g1[x,y] + g2[x,y] + g3[x,y] + g4[x,y]] (* = 0 *) (* Some imformations on e and g0,g1,g2,g3*) Factor[FrakF4[0,s,t,1, s,t]] (* = 0 *) eb[a0_,a1_,a2_,a3_,s_,t_] := g0[s,t] S3[a0,a1,a2,a3] + g1[s,t] S210[a0,a1,a2,a3] + g2[s,t] S201[a0,a1,a2,a3] + g3[s,t] S120[a0,a1,a2,a3] + g4[s,t] S111[a0,a1,a2,a3] Factor[FrakF4[0,s,t,1, s,t]] (* = 0 *) (* FrakF4[x0,x1,x2,x3,s,0] = (s^2-1)^2 (t1[x0,x1,x2,x3] + s t3[x0,x1,x2,x3] - (s+1)t4[x0,x1,x2,x3]) *) Expand[discS[g0[x,y], g1[x,y], g2[x,y], g3[x,y]]] (* = 0 *) (* Put gamma[x,y]:=(g0[x,y],...,g3[x,y]) gamma[x,0]=(0:1:0:x) gamma[0,y]=(y^2 : (1-2y^3) : y(1-y+2y^2+y^4) : y(-2+y^3)) gamma[x:1]=((1-x+3x^2) : (-1+5x-4x^2-x^3-x^4) : (-3+x)(-1+2x-x^2+x^3) : (1+x)(-1-2x+2x^2-x^3+x^4)) gamma[1:y]=((4-y) : y(y-3) : (y^3+y-4) : y(y-3)) *) Factor[x^5 g0[1/x, y/x] - g0[x, y]] (* = 0 *) Factor[x^5 g1[1/x, y/x] - g3[x, y]] (* = 0 *) Factor[x^5 g2[1/x, y/x] - g2[x, y]] (* = 0 *) gw0[x1_, x2_, x3_] := -x2 (-x1^3 x2 + x1^3 x3 - x1^2 x2 x3 + x1 x2^2 x3 - 2 x1^2 x3^2 - x1 x2 x3^2 + x1 x3^3 - x2 x3^3) gw1[x1_, x2_, x3_] := -2 x1^4 x2 + x1 x2^4 + x1^4 x3 - x1^3 x2 x3 - 2 x1^2 x2^2 x3 - x1 x2^3 x3 + 2 x1 x2^2 x3^2 - 2 x2^3 x3^2 - 2 x1^2 x3^3 + 3 x1 x2 x3^3 + x3^5 gw2[x1_, x2_, x3_] := x2 (x1^4 - x1^3 x2 + 2 x1^2 x2^2 + x2^4 - 3 x1^3 x3 - x1^2 x2 x3 - 3 x1 x2^2 x3 + 4 x1^2 x3^2 - x1 x2 x3^2 + 2 x2^2 x3^2 - 3 x1 x3^3 - x2 x3^3 + x3^4) gw3[x1_, x2_, x3_] := x1^5 - 2 x1^2 x2^3 + 3 x1^3 x2 x3 + 2 x1^2 x2^2 x3 - x1 x2^3 x3 + x2^4 x3 - 2 x1^3 x3^2 - 2 x1 x2^2 x3^2 - x1 x2 x3^3 + x1 x3^4 - 2 x2 x3^4 (* Cut $\partial X_{4,3}^{c0+}$ by the plane $V(x_1-x_3)$. *) Factor[f3c0[1, x, y, x] - x^2 (2x-3y-1)(2x^3 + x^2y - y^3 - x^2 + 2 y^2 - y)] (* = 0 *) (* X_{4,3}^{c0+} is not convex near (1:0:0:0). *) fb[x_,y_] := -x^2 + 2 x^3 - y + x^2 y + 2 y^2 - y^3 Factor[fb[t/(2t^3-t^2+1), (2t^3-t^2)/(2t^3-t^2+1)]] (* = 0. t>0 Parametric *) fbx[x_,y_] := 2 x (-1+3 x+y) (* = Factor[D[fb[x, y], x]] *) fby[x_,y_] := -1 + x^2 + 4 y - 3 y^2 (* = Factor[D[fb[x, y], y]] *) bx[t_] := t/(2 t^3 - t^2 + 1) by[t_] := (2 t^3 - t^2)/(2 t^3 - t^2 + 1) Fbtanw[x_, y_, t_] := fbx[bx[t], by[t]] (x - bx[t]) + fby[bx[t], by[t]] (y - by[t]) Factor[Fbtanw[x, y, t]] (* = (t^2 - 4 t^3 - 2 t x + 6 t^2 x - y - t^2 y + 4 t^3 y)/(1 - t^2 + 2 t^3)^2 *) Fbtan[x_, y_, t_] := (t^2 - 4 t^3) + (6 t^2 - 2 t) x + (4 t^3 - t^2 - 1) y (* (bx[1/4],by[1/4]=(8/31, -1/31) Tangent at this point pass throught (0,0) (0:1:4:1) \in A. g0[1,4]=0 *) (* Lemma 6.3 *) (* The dual of $C:s_1^3 - s_0 s_1 s_3 + s_3^3 = 0$ is *) FC[x0_,x1_,x3_]:=x1^3 - x0 x1 x3 + x3^3 Factor[FC[s0[0,0,t,1],s1[0,0,t,1],s3[0,0,t,1]]] Factor[f3c0[x0, x1, 0, x3] - FC[x0,x1,x3]^2] (* = 0 *) discC[a0_,a1_,a3_] := 27 a0^4 + 4 a0 a1^3 + 4 a0 a3^3 - a1^2 a3^2 - 18 a0^2 a1 a3 Factor[s2[x0, x1, x2, x3]] (* = (x0 - x1 + x2 - x3) (x0 x2 - x1 x3) *) Factor[FC[s0[1, a, a c, c], s1[1, a, a c, c], s3[1, a, a c, c]]] (* = - a c (a-1)^2 (a+1) (c-1)^2 (c+1) ((a-c)^2 + (a c - 1)^2)^2 *) Factor[s0[a, a, 1, 1]] (* = 2 (-1 + a)^2 (1 + a) *) Factor[s1[a, a, 1, 1]] (* = (-1 + a)^2 (1 + a) *) Factor[s3[a, a, 1, 1]] (* = (-1 + a)^2 (1 + a) *) (* $(a:a:1:1)$ の像も $(2:1:0:2)$. *) Factor[s0[0, t, 1, 0]] (* = (1 + t) (1 - t + t^2) *) Factor[s1[0, t, 1, 0]] (* = t^2 *) Factor[s3[0, t, 1, 0]] (* = t *) (* Plot X_{4,3}^{c0} *) ContourPlot3D[f3c0[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}}], 1ParametricPlot3D[{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 6.4 *) Factor[dds0[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[dds0[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 6.5 *) (* the defining equation of $F_2 \cap F_4$ is *) 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$. *) Factor[g0[x, y] + g2[x, y]] (* = y ((x-1)^2 + y^2)^2 *) Factor[g0[1 + r Cos[t], r Sin[t]] + g2[1 + r Cos[t], r Sin[t]]] (* = r^5 Sin[t] *) fww[p0_,p1_,p3_] := 8 p0 (p1 + p3) - (p1-p3)^2 Factor[fww[g0[1+r Cos[t], r Sin[t]], g1[1+r Cos[t], r Sin[t]], g3[1+r Cos[t], r Sin[t]]]] (* = -r^5 192 Sin[t] + O(R^6) *) xw[r_, t_] := g1[1 + r Cos[t], r Sin[t]]/g0[1 + r Cos[t], r Sin[t]] yw[r_, t_] := g3[1 + r Cos[t], r Sin[t]]/g0[1 + r Cos[t], r Sin[t]] Show[ParametricPlot[{xw[0.1, t], yw[0.1, t]}, {t, 0.1, Pi - 0.1}, PlotRange -> {{-10, 30}, {-10, 30}}], ParametricPlot[{x^2/16 + x/2, x^2/16 - x/2}, {x, -20, 20}, PlotRange -> {{-10, 30}, {-10, 30}}]] Show[ParametricPlot3D[{x^2/16 + x/2, -1, x^2/16 - x/2}, {x, -30, 30}, PlotRange -> {{-20, 30}, {-20, 50}, {-20, 30}}], ParametricPlot3D[{(1-2y^3)/y^2, (1-y+2y^2+y^4)/y, (y^3-2)/y}, {y,0,10}, PlotRange -> {{-20, 30}, {-20, 50}, {-20, 30}}], ContourPlot3D[{discS[1,x,y,z] == 0}, {x,-20,30}, {y,-20,50}, {z,-20,30}]] (* Proof of Theorem 6.1, Part 1 *) ContourPlot3D[{discC[1, x, z] == 0, discS[1, x, y, z] == 0, y == -1}, {x, -20, 30}, {y, -20, 30}, {z, -20, 30}] 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}]] ContourPlot3D[{discS[1, x, y, z] == 0, discC[1, x, z] == 0, eta[x + z, y] == 0}, {x, -2000, 5000}, {y, -2, 50}, {z, -2000, 5000}] (* Lemma 6.6 *) Factor[discS[1, x, y, x]] (* = (-1 + 2 x + y)^2 (13 + 4 x - 2 y + 4 x y + y^2)^2 (26 + 18 x - x^2 + 16 x^3 + 25 y + 18 x y - x^2 y - y^2) f4cusp[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) (* 2乗 *) wwx[w_] := (1-2w^3)/w^2 wwy[w_] := (1-w+2w^2+w^4)/w wwz[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,wwx[w],wwz[w]]] (* = 0 *) Factor[discS[1,wwx[w],wwy[w],wwz[w]]] (* = 0 *) Factor[discC[1,(1-2w^3)/w^2,(w^3-2)/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[discSx[(1-2w^3)/w^2, (1-w+2w^2+w^4)/w, (w^3-2)/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[(1-2w^3)/w^2, (1-w+2w^2+w^4)/w, (w^3-2)/w]] (* = 0 *) Factor[discSz[(1-2w^3)/w^2, (1-w+2w^2+w^4)/w, (w^3-2)/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)) *) (* w=1 と w^4-6w^2-8w+1 = 0 の2つの実根 w=0.11508799467984865, w=2.934317165179855 が特異点に対応する *) (* Proof of Theorem 6.1, Part 2 *) (* (I) *) ContourPlot[{discC[1, x, z] == 0, discS[1, x, -1, z] == 0}, {x, -7, 10}, {z, -7, 10}] ContourPlot[{discC[1, x, z] == 0, discS[1, x, 0, z] == 0}, {x, -7, 10}, {z, -7, 10}] ContourPlot[{discC[1, x, z] == 0, discS[1, x, 1, z] == 0}, {x, -7, 10}, {z, -7, 10}] ContourPlot[{discC[1, x, z] == 0, discS[1, x, 2, z] == 0}, {x, -7, 10}, {z, -7, 10}] (* (II) *) 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]] (* (III) *) ContourPlot[{discC[1, x, z] == 0, discS[1, x, 4, z] == 0, eta[x + z, 4] == 0, fp[x, 4] == 0}, {x, -2.5, -1}, {z, -1, 0.5}] ContourPlot[{discC[1, x, z] == 0, discS[1, x, 4, z] == 0, eta[x + z, 4] == 0, fp[x, 4] == 0}, {x, -10, -6}, {z, 10, 25}] (* Q_1 = (1:-5.75249:30.4745:7.92863) *) ContourPlot[{discC[1, x, z] == 0, discS[1, x, 30.4745, z] == 0, eta[x + z, 30.4745] == 0, fp[x, 30.4745] == 0}, {x, -5.8, -5.6}, {z, 7.5, 8}] ContourPlot[{discC[1, x, z] == 0, discS[1, x, 100, z] == 0, fp[x, 100] == 0, eta[x + z, 100] == 0}, {x, -10, -6}, {z, 15, 22}] ContourPlot[{discC[1, x, z] == 0, discS[1, x, 500, z] == 0, fp[x, 500] == 0, eta[x + z, 500] == 0 }, {x, -30, -13}, {z, 50, 100}] ContourPlot[{discC[1, x, 1] == 0, discS[1, x, y, 1] == 0, eta[x + 1, y] == 0, y == -1, fp[x,y]==0}, {x, -3, 1}, {y, -2, 10}] ContourPlot[{discC[1, x, 10] == 0, discS[1, x, y, 10] == 0, eta[x + 10, y] == 0, y == -1, fp[x,y]==0}, {x, -15, 10}, {y, -2, 5}] ContourPlot[{discC[1, x, 10] == 0, discS[1, x, y, 10] == 0, eta[x + 10, y] == 0, y == -1, fp[x,y]==0}, {x, -6.44, -6.4}, {y, 39.5, 41}] ContourPlot[{discC[1, x, 50] == 0, discS[1, x, y, 50] == 0, eta[x + 50, y] == 0, y == -1, fp[x,y]==0}, {x, -14.3, -14}, {y, 6, 6.8}] (* Q_4=(1:-17.3648:7.9207:75.2686) *) ContourPlot[{discC[1, x, 75.2686] == 0, discS[1, x, y, 75.2686] == 0, eta[x + 75.2686, y] == 0, y == -1, fp[x,y]==0}, {x, -17.4, -17.3}, {y, 7.7, 8}] ContourPlot[{discC[1, x, 75.2686] == 0, discS[1, x, y, 75.2686] == 0, eta[x + 75.2686, y] == 0, y == -1, fp[x,y]==0}, {x, -22, -15}, {y, 0,1000}] ContourPlot[{discC[1, x, 100] == 0, discS[1, x, y, 100] == 0, eta[x + 100, y] == 0, y == -1, fp[x,y]==0}, {x, -20.1, -19.9}, {y, 9, 9.4}] ContourPlot[{discC[1, x, 100] == 0, discS[1, x, y, 100] == 0, eta[x + 100, y] == 0, y == -1, fp[x,y]==0}, {x, -200, 10}, {y, 8, 50000}] ContourPlot[{discC[1, x, 1000] == 0, discS[1, x, y, 1000] == 0, eta[x + 1000, y] == 0, y == -1, fp[x,y]==0}, {x, -100, 10}, {y, 8, 60}] Factor[discS[1, x, r, x]] (* = -(-1 + r + 2 x)^2 (13 - 2 r + r^2 + 4 x + 4 r x)^2 (-26 - 25 r + r^2 - 18 x - 18 r x + x^2 + r x^2 - 16 x^3) *) (* Lemmma 6.7 *) Factor[wwx[w] + wwz[w]] wwxz[w_] := (1 - 2 w - 2 w^3 + w^4)/w^2 Solve[{c1 wwxz[a2] + c2 wwy[a2] == 1, c1 wwxz[a1] + c2 wwy[a1] == 1}, {c1, c2}] c1w[a1_,a2_] := -(a1 a2 - 2 a1^2 a2^2 - a1^4 a2^2 - a1^3 a2^3 - a1^2 a2^4)/(1 - a1 + 2 a1^2 + a1^4 - a2 + 4 a1 a2 - 2 a1^2 a2 - 2 a1^4 a2 + 2 a2^2 - 2 a1 a2^2 - 2 a1^2 a2^2 - a1^3 a2^2 - a1^2 a2^3 - 2 a1^3 a2^3 - 2 a1^4 a2^3 + a2^4 - 2 a1 a2^4 - 2 a1^3 a2^4 + a1^4 a2^4) c2w[a1_,a2_] := -((-1 + a1 a2) (a1 + a2 - 2 a1 a2 + a1^2 a2 + a1 a2^2))/(1 - a1 + 2 a1^2 + a1^4 - a2 + 4 a1 a2 - 2 a1^2 a2 - 2 a1^4 a2 + 2 a2^2 - 2 a1 a2^2 - 2 a1^2 a2^2 - a1^3 a2^2 - a1^2 a2^3 - 2 a1^3 a2^3 - 2 a1^4 a2^3 + a2^4 - 2 a1 a2^4 - 2 a1^3 a2^4 + a1^4 a2^4) Eliminate[{c1 == c1w[a1, a2], s == a1 + a2, t == a1 a2}, {a1, a2}] (* c1 = (-t + 2 t^2 + s^2 t^2 - t^3)/(1 - s + 2 s^2 + s^4 - 2 s t - 4 s^2 t - 2 s^3 t + 5 s t^2 - 2 t^3 - 2 s t^3 + t^4) = 0.012907403163057564` *) Eliminate[{c1 == c1w[a1, a2], s == a1 + a2, t == a1 a2}, {a1, a2}] (* c2 = (s - 2 t + 2 t^2 - s t^2)/(1 - s + 2 s^2 + s^4 - 2 s t - 4 s^2 t - 2 s^3 t + 5 s t^2 - 2 t^3 - 2 s t^3 + t^4) = 0.03189258447607267` *) (* Proposition 6.9 *) f3c[x0_,x1_,x2_,x3_,x4_] := x1^3 - x0 x1 x2 + x1^2 x2 + x1 x2^2 - x0 x1 x3 - x0 x2 x3 - x1 x2 x3 + x2^2 x3 + x2 x3^2 + x3^3 + x0^2 x4 + x1^2 x4 - x2^2 x4 - 4 x1 x3 x4 + x3^2 x4 + x0 x4^2 - x1 x4^2 - x2 x4^2 - x3 x4^2 + 2 x4^3 Expand[f3c[S3[a0,a1,a2,a3], S210[a0,a1,a2,a3], S201[a0,a1,a2,a3], S120[a0,a1,a2,a3], S111[a0,a1,a2,a3]]] Factor[dds0[1,-1,x,y]] (* = 4 (8 x - y^2)^3 ((x-2)^2 + y^2). y = \pm 2\sqrt{2x} *) Factor[discS[1, x, -1, y]] (* = 2 ((x-1)^2+(y-1)^2) (8(x+y) - (x-y)^2)^3 *) Factor[s0[a0, a1, a2, a0 - a1 + a2]] (* = 2 (a0 + a2) (a0^2 - 2 a0 a1 + 2 a1^2 - 2 a1 a2 + a2^2) *) Factor[s1[a0, a1, a2, a0 - a1 + a2]] (* = (a0 + a2) (a0^2 - 2 a0 a1 + 2 a1^2 - 2 a1 a2 + a2^2) *) Factor[s2[a0, a1, a2, a0 - a1 + a2]] (* = 0 *) Factor[s3[a0, a1, a2, a0 - a1 + a2]] (* = (a0 + a2) (a0^2 - 2 a0 a1 + 2 a1^2 - 2 a1 a2 + a2^2) *) (* The image of a0-a1+a2-a3=0 is (2:1:0:1) *) Factor[s0[s, t, s, t]] (* = 2(s-t)^2(s+t) *) Factor[s1[s, t, s, t]] (* = 0 *) Factor[s2[s, t, s, t]] (* = 2(s-t)^2(s+t) *) Factor[s3[s, t, s, t]] (* = 0 *) (* The image of a0=a2=s, a1=a3=t is (1:0:1:0) *) Expand[f3cl[1, x1 + 1, x2 + 1, x3 + 1, x4 + 1]] ContourPlot3D[f3c[4, x, 2, y, z] == 0, {x, 0, 4}, {y, 0, 4}, {z, 0, 4}] ContourPlot3D[f3c[4, x, x, y, z] == 0, {x, 0, 4}, {y, 0, 4}, {z, 0, 4}] ContourPlot3D[f3c[4, x, y, x, z] == 0, {x, 0, 4}, {y, 0, 4}, {z, 0, 4}] t0[x0_, x1_, x2_, x3_] := x0^3 + x1^3 + x2^3 + x3^3 t1[x0_, x1_, x2_, x3_] := x0^2 x1 + x1^2 x2 + x2^2 x3 + x3^2 x0 t2[x0_, x1_, x2_, x3_] := x0^2 x2 + x1^2 x3 + x2^2 x0 + x3^2 x1 t3[x0_, x1_, x2_, x3_] := x0^2 x3 + x1^2 x0 + x2^2 x1 + x3^2 x2 t4[x0_, x1_, x2_, x3_] := x0 x1 x2 + x0 x1 x3 + x0 x2 x3 + x1 x2 x3