Monge'sTheoremin3D::usage=" There are three spheres: (1)
2
x
+
2
y
+
2
z
= 4, (2) x - 5
2
)
+
2
y
+
2​
z
= 1 y (3)
2​
x
+ y - 5
2
)
+
2
z
=
9
4
. Find the vertices of the cones that contain them and demonstrate that they are colinear to verify Monge's 3Dtheorem.​Reference: Personal."
Obtaining the vertex of the cone by calculating the Cos[θ] for the spheres (1) and (3):
In[]:=
Solve
2
(5-c)
-
9
4
2
(5-c)
==
2
c
-4
2
c
,c
Out[]=
c
20
7
,{c20}
V
13
={0,20,0}
Obtaining the vertex of the cone by calculating the Cos[θ] for the spheres (1) and (2):
In[]:=
Solve
2
c
-4
2
c
==
2
(c-5)
-1
2
(c-5)
,c
Out[]=
c
10
3
,{c10}
V
12
={10,0,0}
Obtaining the vertex of the cone by calculating the Cos[θ] for the spheres (2) and (3) (We know that x1 = 5 - y1):
In[]:=
Solve
2
(5-y1)
+
2
(5-y1)
-
9
4
2
(5-y1)
+
2
(5-y1)
==
2
(5-y1-5)
+
2
y1
-1
2
(5-y1-5)
+
2
y1
,y1
Out[]=
{{y1-10},{y12}}
V
23
={15,-10,0}
Equation of the line that contains the 3 vertices:
ℒ:{0,20,0}+t{10,-20,0}
Cartesian equation of the cone with vertex
V
13
= {0, 20, 0} and axis t{0, 1, 0}:
99
100
==
({x,y,z}-{0,20,0}).({0,1,0}-{0,20,0})
Norm[{x,y,z}-{0,20,0}]Norm[{0,1,0}-{0,20,0}]
Out[]=
3
11
10
-
-20+y
2
Abs[x]
+
2
Abs[-20+y]
+
2
Abs[z]
In[]:=
Expand[99(
2
x
+
2
(y-20)
+
2
z
)==100
2
(-20+y)
]
Out[]=
39600+99
2
x
-3960y+99
2
y
+99
2
z
40000-4000y+100
2
y
99
2
x
-
2
y
+99
2
z
+40y-4000;
Cartesian equation of the cone with vertex
V
12
= {10, 0, 0} and axis t{1, 0, 0}:
In[]:=
96
100
==
({x,y,z}-{10,0,0}).({1,0,0}-{10,0,0})
Norm[{x,y,z}-{10,0,0}]Norm[{1,0,0}-{10,0,0}]
Out[]=
2
6
5
-
-10+x
2
Abs[-10+x]
+
2
Abs[y]
+
2
Abs[z]
In[]:=
Expand[24
2
(x-10)
+24
2
y
+24
2
z
==25
2
(x-10)
]
Out[]=
2400-480x+24
2
x
+24
2
y
+24
2
z
2500-500x+25
2
x
-
2
x
+24
2
y
+24
2
z
+20x-100==0;
Cartesian equation of the cone with vertex
V
23
=
{15, - 10, 0} and axis ζ: {0, 5, 0} + t {5, - 5, 0}:
In[]:=
1791
1800
==
({x,y,z}-{15,-10,0}).({5,0,0}-{15,-10,0})
Norm[{x,y,z}-{15,-10,0}]Norm[{5,0,0}-{15,-10,0}]
Out[]=
199
2
10

-10(-15+x)+10(10+y)
10
2
2
Abs[-15+x]
+
2
Abs[10+y]
+
2
Abs[z]
In[]:=
Expand[199(
2
(x-15)
+
2
(y+10)
+
2
z
)==100
2
(-(-15+x)+(10+y))
]
Out[]=
64675-5970x+199
2
x
+3980y+199
2
y
+199
2
z
62500-5000x+100
2
x
+5000y-200xy+100
2
y
99
2
x
+99
2
y
+199
2
z
+200xy-970x-1020y+2175==0;
Animation:
In[]:=
​​Manipulateℒ[t_]:={0,20,0}+t{10,-20,0};φ[t_]:=t{0,1,0};​​ξ[t_]:=t{1,0,0};​​ζ[t_]:={0,5,0}+t{5,-5,0};​​​​ShowParametricPlot3D[φ[t],{t,-10,25},PlotStyleGray]/.Line[pts_,rest___]:>Tube[pts,0.15,rest],​​ParametricPlot3D[ξ[t],{t,-5,20},PlotStyleGray]/.Line[pts_,rest___]:>Tube[pts,0.15,rest],​​ParametricPlot3D[ζ[t],{t,-2,4},PlotStyleGray]/.Line[pts_,rest___]:>Tube[pts,0.15,rest],​​ParametricPlot3D[ℒ[t],{t,-5,5},PlotStyleYellow]/.Line[pts_,rest___]:>Tube[pts,0.15,rest],​​Graphics3D[{Black,Ball[{0,20,0},0.3]}],Graphics3D[{Black,Ball[{10,0,0},0.3]}],​​Graphics3D[{Black,Ball[{15,-10,0},0.3]}],​​ParametricPlot3D
1
99
vCos[u],v+20,
1
99
vSin[u],{u,0,t1},{v,-25,25},PlotStyle->Directive[Opacity[0.4],Specularity[White,30]],MeshFalse,ColorFunction->"BlueGreenYellow",PerformanceGoal->"Quality",PlotPoints->40,​​ParametricPlot3Dv+10,
1
24
vCos[u],
1
24
vSin[u],{u,0,t1},{v,-15,10},PlotStyle->Directive[Opacity[0.4],Specularity[White,30]],MeshFalse,ColorFunction->"DeepSeaColors",PerformanceGoal->"Quality",PlotPoints->40,​​ParametricPlot3D[{2Cos[u]Sin[v],2Sin[u]Sin[v],2Cos[v]},{u,0,t1},{v,0,π},PlotStyle->Directive[Opacity[1],Specularity[White,30]],MeshFalse,PlotStyleRed,PerformanceGoal->"Quality"],​​ParametricPlot3D[{Cos[u]Sin[v]+5,Sin[u]Sin[v],Cos[v]},{u,0,t1},{v,0,π},PlotStyle->Directive[Opacity[1],Specularity[White,30]],MeshFalse,PlotStyleRed,PerformanceGoal->"Quality"],​​ParametricPlot3D
3
2
Cos[u]Sin[v],
3
2
Sin[u]Sin[v]+5,
3
2
Cos[v],{u,0,t1},{v,0,π},PlotStyle->Directive[Opacity[1],Specularity[White,30]],MeshFalse,PlotStyleRed,PerformanceGoal->"Quality",​​ContourPlot3D99
2
x
+99
2
y
+199
2
z
+200xy-970x-1020y+2175==0,x,-5
t1
2π
,25
t1
2π
,{y,-15,15},{z,-15,15},ContourStyle->Directive[Opacity[0.4],Specularity[White,30]],MeshFalse,ColorFunction->"FruitPunchColors",PerformanceGoal->"Quality",PlotPoints->40,​​AxesLabel->(Style[#,15,Blue]&/@{"X","Y","Z"}),AxesOrigin{0,0,0},AxesTrue,BoxedFalse,BoxRatiosAutomatic,PlotRange20,ImageSize900,ViewPoint{-3,3,2},Style["Monge's theorem in 3D:",Bold,Medium],{{t1,0.00002,"Value (t1)"},0.00001,2π,0.00001},ControlPlacementLeft
Out[]=
​
Monge's theorem in 3D:
Value (t1)
View from all angles (below):