In[]:=
OrthopticCurveEllipse::usage="It is the geometric locus of the intersection point of two tangent lines to a curve and orthogonal to each other. References: Personal.";
Development:
Obtaining the cartesian equation from the orthoptic curve to the parabola (observe that quadratic terms form a perfect square trinomiam, there is no doubt that it is a conical of the parabola gender):
In[]:=
4
2
x
-4xy+
2
y
-4x-8y-4==0;​​y-
y
0
==m(x-
x
0
);​​y==
y
0
+mx-m
x
0
;​​4
2
x
-4x(
y
0
+mx-m
x
0
)+
2
(
y
0
+mx-m
x
0
)
-4x-8(
y
0
+mx-m
x
0
)-4==0;​​Expand[4
2
x
-4x(
y
0
+mx-m
x
0
)+
2
(
y
0
+mx-m
x
0
)
-4x-8(
y
0
+mx-m
x
0
)-4==0]
Out[]=
-4-4x-8mx+4
2
x
-4m
2
x
+
2
m
2
x
+8m
x
0
+4mx
x
0
-2
2
m
x
x
0
+
2
m
2
x
0
-8
y
0
-4x
y
0
+2mx
y
0
-2m
x
0
y
0
+
2
y
0
0
In[]:=
-4-4x-8mx+4
2
x
-4m
2
x
+
2
m
2
x
+8m
x
0
+4mx
x
0
-2
2
m
x
x
0
+
2
m
2
x
0
-8
y
0
-4x
y
0
+2mx
y
0
-2m
x
0
y
0
+
2
y
0
0;​​(4-4m+
2
m
)
2
x
+-4-8m+4m
x
0
-2
2
m
x
0
-4
y
0
+2m
y
0
x-4+8m
x
0
+
2
m
2
x
0
-8
y
0
-2m
x
0
y
0
+
2
y
0
==0;
Due to the condition of tangency, the discriminant must be zero:
In[]:=
SimplifyExpand
2
-4-8m+4m
x
0
-2
2
m
x
0
-4
y
0
+2m
y
0

-4(4-4m+
2
m
)-4+8m
x
0
+
2
m
2
x
0
-8
y
0
-2m
x
0
y
0
+
2
y
0
==0
Out[]=
1+
2
m
+(-2+m)m
x
0
(-2+m)
y
0
In[]:=
1+
2
m
+(-2+m)m
x
0
(-2+m)
y
0
;​​(1+
x
0
)
2
m
+(-2
x
0
-
y
0
)m+2
y
0
+1==0;
By Vieta’s theorem:
In[]:=
m
1
m
2
==
c
a
;
Due to the perpendicularity condition:
In[]:=
2
y
0
+1
1+
x
0
==-1;​​
x
0
+2
y
0
+2==0;​​x+2y+2==0;
The orthoptic “curve” as expected, corresponds to the directrix of the parabola.
Animation:
In[]:=
Manipulate​​Module{p,slopes,m1,m2,t1Line,t2Line},​​​​p=t1,-
t1
2
+1;​​​​slopes=m/.Solve[​​(1+p[[1]])
2
m
+(-2p[[1]]-p[[2]])m+2p[[2]]+1==0,​​m​​]//Simplify;​​​​{m1,m2}=slopes;​​​​t1Line[x_]:=p[[2]]+m1(x-p[[1]]);​​t2Line[x_]:=p[[2]]+m2(x-p[[1]]);​​​​Show​​​​ContourPlot[4
2
x
-4xy+
2
y
-4x-8y-4==0,{x,-6,6},{y,-6,6},PerformanceGoal->"Quality",PlotPoints60,ContourStyle->{Blue,Thick}],​​ParametricPlotx,-
x
2
+1,{x,-6,t1},​​ColorFunction->Function[{x,y,u},ColorData["BlueGreenYellow"][u]],​​ColorFunctionScaling->True​​,​​Plot[t1Line[x],{x,-6,6},PlotStyle->Black],​​Plot[t2Line[x],{x,-6,6},PlotStyle->Black],​​Graphics[{​​Black,PointSize[0.01],Point[p],​​Text[Style["P",14,Bold],p,{0,-1.2}]​​}]​​,​​AspectRatio->Automatic,​​Axes->True,​​AxesOrigin->{0,0},​​AxesLabel->{x,y},​​PlotRange->6,​​ImageSize->900​​​​,​​{{t1,-6+0.00002,"Value t1"},-6+0.000001,6,0.00001},SaveDefinitions->True​​
Out[]=
​
Value t1