An Algebraic Surface with Negative Curvature and Euler Characteristic

Mohammad Ghomi

This notebook is an accompanyment to the paper Topology of negatively curved real affine algebraic surfaces by Chris Connell and Mohammad Ghomi. Here we verify that the following equation

eq=3 (z^4)+2 (1+4x y)(z^2)-2((((x^2)+(y^2)))^2)+8x y -1 ==0;

gives a  complete negatively curved surface Σ in (R^3) which is homeomorphic to a doubly punctured torus.  This yields an explicit algebraic solution to a problem first studied by Hadamard.We also study the projective transformations of this equation which yield some surfaces with nonpositive curvature. Finally, we obtain a sharp estimate for the merging of two hyperboloids to be negatively curved.

Implementation (Defining the Hessian)

DetHess[f_][x_,y_] := D[f[u,v],u,u] D[f[u,v],v,v]-((D[f[u,v],u,v])^2)/.{u->x,v->y};

Picture of  Σ

ContourPlot3D[eq//Evaluate,{x,-3,3},{y,-3,3},{z,-1.5,1.5}, PlotPoints->{30, 30, 20}, BoxRatios->Automatic, Axes->False]

Regularity of  Σ

Here we check that our main surface in regular. To see this note that our surface is given by (F^(-1))(-1) where

F[x_,y_,z_]:=2 ((((x^2)+(y^2)))^2)-2 (z^2)-3 (z^4)-8 x y (1+(z^2))

So we just need to check that -1 is a regular value of F:

gradF:={(∂_x) F[x,y,z],(∂_y) F[x,y,z],(∂_z) F[x,y,z]}

gradF//FullSimplify

Thus for the gradient to vanish we must have z=0.

gradF/.{z->0}

Solve[{-8 y+8 x ((x^2)+(y^2)),-8 x+8 y ((x^2)+(y^2))}=={0,0}]

F[0,0,0]

F[-(1/(Sqrt[2])),-(1/(Sqrt[2])),0]

F[(1/(Sqrt[2])),(1/(Sqrt[2])),0]

So the only singular values are 0, and -2.

Curvature of  Σ

There are two cases to consider:

Case I: z ≠ 0

roots=Solve[eq,z]

f[x_,y_] =z/.roots[[4]];

We just have to check that the determinant of the Hessian of f is always negative.

DetHess[f][x,y]//Simplify

Since the denominator is always positive, we just need to check the sign of the the numerator:

num[x_,y_] = Numerator[%];

Reduce[num[x,y]≥0,Reals]

So we are done (provided one trusts "Reduce"). But we also provide a more transparent proof of this as follows.

First note that num(x,y) may be rewritten as -2(p(x,y)+q(x,y)r(x,y))where :

p[x_,y_]:=(670(x^(4 ))(y^4)-1424(x^3)(y^3)+900(x^2)(y^2)-176x y+16)+(60(x^2)(y^2)-168x y +114)((x^4)+(y^4))+45((x^8)+(y^8))

q[x_,y_]:=2 (2 x y-1)(15((((x^2)-(y^2)))^2)+20(x^2)(y^2)+28x y-4)

r[x_,y_]:=(Sqrt[4+6 (x^4)-16 x y+28 (x^2) (y^2)+6 (y^4)])

Here is how we can check that num(x,y) is indeed equal to -2(p(x,y)+q(x,y)r(x,y)):

num[x,y]==-2(p[x,y]+q[x,y]r[x,y])//Simplify

We consider the following three subcases:

1.  xy ≥ 1/2

It is enough to show that when xy>1/2, q(x,y)>0 and p(x,y)>0.

3.1 q(x,y) > 0, when xy ≥ 1/2

Solve[-4+28z+20 (z^2)==0,z]

N[%]

So this quadratic expression is never zero when z>1/2, which implies that it must be positive when z>1/2. This implies that the same is true for q.

3.2 p(x,y) > 0, when xy ≥ 1/2

First we recall that

p[x,y]

Note that, when xy ≥1/2, then ((x^8)+(y^8))≥((x^4)+(y^4))/2-2(x^4)(y^4). This is easy to verify by hand, and here is how one can check this:

Reduce[(x^8)+(y^8)<(((x^4)+(y^4))/2)-2(x^4)(y^4)&&x y≥(1/2), {x,y}]

This inequality yields that 45((x^8)+(y^8))≥5((x^4)+(y^4))+50(x^4)(y^4), which we again can be easily checked both by hand and by the computer:

Reduce[45((x^8)+(y^8))<5((x^4)+(y^4))+50(x^4)(y^4)&&x y≥(1/2), {x,y}]

The last ineqaulity easily yields that

p[x,y]≥(16-176 x y+900 (x^2) (y^2)-1424 (x^3) (y^3)+720 (x^4) (y^4))+(119 -168 x y+60 (x^2)(y^2))((x^4)+(y^4))

which we check as follows:

Reduce[p[x,y]<(16-176 x y+900 (x^2) (y^2)-1424 (x^3) (y^3)+720 (x^4) (y^4))+(119 -168 x y+60 (x^2)(y^2))((x^4)+(y^4))&&x y≥(1/2), {x,y}]

So it is enough to show that the lower bound for p is positive. This is indeed the case, because the components of p have no real roots:

The above is always negative:

Solve[119 -168 z+60 (z^2)==0,z]//N

Solve[16-176 z+900 (z^2)-1424 (z^3)+720 (z^4)==0,z]//N

2.  0 ≤ xy ≤ 1/2

Set:

g[x_,y_]:=(((p[x,y]))^2)-(((q[x,y]r[x,y]))^2)

It is enough to show that g(x,y) does not vanish when 0≤xy≤1/2 and x and y are not both zero.

g[x,y]//Expand//FullSimplify

Note that g(x,y) may be rewritten as

g[x,y]==27 ((((x^2)+(y^2)))^2)((192-2496 x y+13304 (x^2) (y^2)-33409 (x^3) (y^3)+40000(x^4) (y^4))+(3900 (x^3) (y^3)-24160 (x^2) (y^2)+1976x y+1)(x^3)(y^3)+(508-2112 x y+4272 (x^2) (y^2)-4160 (x^3) (y^3)+1125 (x^4) (y^4))((x^4)+(y^4)) +(180+240 x y-750 (x^2) (y^2)) ((x^8)+(y^8))+75 ((x^12)+(y^12)))//Simplify

which is positive when 0 ≤ xy ≤ 1/2:

Solve[180 +240z -750 (z^2)==0,z]//N

Solve[508-2112 z+4272 (z^2)-4160 (z^3)+1125(z^4)==0,z]//N

Solve[ 1+1976 z-24160 (z^2)+3900 (z^3)==0,z]//N

Solve[192-2496 z+13304 (z^2)-33409(z^3)+40000(z^4)==0,z]//N

3.  xy ≺ 0

Again we show that g(s,y) doew not vanish. first note that

g[x,c x]//Expand//FullSimplify

We just need to show that the last factor in the above expression, i.e., the polynomial

h[x_,c_]:=192-2496 c (x^2)+4 (127+3326 (c^2)+127 (c^4)) (x^4)-192 c (11+174 (c^2)+11 (c^4)) (x^6)+12 (15+356 (c^2)+3498 (c^4)+356 (c^6)+15 (c^8)) (x^8)+80 c (1-22 (c^2)+(c^4)) (3+14 (c^2)+3 (c^4)) (x^10)+75 (((1-5 (c^2)-5 (c^4)+(c^6)))^2) (x^12)

does not vanish when x>0,and-1≤c<0. Let (Subscript[a, i]), i=1 ... 12, denote the coefficient of (x^(i ))in the above polynomial. In particular,

a8[c_]:=12 (15+356 (c^2)+3498 (c^4)+356 (c^6)+15 (c^8));
a10[c_]:=80 c (1-22 (c^2)+(c^4)) (3+14 (c^2)+3 (c^4));
a12[c_]:=75 (((1-5 (c^2)-5 (c^4)+(c^6)))^2)

It is clear that when c<0  all ai other than a10 are positive. Unfortunately, a10(c) has a root in [-1,0] and is not always positive:

Solve[a10[c]==0,c]//N

But a10+a12 >0, because

Solve[a10[c]+a12[c]==0,c]//N

So a10+a12 has no roots in [-1,0], and furthermore

a10[-.5]+a12[-.5]

Similarly we can show that, a8+a10>0:

Solve[a8[c]+a10[c]==0,c]//N

a8[0.5]+a10[0.5]

Thus when x≥1, (Subscript[a , 10])(x^10)+(Subscript[a, 12])(x^12)≥((Subscript[a, 10])+(Subscript[a, 12]))(x^10)>0, andwhen 0<x≤1, (Subscript[a , 8])(x^8)+(Subscript[a, 10])(x^10)≥((Subscript[a, 8])+(Subscript[a, 10]))(x^10)>0, for all -1≤c≺0. So h(x,c) ≥ (Subscript[a , 8])(x^8)+(Subscript[a , 10])(x^10)+(Subscript[a, 12])(x^12)>0 for all x≥0, and -1≤c≺0.

Case II: z = 0

R[θ_]:=(({{Cos[θ], -Sin[θ]}, {Sin[θ], Cos[θ]}}))

R[(π/4)].(({{x}, {y}}))

1+2 ((((x^2)+(y^2)))^2)==2 (z^2)+3 (z^4)+8 x y (1+(z^2))/.{x->(x/(Sqrt[2]))-(y/(Sqrt[2])), y->(x/(Sqrt[2]))+(y/(Sqrt[2]))}//FullSimplify

1+2 (x^4)+2 (y^4)+4 (x^2) (-1+(y^2)-(z^2))+4 (y^2) (1+(z^2))==2 (z^2)+3 (z^4)/.{z->0}

Here is the picture of the intersection of the surface with the xy-plane.

ContourPlot[1+2 (x^4)+4 (y^2)+2 (y^4)+4 (x^2) (-1+(y^2))==0, {x,-1.5,1.5},{y,-1.5,1.5},AxesOrigin->{0,0},Ticks->{{-1,1},{-1,1}},AxesLabel->{"x","y"}]

1+2 (x^4)+4 (y^2)+2 (y^4)+4 (x^2) (-1+(y^2))==0/.{y->0}

Solve[%,x]

N[%]

Case I. 1 y ≠ 0

Solve[1+2 (x^4)+2 (y^4)+4 (x^2) (-1+(y^2)-(z^2))+4 (y^2) (1+(z^2))==2 (z^2)+3 (z^4),y]

f[x_,z_] :=(Sqrt[-1-(x^2)-(z^2)+((Sqrt[1+8 (x^2)+6 (z^2)+8 (x^2) (z^2)+5 (z^4)])/(Sqrt[2]))])

DetHess[f][x,0]//FullSimplify

Numerator[%]-(-42-208 (x^2)-96 (x^4)+4(Sqrt[2+16 (x^2)])(7+12  (x^2)))//Simplify

(((-42-208 (x^2)-96 (x^4)))^2)-(((4(Sqrt[2+16 (x^2)])(7+12  (x^2))))^2)//Expand

Solve[%==0,x]//N

Case I. 2 y = 0

Solve[1+2 (x^4)+2 (y^4)+4 (x^2) (-1+(y^2)-(z^2))+4 (y^2) (1+(z^2))==2 (z^2)+3 (z^4),x]

f1[y_,z_] :=(Sqrt[1-(y^2)+(z^2)+((Sqrt[1-8 (y^2)+6 (z^2)-8 (y^2) (z^2)+5 (z^4)])/(Sqrt[2]))])

DetHess[f1][0,0]

f2[y_,z_] :=(Sqrt[1-(y^2)+(z^2)-((Sqrt[1-8 (y^2)+6 (z^2)-8 (y^2) (z^2)+5 (z^4)])/(Sqrt[2]))])

DetHess[f2][0,0]

Projective Transformations of  Σ

Here we employ projective transformations to generate other complete negatively curved surfaces in (R^3).

First we are going to rotate the surface as this will make performing the projective transformations easier:

(((((x/(Sqrt[(z^2)+1]))-1))^2)+((((y/(Sqrt[(z^2)+1]))-0))^2))(((((x/(Sqrt[(z^2)+1]))-(-1)))^2)+((((y/(Sqrt[(z^2)+1]))-0))^2))==1/2+((2(z^2))/((z^2)+1))//Simplify

So our new equation will be:

eq2=1+2 (x^4)+2 (y^4)-2 (z^2)-3 (z^4)+4 (x^2) (-1+(y^2)-(z^2))+4 (y^2) (1+(z^2))==0;

Punctured Torus

Solve[eq2/.{y->0,z->0},x]

(Subscript[x, 0])=-(Sqrt[(1/2) (2-(Sqrt[2]))]);

Simplify[eq2/.{x->1/(x-(Subscript[x, 0]))+(Subscript[x, 0]),y->y/(x-(Subscript[x, 0])),z->z/(x-(Subscript[x, 0]))}]

eqx=4 (Sqrt[2-(Sqrt[2])]) (x^3)+2 (y^4)+(z^2) (-4+(Sqrt[2])-3 (z^2))+(y^2) (6-2 (Sqrt[2])+4 (z^2))+(x^2) (-4+6 (Sqrt[2])-2 (-4+(Sqrt[2])) (y^2)+2 (-3+(Sqrt[2])) (z^2))+2 (Sqrt[2-(Sqrt[2])]) x (-(Sqrt[2])+2 (-1+(Sqrt[2])) (y^2)-(-2+(Sqrt[2])) (z^2))==0/.{x->z,z->x};

ContourPlot3D[eqx//Evaluate,{x, -4, 4}, {y, -4, 4}, {z, -4, 4},PlotPoints->{40,40,4}, BoxRatios->Automatic, Axes->False]

Triply Punctured Sphere

Solve[eq2/.{x->0, y->0},z]

(Subscript[z, 0])=-(1/(Sqrt[3]));

Simplify[eq2/.{x->x/(z-(Subscript[z, 0])),y->y/(z-(Subscript[z, 0])),z->1/(z-(Subscript[z, 0]))+(Subscript[z, 0])}]

eqz=-7+18 (x^4)+18 (y^4)+12 (Sqrt[3]) z+24 (Sqrt[3]) (z^3)+4 (x^2) (-7+9 (y^2)-2 (Sqrt[3]) z-12 (z^2))+4 (y^2) (7+2 (Sqrt[3]) z+12 (z^2))==0;

ContourPlot3D[eqz//Evaluate,{x, -5, 5}, {y, -4, 4}, {z, -3, 2.75}, PlotPoints->{40,40,40},  BoxRatios->Automatic, Axes->False]

Doubly punctured sphere

Solve[eq2/.{z->0, x->1},y]

(Subscript[y, 0])=-(Sqrt[(1/2) (-4+3 (Sqrt[2]))]);

Simplify[eq2/.{x->(x/(y-(Subscript[y, 0]))),y->(1/(y-(Subscript[y, 0])))+(Subscript[y, 0]),z->(z/(y-(Subscript[y, 0])))}]

eqy=481-339 (Sqrt[2])+2 (x^4)+12 (-3+2 (Sqrt[2])) (Sqrt[-4+3 (Sqrt[2])]) (y^3)+(10-6 (Sqrt[2])) (y^4)+58 (z^2)-39 (Sqrt[2]) (z^2)-3 (z^4)-2 (x^2) (-31+21 (Sqrt[2])+2 (Sqrt[-4+3 (Sqrt[2])]) (-3+4 (Sqrt[2])) y-3 (-2+(Sqrt[2])) (y^2)+2 (z^2))+2 (y^2) (-202+144 (Sqrt[2])+(-5+3 (Sqrt[2])) (z^2))-2 (Sqrt[-4+3 (Sqrt[2])]) y (-126+89 (Sqrt[2])+(-6+7 (Sqrt[2])) (z^2))==0/.{y->z, z->y};

We switch y and z for better visualization:

ContourPlot3D[eqy//Evaluate,{x, -8, 8}, {y, -8, 8}, {z, -8, 8}, PlotPoints->{40,40,40}, BoxRatios->Automatic, Axes->False]

Flat Points of the Projective Transformations

All projective transformations of Σ  necessarily have nonpositive curvature; however, in general they are not negatively curved, since they may pick up flat points along the planes which were blown up during the projective transformation.

Punctured Torus

First recall that the equation for this surface is

eqx=4 (Sqrt[2-(Sqrt[2])]) (x^3)+2 (y^4)+(z^2) (-4+(Sqrt[2])-3 (z^2))+(y^2) (6-2 (Sqrt[2])+4 (z^2))+(x^2) (-4+6 (Sqrt[2])-2 (-4+(Sqrt[2])) (y^2)+2 (-3+(Sqrt[2])) (z^2))+2 (Sqrt[2-(Sqrt[2])]) x (-(Sqrt[2])+2 (-1+(Sqrt[2])) (y^2)-(-2+(Sqrt[2])) (z^2))==0/.{x->z,z->x};

Note that we switched x and z. This is so that it can be visualized better once we graph it.

PunctTorus=ContourPlot3D[eqx//Evaluate,{x, -4, 4}, {y, -4, 4}, {z, -4, 4},PlotPoints->{40,40,40}];
plane=ContourPlot3D[z==-(Sqrt[(1/2) (2-(Sqrt[2]))]),{x, -4, 4}, {y, -4, 4}, {z, -4, 4}];
Show[PunctTorus,plane, Axes->False]

If there are any flat points, they must be on the plane z=-(Sqrt[(1/2) (2-(Sqrt[2]))]).

roots=Solve[eqx, y]

f[x_,z_]=y/.roots[[4]];

Reduce[DetHess[f][x,z]>=0&&z==-(Sqrt[(1/2) (2-(Sqrt[2]))]),Reals]

f[-(Sqrt[4+4 (Sqrt[2])]),-(Sqrt[(1/2) (2-(Sqrt[2]))])]//FullSimplify

section=ContourPlot[eqx/.{z->-(Sqrt[(1/2) (2-(Sqrt[2]))])}//Evaluate,{x,-4,4},{y,-4,4}];
points=ListPlot[{{-(Sqrt[4+4 (Sqrt[2])]),-1-(Sqrt[2])},{-(Sqrt[4+4 (Sqrt[2])]),1+(Sqrt[2])},{(Sqrt[4+4 (Sqrt[2])]),-1-(Sqrt[2])},{(Sqrt[4+4 (Sqrt[2])]),1+(Sqrt[2])}},PlotStyle->{PointSize[0.02`],Red}];
Show[section,points]

The curvature of the surface "Punctured Torus" vanishes at 4 points which lie on the cross section z=-(Sqrt[(1/2) (2-(Sqrt[2]))]).

Triple Punctured Sphere

First recall that the equation for this surface is given by:

eqz=-7+18 (x^4)+18 (y^4)+12 (Sqrt[3]) z+24 (Sqrt[3]) (z^3)+4 (x^2) (-7+9 (y^2)-2 (Sqrt[3]) z-12 (z^2))+4 (y^2) (7+2 (Sqrt[3]) z+12 (z^2))==0;

Here we check that this equation can be rewritten more simply as follows:

TripPunctSphere=ContourPlot3D[eqz//Evaluate,{x,-5,5},{y,-4,4},{z,-3,2.75`}];
plane=ContourPlot3D[z==-(1/(Sqrt[3])),{x,-5,5},{y,-4,4},{z,-3,2.75`}];
Show[TripPunctSphere,plane,  Axes->False,BoxRatios->Automatic]

The flat points, if there are any, must be along the plane z=-(1/(Sqrt[3])).

roots=Solve[eqz,y]

It appears that the real roos are the thirs and fourth roots which are the same up to a sign.

f[x_,z_]=y/.roots[[4]];

Reduce[DetHess[f][x,z]>=0&&z==-(1/(Sqrt[3])),Reals]

f[-(1/2) (Sqrt[-1+(Sqrt[2])]),-(1/(Sqrt[3]))]//FullSimplify

f[(1/2) (Sqrt[-1+(Sqrt[2])]),-(1/(Sqrt[3]))]//FullSimplify

points=ListPlot[{{-(1/2) (Sqrt[-1+(Sqrt[2])]),((Sqrt[1+(Sqrt[2])])/2)},{(1/2) (Sqrt[-1+(Sqrt[2])]),((Sqrt[1+(Sqrt[2])])/2)},{-(1/2) (Sqrt[-1+(Sqrt[2])]),-(1/2) (Sqrt[1+(Sqrt[2])])},{(1/2) (Sqrt[-1+(Sqrt[2])]),-(1/2) (Sqrt[1+(Sqrt[2])])}},PlotStyle->{PointSize[0.02`],Red}];section=ContourPlot[eqz/.{z->-(1/(Sqrt[3]))}//Evaluate,{x,-2,2},{y,-2,2}];
Show[section,points]

So it seems that the curvature of the surface vanishes at the inflection points of the cross section at height z=-(1/(Sqrt[3])).

Doubly Punctured Sphere

First recall that the equation for this surface is given by:

eqy=481-339 (Sqrt[2])+2 (x^4)+12 (-3+2 (Sqrt[2])) (Sqrt[-4+3 (Sqrt[2])]) (y^3)+(10-6 (Sqrt[2])) (y^4)+58 (z^2)-39 (Sqrt[2]) (z^2)-3 (z^4)-2 (x^2) (-31+21 (Sqrt[2])+2 (Sqrt[-4+3 (Sqrt[2])]) (-3+4 (Sqrt[2])) y-3 (-2+(Sqrt[2])) (y^2)+2 (z^2))+2 (y^2) (-202+144 (Sqrt[2])+(-5+3 (Sqrt[2])) (z^2))-2 (Sqrt[-4+3 (Sqrt[2])]) y (-126+89 (Sqrt[2])+(-6+7 (Sqrt[2])) (z^2))==0/.{y->z, z->y};

Here we check that this equation can be rewritten more simply as follows:

DoublePunctSphere=ContourPlot3D[eqy//Evaluate,{x, -8, 8}, {y, -8, 8}, {z, -8, 8}, PlotPoints->{40,40,40}];
plane=ContourPlot3D[z==-(Sqrt[(1/2) (-4+3 (Sqrt[2]))]),{x, -8, 8}, {y, -8, 8}, {z, -8, 8}];
Show[DoublePunctSphere,plane,BoxRatios->Automatic,Axes->False]

The flat points, if there are any, must be along the plane z=-(Sqrt[(1/2) (-4+3 (Sqrt[2]))]).

roots=Solve[eqy,y]

f[x_,z_]=y/.roots[[4]];

Reduce[DetHess[f][x,z]>=0&&z==-(Sqrt[(1/2) (-4+3 (Sqrt[2]))]),Reals]

f[-(Sqrt[3-2 (Sqrt[2])]),-(Sqrt[(1/2) (-4+3 (Sqrt[2]))])]//FullSimplify

f[(Sqrt[3-2 (Sqrt[2])]),-(Sqrt[(1/2) (-4+3 (Sqrt[2]))])]//FullSimplify

points=ListPlot[{{-(Sqrt[3-2 (Sqrt[2])]),-2 (Sqrt[-1+(Sqrt[2])])},{-(Sqrt[3-2 (Sqrt[2])]),2 (Sqrt[-1+(Sqrt[2])])},{(Sqrt[3-2 (Sqrt[2])]),-2 (Sqrt[-1+(Sqrt[2])])},{(Sqrt[3-2 (Sqrt[2])]),2 (Sqrt[-1+(Sqrt[2])])}},PlotStyle->{PointSize[0.02`],Red}];section=ContourPlot[eqy/.{z->-(Sqrt[(1/2) (-4+3 (Sqrt[2]))])}//Evaluate,{x,-2,2},{y,-2,2}];
Show[section,points]

So it seems that the curvature of the surface vanishes at the inflection points of the cross section at height z=-(Sqrt[(1/2) (-4+3 (Sqrt[2]))]).

How the Equation for  Σ Was Obtained

The main idea here was to work with "Cassini Ovals". These are the loci of points in the plane whose product of distances from a pair of given points is constant. For instance consider:

f[n_]:=ContourPlot[((((x-1))^2)+(((y-0))^2))((((x-(-1)))^2)+(((y-0))^2))==n, {x,-2,2}, {y,-2,2}, DisplayFunction->Identity]

pictures=Table[f[n], {n, 0.5, 2.5, 0.25}];

Show[GraphicsGrid[Partition[pictures//Evaluate,3]]]

The above formula was obtained by piling up and dilating Cassini ovals with respect to the points (((-1)/(Sqrt[2])),((-1)/(Sqrt[2]))), and ((1/(Sqrt[2])),(1/(Sqrt[2]))):

Simplify[(((((x/(Sqrt[(z^2)+1]))-(1/(Sqrt[2]))))^2)+((((y/(Sqrt[(z^2)+1]))-(1/(Sqrt[2]))))^2))(((((x/(Sqrt[(z^2)+1]))-(-(1/(Sqrt[2])))))^2)+((((y/(Sqrt[(z^2)+1]))-(-(1/(Sqrt[2])))))^2))==(1/2)+((2(z^2))/((z^2)+1))]

Our formula is just the numerator of the above:

FullSimplify[1+2 (x^4)+4 (x^2) (y^2)+2 (y^4)-2 (z^2)-3 (z^4)-8 x y (1+(z^2))==0]

The most difficult part was to adjust the rate of scaling of the ovals with the rate of vertical shifting to make sure that the curvature remains negative.

Sharp Estimate for  MergingTwo Hyperboloids

Special Estimate

(Subscript[F, 1])[x_,y_,z_]:=-(r^2)+(((-a+x))^2)+(((-a+y))^2)-(z^2)
(Subscript[F, 2])[x_,y_,z_]:=-(r^2)+(((a+x))^2)+(((a+y))^2)-(z^2)

eq=(Subscript[F, 1])[x,y,z](Subscript[F, 2])[x,y,z]==ϵ/.{a->2,r->1};

Solve[eq,z]

f[x_,y_]:=(Sqrt[7+(x^2)+(y^2)-(Sqrt[16 (x^2)+32 x y+16 (y^2)+ϵ])])

DetHess[f][x,y]

h[z_]:=Numerator[DetHess[f][x,y]]/.{(((x+y))^2)->z}

h[z]//Expand

-112 ϵ-24 z ϵ-(ϵ^2)+(-16 z +23 ϵ) (Sqrt[16 z+ϵ])

Solve[-16 z+23 ϵ==0,z]

So if z>=((23 ϵ)/16), then h(z)<0. Suppose now that z<((23 ϵ)/16). Then the above expression is less than

-112 ϵ-24 z ϵ-(ϵ^2)+(-16 z +23 ϵ) (Sqrt[24ϵ])//Expand

Solve[-112 ϵ+46 (Sqrt[6]) (ϵ^(3/2))-(ϵ^2)==0,ϵ]//FullSimplify

N[6236-92 (Sqrt[4593])]

eq=eq/.{x->((x-y)/(Sqrt[2])),y->((x+y)/(Sqrt[2]))}

ContourPlot[eq/.{z->0,ϵ->1}//Evaluate,{x,-4,4},{y,-4,4}]

Solve[eq,y]

f[x_,z_]:=(Sqrt[-7-(x^2)+(z^2)+(Sqrt[32 (x^2)+ϵ])])

DetHess[f][x,0]//Simplify

g[x_]:=-48 (x^2) ϵ-ϵ (112+ϵ)+(-32 (x^2)+23 ϵ )(Sqrt[32 (x^2)+ϵ])

If -32 (x^2) +23 ϵ ≤0, then the above is always negative. So suppose -32 (x^2) +23 ϵ ≥0. Then (Sqrt[32 (x^2)+ϵ])≤(Sqrt[24ϵ]), and we have

                  g(x) ≤ -48 (x^2) ϵ-ϵ (112+ϵ)+(-32 (x^2)+23 ϵ )(Sqrt[24ϵ])
                          ≤ -ϵ (112+ϵ)+23 ϵ (Sqrt[24ϵ])

Solve[-ϵ (112+ϵ)+23 ϵ (Sqrt[24ϵ])==0,ϵ]//FullSimplify

N[%]

Solve[eq,x]

(Subscript[f, 1])[y_,z_]:=(Sqrt[9-(y^2)+(z^2)-(Sqrt[32-32 (y^2)+32 (z^2)+ϵ])])

(Subscript[f, 2])[y_,z_]:=(Sqrt[9-(y^2)+(z^2)+(Sqrt[32-32 (y^2)+32 (z^2)+ϵ])])

DetHess[(Subscript[f, 1])][0,0]//Simplify

Solve[-9+(Sqrt[32+ϵ])==0,ϵ]

DetHess[(Subscript[f, 2])][0,0]//Simplify

General Estimate

(Subscript[F, 1])[x_,y_,z_]:=-(r^2)+(((-a+x))^2)+(((-a+y))^2)-(z^2)
(Subscript[F, 2])[x_,y_,z_]:=-(r^2)+(((a+x))^2)+(((a+y))^2)-(z^2)

eq=(Subscript[F, 1])[x,y,z](Subscript[F, 2])[x,y,z]==ϵ;

Solve[eq,z]

f[x_,y_]:=(Sqrt[2 (a^2)-(r^2)+(x^2)+(y^2)-(Sqrt[4 (a^2) (x^2)+8 (a^2) x y+4 (a^2) (y^2)+ϵ])])

DetHess[f][x,y]

h[z_]:=Numerator[DetHess[f][x,y]]/.{(((x+y))^2)->z}

h[z]//Expand

-8 (a^4) ϵ+4 (a^2) (r^2) ϵ-6 (a^2) z ϵ-(ϵ^2)+(-4 (a^2) (r^2) z +6 (a^2) ϵ -(r^2) ϵ )(Sqrt[4 (a^2) z+ϵ])

Solve[-4 (a^2) (r^2) z +6 (a^2) ϵ -(r^2) ϵ ==0,z]

So if z>=((6 (a^2) ϵ-(r^2) ϵ)/(4 (a^2) (r^2))), then h(z)<0. Suppose now that z<((6 (a^2) ϵ-(r^2) ϵ)/(4 (a^2) (r^2))). Then the above expression is less than

4 (a^2) z+ϵ/.{z->((6 (a^2) ϵ-(r^2) ϵ)/(4 (a^2) (r^2)))}//Simplify

-8 (a^4) ϵ+4 (a^2) (r^2) ϵ-6 (a^2) z ϵ-(ϵ^2)+(-4 (a^2) (r^2) z +6 (a^2) ϵ -(r^2) ϵ )(Sqrt[6 ϵ])(a/r)//Expand

Solve[-8 (a^4) ϵ+4 (a^2) (r^2) ϵ+((6 (Sqrt[6]) (a^3) (ϵ^(3/2)))/r)-(Sqrt[6]) a r (ϵ^(3/2))-(ϵ^2)==0,ϵ]//Simplify

((108 (a^6)-44 (a^4) (r^2)+7 (a^2) (r^4)-(Sqrt[3]) (Sqrt[(a^4) (((-6 (a^2)+(r^2)))^2) (108 (a^4)-52 (a^2) (r^2)+11 (r^4))]))/(r^2))/.{a->2,r->1}

N[%]

((((a/r)))^2)(108 (a^4)-44 (a^2) (r^2)+7  (r^4)- (Sqrt[3(((-6 (a^2)+(r^2)))^2) (108 (a^4)-52 (a^2) (r^2)+11 (r^4))]))

Picture

(Subscript[F, 1])[x_,y_,z_]:=-(r^2)+(((-a+x))^2)+(((-a+y))^2)-(z^2)
(Subscript[F, 2])[x_,y_,z_]:=-(r^2)+(((a+x))^2)+(((a+y))^2)-(z^2)

eq=(Subscript[F, 1])[x,y,z](Subscript[F, 2])[x,y,z]==ϵ/.{a->2,r->1};

eq/.{x->(((x-y))/(Sqrt[2])),y->(((x+y))/(Sqrt[2])),ϵ->1}//Simplify

(-1+(((-2(Sqrt[2])+x))^2)+(y^2)-(z^2))(-1+(((2(Sqrt[2])+x))^2)+(y^2)-(z^2))==1//Simplify

ContourPlot3D[(-1+(((-2(Sqrt[2])+x))^2)+(y^2)-(z^2))(-1+(((2(Sqrt[2])+x))^2)+(y^2)-(z^2))==1,{x,-7,7},{y,-5,5},{z,-3.75,3.75},PlotPoints->{100, 75, 75},BoxRatios->Automatic,Axes->False]

Negatively Curved Surfaces in a Slab

graph1=ContourPlot3D[-x(1-(z^2))==y z(1-z^2)+z,{x,-7,7},{y,-6,6},{z,-1,1}, Boxed->False,Axes->False,BoxRatios->Automatic]

graph2=ContourPlot3D[-x(1-(z^2))==-y z(1-z^2)+1,{x,-7,7},{y,-6,6},{z,-1,1},  Boxed->False,Axes->False,BoxRatios->Automatic]

graph3=ContourPlot3D[((x^2)+(y^2))(1-(z^2))==1,{x,-2.5,2.5},{y,-2.5,2.5},{z,-1,1}, Boxed->False,Axes->False,BoxRatios->Automatic]

Show[GraphicsRow[{graph1,graph2,graph3}]]