Cassinian Oval

Note

This Mathematica notebook is from the WWW project A Visual Dictionary of Special Plane Curves. Copyright © 1995-2004 by Xah Lee. (http://xahlee.org/)

Graphics illustrating Cassinian Oval as a torus section

Packages and Initializations

Needs["Graphics`ImplicitPlot`"]

Needs["Graphics`Shapes`"]	(* MathSource Item#: 0200-608 *)

Needs["ExtendGraphics`Geometry3D`"]
(*MathSource Item:0208 - 976*)

$HistoryLength = 5;

Clear[ Slice3DGraphics]

(*Clip3D is a function in Tom W.J.'s ExtendGraphics`Geometry3D` Package*)
(*It is not well documented. Here's a replacement usage documentation*)
Clip3D::usage= "Clip3D[ gPrim, Plane[p,v] ]
	will take a list of Graphics3D primitives gPrim, and return a list of
	Graphics3D primitives that is on one side of the plane Plane[p,v],
	where v is the normal vector and p is a point on the plane. Primitives
	that contain points on both sides are cut. Example:
	Needs[\"Graphics`Shapes`\"];
	Show@ Graphics3D@ Clip3D[ Torus[2,1,15,15], Plane[{2,0,0}, {-1,0,0}]]";

Slice3DGraphics::usage = "
	Slice3DGraphics[ graphics3DPrimitives,  sliceAxis, {p1, p2,...,pn} ]
	will return a list of Graphics3D primitives that is parts of the
	given graphics3DPrimitives sliced along planes passing through
	a list of nPoints {p1, p2,...,pn} and normal to sliceAxis vector.
	Graphics that lies outside the first and last cutting plane will
	be clipped.	The number of Graphics3D objects returned depends on
	positions of nPoints.
	The nPoints that define the slicing plane must be
	in order; towards the direction of sliceAxis vector.
	sliceAxis is a vector of the form {x,y,z}.
	Slice3DGraphics calls functions in the package ExtendGraphics`Geometry3D.";

Slice3DGraphics[ gp_List, axis_List, throughPoints_List ]:=
Module[{pieces, remain},
	remain = gp;
	pieces = Table[Null, {Length@ throughPoints-1} ];
	Do[
		remain = Clip3D[ remain, Plane[ throughPoints[[i]], axis] ];
		pieces[[i]] = Clip3D[ remain, Plane[ throughPoints[[i+1]], -axis] ],
		{i, Length@ pieces}
	];
	pieces
]

torusSweepingCircles::usage="
torusSweepingCircles[b,a,n,{tMin, tMax},{thetaMin,thetaMax}]
will return Graphics3D primitives of circular arcs that represents
the path of surface of revolution for a torus. Example:
Show@ Graphics3D@ torusSweepingCircles[4,1,6,{1,5},{0, Pi}]";

Clear[torusSweepingCircles]

torusSweepingCircles[b_,a_,n_,{tMin_, tMax_},{thetaMin_,thetaMax_}]:=
	First@ ParametricPlot3D[
		{ (b+First@#) Cos[t], (b+First@#) Sin[t], Last@ #},
		{t, tMin, tMax},
		DisplayFunction->Identity
	]& /@
		( (a{Cos[#], Sin[#]})& /@
			Range[thetaMin,thetaMax,(thetaMax-thetaMin)/(n-1)]
		)

Clear[torusGeneratingCircles]

torusGeneratingCircles::usage="
torusGeneratingCircles[b,a, n, {tMin,tMax}, {thetaMin,thetaMax}]
will return Graphics3D primitives that represents the generating
circles of a torus. Example:
Show@ Graphics3D@ torusGeneratingCircles[3,1, 5, {1,5}, {0,6}]";

torusGeneratingCircles[b_,a_,n_,{tMin_,tMax_},{thetaMin_,thetaMax_}]:=
	First@ ParametricPlot3D[#, {theta, thetaMin, thetaMax},
		DisplayFunction->Identity]& /@
		(Rotate3D[{a Cos[theta],0,a Sin[theta]}+{b,0,0}, -#,0,0]& /@
			Range[tMin, tMax, (tMax-tMin)/(n-1)]
		)

as intersection of a torus
Illustration of slicing a torus to form Cassinian Oval

using PlotRange to cut the torus

Cassinian ovals are the intersection of a torus and a plane in certain position.

Let b-a be the inner radius of a torus whose generating circle has radius a.
Cassinian oval is the intersection of a plane parallel to the torus' axis and a distant from it. If b == 2 a, then it's Lemniscate of Bernoulli.

change b and a for different Cassinian oval.

With[{a = 1, b = 2.3}, 
        Show[Graphics3D[Torus[b, a, 20, 20]], 
          PlotRange -> {{-1, 1} (a + b), {-a, 
                a + b}, {-1, 1} a}, 
          ViewPoint -> {-0.007, -2.017, 2.717}]];

slicing the graphics

Clear[a, b, wallGP, torusGP1, torusGP2, cassOvalGP]
a = 1; b = 2.2;
wallGP = 
        Table[{Line[{{i, a, -(b + a)}, {i, a, b + a}}], 
            Line[{{-(b + a), a, i}, {b + a, a, i}}]}, {i, -(b + 
                  a), b + a, 2 (b + a)}];
torusGP1 = 
        Clip3D[Torus[b, a, 50, 30], 
          Plane[{0, a, 0}, {0, -1, 0}]];
torusGP2 = 
        Clip3D[{torusSweepingCircles[b, a, 5, {0, π}, {0, 2 π}], 
            torusGeneratingCircles[b, a, 4, {0, π}, {0, 2 π}]}, 
          Plane[{0, a, 0}, {0, 1, 0}]];

Show[Graphics3D[{{torusGP1}, {Hue[0], torusGP2}, wallGP}], 
        Axes -> False, Boxed -> False, 
        ViewPoint -> {2.169, 2.351, 1.104}];

Now we wish to add the an outline to the intersection.
The formula of torus with generating circle radius a and center to axis b is
(Sqrt[x^2 + y^2] -b)^2 + z^2 - a^2 == 0
we want to find the intersection of this torus with a plane x=a

so, solve the system of eq. by subsitute x=a,

cassOvalGP = 
        First[ImplicitPlot[(Expand[((((Sqrt[(x^2) + (y^2)]) - b))^2)] + (z^2) - 
                    (a^2) /. x -> a) == 
              0, {y, -(b + a), b + a}]];

Make it 3 dimentional by adding a coordinate.

cassOvalGP = 
        cassOvalGP /. {x_?AtomQ, y_?AtomQ} -> {x, a, 
              y};

Show[
        Graphics3D[{{EdgeForm[], torusGP1}, {Hue[0], Thickness[ .003], 
              torusGP2}, {Hue[ .75], wallGP, cassOvalGP}}], 
        Axes -> False, Boxed -> False, 
        ViewPoint -> {2.169, 2.351, 1.104}];