Note

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

Packages and Initializations

Needs["ParaPlot`"]
(*MathSource Item:0207-986*)

Needs["PlaneCurveFormulas`"]

Needs["PlaneCurveGenerator`"]

Needs["Graphics`ImplicitPlot`"]
(*MathSource Item:0200-529*)

Off[General::spell];

Clear[alpha,theta,v0n0]

Clear[v0 , v1 , v2 , v0v1 , v0v2 , v1v2 , n0, c0 , c0v1 , c0f1,
f1 , f2 , v0f1 , v0f2 , v1f1, b0, v0b0, s1, s2, s1j1, s2j2,
v0s1, v0s2, v0j1, v0j2 , v0c1, v0c2 , c1j1 , c2j2, c1d1 , d1, d2]

v0 = {0,0};

v1 = {v0n0*Csc[alpha + theta]*Sin[alpha],
	v0n0*Cos[alpha]*Csc[alpha + theta]};

v2 = {v0n0*Csc[alpha - theta]*Sin[alpha],
	-(v0n0*Cos[alpha]*Csc[alpha - theta])};

v0v1 = Sqrt[v0n0^2 Csc[alpha + theta]^2];
v0v2 = Sqrt[v0n0^2 Csc[alpha - theta]^2];

v1v2 =
 Sqrt[v0n0^2 Csc[alpha - theta]^2 Csc[alpha + theta]^2 Sin[2 alpha]^2];

n0 = {Cos@ theta, Sin@ theta} v0n0;

c0 = 
	{v0n0*Cos[theta]*Csc[alpha - theta]*Csc[alpha + theta]*Sin[alpha]^2, 
	-(v0n0*Cos[alpha]^2*Csc[alpha - theta]* Csc[alpha + theta]*Sin[theta])
	};
c0v1 =
Sqrt[v0n0^2*Csc[alpha - theta]^2*Csc[alpha + theta]^2*Sin[2*alpha]^2]/2;

c0f1 = (Cos[theta]*Sec[alpha]*(v0n0^2*Csc[alpha - theta]^2*
       Csc[alpha + theta]^2*Sin[2*alpha]^2)^(1/2))/2;

f1 = {(v0n0*Cos[theta]*Csc[(alpha + theta)/2]*
     Sec[(alpha - theta)/2]*Sin[alpha])/2,
  (v0n0*(2 + Cos[alpha - theta] - Cos[alpha + theta])*
     Csc[(alpha + theta)/2]*Sec[(alpha - theta)/2])/4};

f2 = {(v0n0*Cos[theta]*Csc[(alpha - theta)/2]*
     Sec[(alpha + theta)/2]*Sin[alpha])/2,
  (v0n0*(-2 + Cos[alpha - theta] - Cos[alpha + theta])*
     Csc[(alpha - theta)/2]*Sec[(alpha + theta)/2])/4};

v0f1 = ((v0n0^2*Cos[alpha]^4*Csc[(alpha + theta)/2]^2*
       Sec[(alpha - theta)/2]^2)/4 + 
    (v0n0^2*(2 + Cos[alpha - theta] - Cos[alpha + theta])^2*
       Csc[(alpha + theta)/2]^2*Sec[(alpha - theta)/2]^2*
       Sec[theta]^2*Sin[alpha]^2)/16)^(1/2);
v0f2 = ((v0n0^2*Cos[alpha]^4*Csc[(alpha + theta)/2]^2*
       Sec[(alpha - theta)/2]^2)/2 +
    (v0n0^2*(2 + Cos[alpha - theta] - Cos[alpha + theta])^2*
       Csc[(alpha + theta)/2]^2*Sec[(alpha - theta)/2]^2*
       Sec[theta]^2*Sin[alpha]^2)/8)^(1/2);

v1f1 = (v0n0^2*Sec[(alpha - theta)/2]^2*Sec[(alpha + theta)/2]^2*Sin[alpha]^2)^(1/2)/2;

b0 = {0, v0n0 Csc[theta]};

v0b0 = Abs[v0n0 Csc[theta]];

s1 = {0,  (v0n0 Csc[(alpha + theta)/2] Sec[(-alpha + theta)/2])/2};

s2 = {0, -(v0n0 Csc[(alpha - theta)/2] Sec[( alpha + theta)/2])/2};

s1j1 = Abs[(v0n0 Csc[(alpha + theta)/2] Sec[(alpha - theta)/2] Sin[alpha])/2];
s2j2 = Abs[(v0n0 Csc[(alpha - theta)/2] Sec[(alpha + theta)/2] Sin[alpha])/2];

v0s1 = (v0n0 Csc[(alpha + theta)/2] Sec[(-alpha + theta)/2])/2;
v0s2 = -(v0n0 Csc[(alpha - theta)/2] Sec[( alpha + theta)/2])/2;

v0j1 = (v0n0 Csc[(alpha + theta)/2] Sec[(-alpha + theta)/2])/2 Cos[alpha];
v0j2 = -(v0n0 Csc[(alpha - theta)/2] Sec[( alpha + theta)/2])/2 Cos[alpha];

v0c1 = (v0n0 Csc[(alpha + theta)/2] Sec[(-alpha + theta)/2])/2 Cos[alpha]^2;
v0c2 = -(v0n0 Csc[(alpha - theta)/2] Sec[( alpha + theta)/2])/2 Cos[alpha]^2;

c1j1 = (v0n0 Csc[(alpha + theta)/2] Sec[(-alpha + theta)/2])/2 Cos[alpha] Sin[alpha];
c2j2 = -(v0n0 Csc[(alpha - theta)/2] Sec[( alpha + theta)/2])/2 Cos[alpha] Sin[alpha];

c1d1 = (v0b0-v0c1)/Tan[Pi/2-theta];
d1 = {c1d1,v0c1};
d2 = (c0 - d1) + c0;

On[General::spell]

Conic Sections
2D Illustration

This notebook contain codes that generate 2D graphics of a cross-section view of cutting a double cone. Graphics will contain two non-parallel lines that represents the double cone, a line that represents the cutting plane, another line that represents a tangent circle plane, and circles that represents Dandelin spheres.

Ellipse & Hyperbola cases

Execute the cells below. You may change the values of alpha and theta at the beginnig of the cell. 0 < alpha < 90 Degree. 0 < theta < 90 Degree.

Clear[alpha, theta, v0n0, gp1, pRange]

alpha = 45 Degree; 
theta = 15 Degree;
v0n0 = 1;

(* {35, 65, 1}, {45, 15, 1}*)

gp1 = First@ ImplicitPlot[
	{y == Tan[Pi/2-alpha] x (* cone *),
	y == -Tan[Pi/2-alpha] x,
	y == -Tan[Pi/2-theta] x + v0n0/Sin[theta] (* cutting plane *),
	y == v0c1, (*tangent planes*)
	y == v0c2
	},
	{x, -100, 100},
	AspectRatio->Automatic,
	PlotPoints->3,
	PlotStyle->{Hue[.75],Hue[.75], Hue[0], Hue[0], Hue[0] },
	DisplayFunction->Identity
];

pRange = Max[
	Sqrt[Plus@@(v1^2)],
	Sqrt[Plus@@(v2^2)]
	]//N;

Show[
	Graphics[{
		gp1,
		PointSize[.02],
		{Hue[0],Point@ f1, Point@ f2},
		GrayLevel[0],
		Circle[s1, s1j1],
		Circle[s2, s2j2]
	}],
	Axes->False, Ticks->None,
	DisplayFunction->$DisplayFunction,
	PlotRange->
	If[ N[ alpha > theta],
	{{-1,1} Sin[alpha], {-1,1} Cos[alpha]} pRange 2,
	{{-1,1} Sin[alpha], {-.1, Cos[alpha]} } pRange 2
	],
	AspectRatio->Automatic
];

Parabola Case

Codes in this section are tailored to generate the parabola case, when alpha == theta.

(* This cell is for drawing parabola case *)

Clear[alpha, theta, v0n0, gp1, pRange]

alpha = theta = 35 Degree;
v0n0 = 1;

gp1 = First@ ImplicitPlot[
	{y == Tan[Pi/2-alpha] x (* cone *),
	y == -Tan[Pi/2-alpha] x,
	y == -Tan[Pi/2-theta] x + v0n0/Sin[theta] (* cutting plane *),
	y == v0c1
	},
	{x, -100, 100},
	AspectRatio->Automatic,
	PlotPoints->3,
	PlotStyle->{Hue[.75],Hue[.75], Hue[0], Hue[0], Hue[0] },
	DisplayFunction->Identity
];

pRange = Sqrt[Plus@@(v1^2)]//N;

Show[
	Graphics[{
		gp1,
		PointSize[.02],
		{Hue[0],Point@ f1},
		GrayLevel[0],
		Circle[s1, s1j1]
	}],
	Axes->False, Ticks->None,
	DisplayFunction->$DisplayFunction,
	PlotRange->N@ {{-1,1} Sin[alpha], {-.1, Cos[alpha]} } pRange 2,
	AspectRatio->Automatic
];