1.9 Appendix B

X3=mExpsMD[3,{x,y,z}];
Length[X3]

X4=mExpsMD[4,{x,y,z}];
Length[X4]

X5=mExpsMD[5,{x,y,z}];
Length[X5]

Step 1:  Begin with L1

Basis1=L1eq

We have 2 linear equations, i . e . lines .

Step 2:  Add L8

L8Eq

sylB1=sylvesterMD[Basis1,3,{x,y,z}];
syl2=sylvesterMD[L8eq,3,{x,y,z}];
int2X=vectorSpaceIntersection[sylB1,syl2,dTol].X3;
Length[int2X]

Basis2=hBasisMD[int2X,3,{x,y,z},dTol]

We have a linear equation, plane and a quadric which appears to be a union of two planes.

Step 3 :  Add L9

L9eq

sylB2=sylvesterMD[Basis2,3,{x,y,z}];
syl3=sylvesterMD[L9eq,3,{x,y,z}];
int3X=vectorSpaceIntersection[sylB2,syl3,dTol].X3;
Length[int3X]

Basis3=hBasisMD[int3X,3,{x,y,z},dTol]
Length[Basis3]

We get, as expected , 3 quadrics

{ContourPlot3D[Basis3[[1]]==0, {x,-5,5},{y,-5,5},{z,-5,5},Mesh->None, MaxRecursion->4,ImageSize->Small],ContourPlot3D[Basis3[[2]]==0, {x,-5,5},{y,-5,5},{z,-5,5},Mesh->None, MaxRecursion->4,ImageSize->Small],ContourPlot3D[Basis3[[3]]==0, {x,-5,5},{y,-5,5},{z,-5,5},Mesh->None, MaxRecursion->4,ImageSize->Small]}

Apparently 3 hyperboloids, none being the base hyperboloid of Appendix A.

Step 4 : Add L10

L10eq

sylB3=sylvesterMD[Basis3,3,{x,y,z}];
syl4=sylvesterMD[L10eq,3,{x,y,z}];
int4X=vectorSpaceIntersection[sylB3,syl4,dTol].X3;
Length[int4X]

Basis4=hBasisMD[int4X,3,{x,y,z},dTol]
Length[Basis4]

Now we have our base hyperboloid and  cubics.

{ContourPlot3D[Basis4[[2]]==0, {x,-5,5},{y,-5,5},{z,-5,5},Mesh->None, MaxRecursion->4,ImageSize->Small],ContourPlot3D[Basis4[[3]]==0, {x,-5,5},{y,-5,5},{z,-5,5},Mesh->None, MaxRecursion->4,ImageSize->Small],ContourPlot3D[Basis4[[4]]==0, {x,-5,5},{y,-5,5},{z,-5,5},Mesh->None, MaxRecursion->4,ImageSize->Small]}

Step 5 : Add L11

L11eq

Now we need to go to degree 4  and we go beyond our base hyperboloid .

sylB4=sylvesterMD[Basis4,5,{x,y,z}];
syl5=sylvesterMD[L11eq, 5, {x,y,z}];
int5=vectorSpaceIntersection[sylB4,syl5,dTol].X5;
Length[int5]

Basis5=hBasisMD[int5,5,{x,y,z},dTol]
tDegMD[#,{x,y,z}]&/@Basis5

So we have 4 cubics and a quartic .  This is the first case in which this example differs from previous examples I have done.

{ContourPlot3D[Basis5[[1]]==0, {x,-5,5},{y,-5,5},{z,-5,5},Mesh->None, MaxRecursion->4,ImageSize->Small],ContourPlot3D[Basis5[[2]]==0, {x,-5,5},{y,-5,5},{z,-5,5},Mesh->None, MaxRecursion->4,ImageSize->Small],ContourPlot3D[Basis5[[3]]==0, {x,-5,5},{y,-5,5},{z,-5,5},Mesh->None, MaxRecursion->4,ImageSize->Small]}

{ContourPlot3D[Basis5[[4]]==0, {x,-5,5},{y,-5,5},{z,-5,5},Mesh->None, MaxRecursion->4,ImageSize->Small],ContourPlot3D[Basis5[[5]]==0, {x,-5,5},{y,-5,5},{z,-5,5},Mesh->None, MaxRecursion->4,ImageSize->Small]}

Step 6 : Add L6

L6eq

sylB5=sylvesterMD[Basis5,5,{x,y,z}];
syl6=sylvesterMD[L6eq, 5, {x,y,z}];
int6=vectorSpaceIntersection[sylB5,syl6,dTol].X5;
Length[int6]

Basis6=hBasisMD[int6,5,{x,y,z},dTol]
tDegMD[#,{x,y,z}]&/@Basis6

Again a slight discrepancy, there are 4 cubics .  In fact these are the same 4 cubics we had in Basis5.  This is not entirely not expected in that line 6 was calculated from the previous lines and must appear in any cubic surface containing the previous 5 lines.  Note, however that the quartic is no longer in the system as that was the equation that eliminated L6.

Step 7 :  Add L12

L12eq

sylB6=sylvesterMD[Basis6,5,{x,y,z}];
syl7=sylvesterMD[L12eq, 5, {x,y,z}];
int7=vectorSpaceIntersection[sylB6,syl7,dTol].X5;
Length[int7]

Basis7=hBasisMD[int7,5,{x,y,z},dTol]
tDegMD[#,{x,y,z}]&/@Basis7

Here we are back to what is expected, a unique cubic and 4 quartics .  The unique cubic is not one of the cubics in Basis 6.  Call this cubic f.

f=Basis7[[1]]

ContourPlot3D[f==0, {x,-5,5},{y,-5,5},{z,-5,5},Mesh->None, MaxRecursion->5]

We check that this cubic actually contains all of these lines.

Simplify[f/.Thread[{x,y,z}->L1]]

Simplify[f/.Thread[{x,y,z}->L8]]

Simplify[f/.Thread[{x,y,z}->L9]]

Simplify[f/.Thread[{x,y,z}->L10]]

Simplify[f/.Thread[{x,y,z}->L11]]

Simplify[f/.Thread[{x,y,z}->L6]]

Simplify[f/.Thread[{x,y,z}->L12]]

But note that this cubic also contains the other 5 lines of the double 6.  This is because they were all determined from the first 7.

Simplify[f/.Thread[{x,y,z}->L5]]

Simplify[f/.Thread[{x,y,z}->L4]]

Simplify[f/.Thread[{x,y,z}->L3 ]]

Simplify[f/.Thread[{x,y,z}->L2]]

Simplify[f/.Thread[{x,y,z}->L7]]

Since the entire double 6 lies in cubic f we are done already .  Moreover we can actually skip 6 and go directly to 7 from 5

Alternate Step 6:  Add L12 to Step 5

L12

sylB5=sylvesterMD[Basis5,4,{x,y,z}];
syl6alt=sylvesterMD[L12eq, 4, {x,y,z}];
int6alt=vectorSpaceIntersection[sylB5,syl6alt,dTol].X4;
Length[int6alt]

Basis6alt=hBasisMD[int6alt,4,{x,y,z},dTol];
tDegMD[#,{x,y,z}]&/@Basis6alt

Basis6alt[[1]]

f

So we arrive at the same cubic in 6 steps .  Again this came as a small surprise but should not have since we already made our choices after we chose the 6 lines for which a choice could be made.  That is we only needed the blue part of the double 6 to calculate f.

Labeled[Show[ContourPlot3D[f==0, {x,-5,5},{y,-5,5},{z,-5,5},Mesh->None, MaxRecursion->5],ParametricPlot3D[{L1,L8,L9,L10,L11,L12},{t,-5,5},PlotStyle->Blue],ParametricPlot3D[{L7,L6,L5,L4,L3,L2},{t,-5,5},PlotStyle->Green],Boxed->False,Axes->False,ImageSize->Large],"Double 6 on cubic f"]