3
$\begingroup$

The code below is an attempt to obtain the graph of a parabola from two pieces of information: a focus and a directrix. I am not able to get the correct graphical shape of the parabola. I appreciate any help.

focus = {1, -2};directrixEquation = 3 x - 4 y + 7 == 0; directrix = Solve[directrixEquation, y][[1, 1, 2]];

vertexX = (focus[[1]] + directrix[[1]])/2;vertexY = (focus[[2]] + directrix[[2]])/2;vertex = {vertexX, vertexY};

a = 1/(4 (focus[[2]] - vertexY));h = vertex[[1]]; k = vertex[[2]];parabolaEquation = y == a (x - h)^2 + k;

roots = x /. Solve[parabolaEquation, x];axisOfSymmetry = x == h;distanceFocusToAxis = Abs[h - focus[[1]]];

Print["Focus: ", focus];Print["Directrix: y = ", directrix];Print["Vertex: ", vertex];Print["Parabola Equation: ", parabolaEquation];Print["Roots of the Function: ", roots];Print["Axis of Symmetry: ", axisOfSymmetry];Print["Distance from the Focus to the Axis of Symmetry: ", distanceFocusToAxis];

Plot[Evaluate[y /. Solve[parabolaEquation, y]], {x, -10, 10}, PlotRange -> {-10, 10}, Epilog -> {Red, PointSize[Large], Point[focus],Line[{{-10, directrix /. x -> -10}, {10, directrix /. x -> 10}}]}]
$\endgroup$
3
  • 2
    $\begingroup$ "I don’t believe I’m having success" - it would be much more productive if you could pinpoint exactly what you think the problem is, what output you get that you think is incorrect, what errors you get if any, etc. Otherwise you are asking us to do your own troubleshooting for you. $\endgroup$
    – MarcoB
    Apr 11 at 20:11
  • $\begingroup$ You are right, it was not really clear what kind of help I need. I have already edited the post to be more specific. $\endgroup$ Apr 11 at 20:39
  • $\begingroup$ The result of Solve[directrixEquation, y][[1, 1, 2]] is 1/4 (7 + 3 x), so directrix[[1]] is 1/4 and directrix[[2]] is 7 + 3 x. Is this what you meant to do? $\endgroup$
    – MelaGo
    Apr 11 at 21:09

3 Answers 3

6
$\begingroup$

The distance from the point {x,y} to the focus is equal to the distance from the point {x,y} to the line 3 x - 4 y + 7 == 0

Clear["Global`*"];
focus = {1, -2};
directrixEquation = 3  x - 4  y + 7 == 0;
eqn = RegionDistance[Point@focus]@{x, y} == 
   RegionDistance[ImplicitRegion[directrixEquation, {x, y}]]@{x, y};
parabola = 
 First@SubtractSides[
   ApplySides[#^2 &, eqn] // ComplexExpand // Simplify]
ContourPlot[parabola == 0, {x, -10, 10}, {y, -10, 10}, 
 ContourStyle -> Cyan, 
 Epilog -> {Red, Point[focus], 
   First@ContourPlot[directrixEquation, {x, -10, 10}, {y, -10, 10}, 
     ContourStyle -> Blue]}]

76 - 92 x + 16 x^2 + 156 y + 24 x y + 9 y^2.

Since for a*x^2+b*x*y+c*y^2+d*x+e*y+ f ==0 with a = 16; b = 24; c = 9; d = -92; e = 156; f = 76;, Det[{{a, b/2}, {b/2, c}}] == 0, according to https://en.wikipedia.org/wiki/Conic_section, the equation represents a parabola.

enter image description here

$\endgroup$
2
$\begingroup$

This is a partial "answer" to get you started. Play around with these ideas and if you are still stuck, then ask more specific questions.

You can play with the underlying geometric semantics directly with Mathematica constructs. For example, given your directrix equation

directrixEquation = 3  x - 4  y + 7 == 0

you can construct a "native" representation that can be displayed in graphics and can be treated as a region.

samplePoints =
  With[
    {xsamples = {0, 1}},
    Transpose[{xsamples, Flatten[SolveValues[#, y] & /@ Thread[directrixEquation /. x -> xsamples]]}]]
(* {{0, 7/4}, {1, 5/2}} *)

directrix = InfiniteLine[samplePoints]
(* InfiniteLine[{{0, 7/4}, {1, 5/2}}] *)

Now, with your focus,

focus = {1, -2}

you can visualize what we have so far:

Graphics[{Red, PointSize[.03], Point[focus], Blue, directrix}, Axes -> True]

enter image description here

You probably want to find the vertex next. The vertex will be halfway between the focus and the directrix, so we can start by finding the nearest point on the directrix to the focus:

directrixNearest = RegionNearest[directrix, focus]
(* {-29/25, 22/25} *)

And so, the vertex would be

vertex = Mean[{focus, directrixNearest}]
(* {-2/25, -14/25} *)

What we have so far:

Graphics[
  {Red, PointSize[.03], Point[focus], 
   Blue, directrix, Point[directrixNearest], 
   Green, Point[vertex]}, 
  Axes -> True]

enter image description here

$\endgroup$
1
  • $\begingroup$ Thank you very much for the information. It definitely filled some gaps and with a little more study of Analytical Geometry, I managed to solve my problem. Thank you. $\endgroup$ Apr 11 at 22:40
0
$\begingroup$

In the following I will use OP (as well as other examples):

focus = {1, -2}; directrix = 3  x - 4  y + 7 == 0

Deriving parabola

In the following code:

  • the closest point from arbitrary point p to line (q) is found by cp (the line is entered as a x + b y ==0
  • para derives the parabola by finding equation for points whose squared distance from directrix equals the squared distance to focus.
  • ContourPlot is used to plot the parabola

The code

 cp[q_, p_] := {a, b} /. 
      Solve[{({-1, 1} Reverse@Coefficient[q[[1]], {x, y}]) . (p - {a, 
              b}) == 0, (q[[1]] /. {x -> a, y -> b}) == 0}, {a, b}][[1]]
    para[q_, f_] := Module[{i, v1, v2, xp},
          i = cp[q, {u, v}];
          v1 = {u, v} - i;
          v2 = {u, v} - f;
          xp = FullSimplify[Expand /@ (v1 . v1 == v2 . v2)] // Expand;
          ContourPlot[{xp, Evaluate[(q /. {x -> u, y -> v})]}, {u, -10, 
            10}, {v, -10, 10}, Epilog -> Point[f], 
           PlotLabel -> 
            Grid[{{"Directrix", q}, {"Focus", f}, {"Parabola", xp}}], 
           Axes -> True]]

Note:

  • equation for line assumed to be entered as a x+ b y== 0 (includes possibility of a=0 xor b=0)

  • this was done quickly, can be obviously better and other stylistic and formatting choices made

Some examples:

Grid[{{para[directrix, focus], para[y + 1/4 == 0, {0, 1/4}]},
  {para[x + y == 0, {2, 3}], para[x + 1 == 0, {1, 0}]}
  }, Frame -> All, ItemSize -> 20]

enter image description here

Just for fun:

enter image description here

Manipulate[
 param[3 x - 4 y + 7 == 0, p], {{p, {1, 1}}, Locator, 
  Appearance -> ""} , 
 Initialization :> (cpm[q_, p_] := {a, b} /. 
     Solve[{({-1, 1} Reverse@Coefficient[q[[1]], {x, y}]) . (p - {a, 
             b}) == 0, (q[[1]] /. {x -> a, y -> b}) == 0}, {a, b}][[
      1]];
   param[q_, f_] := Module[{i, v1, v2, xp},
     i = cp[q, {u, v}];
     v1 = {u, v} - i;
     v2 = {u, v} - f;
     xp = FullSimplify[Expand /@ (v1 . v1 == v2 . v2)] // Expand;
     Column[{ContourPlot[{xp, 
         Evaluate[(q /. {x -> u, y -> v})]}, {u, -10, 10}, {v, -10, 
         10}, Epilog -> {Red, PointSize[0.02], Point[f]}, 
        PlotLabel -> Grid[{{"Directrix", q}, {"Focus", f}}], 
        Axes -> True, PerformanceGoal -> "Quality", ImageSize -> 300],
        xp}, ItemSize -> 100]]), SaveDefinitions -> True]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.