1
$\begingroup$

How can we show the paths of three light beams in Mathematica which bounce back after hitting the parabola, in a single plot? Suppose we have the following code

Clear[f, x]; 
f[x_] = x^2/8; 
{x[t_], y[t_]} = {t, f[t]}; 
parabola = ParametricPlot[{x[t], y[t]}, {t, -4, 4}, PlotStyle -> {{Blue, Thickness[0.01]}}, AxesLabel -> {"x", "y"}];

Clear[beam]; 
beam[t_] := Vector[{x[t], y[t]} - {x[t], 6}, Tail -> {x[t], 6}, VectorColor -> Red]; 
Show[parabola, beam[1], beam[2], beam[3], PlotRange -> All]
| improve this question | | | | |
$\endgroup$
  • 4
    $\begingroup$ Your code doesn't run. It is unclear what Vector is because it isn't a built-in function. Please also define parabola. $\endgroup$ – C. E. May 26 '19 at 7:43
  • $\begingroup$ Now I think it would work. $\endgroup$ – Khuram Shahzad May 26 '19 at 7:55
  • $\begingroup$ see Wolfram Demonstrations >> Reflection in a Parabolic Mirror $\endgroup$ – kglr May 26 '19 at 8:27
  • $\begingroup$ In that Demonstration, all three rays emerge from a single source. Here I have three different sources. $\endgroup$ – Khuram Shahzad May 26 '19 at 8:42
  • 1
    $\begingroup$ The demonstrations are often "cute" and show off the skill of the person who created the demonstration to display a graphical result, but they often do not include material in a form that is easy to take and use for other purposes. At best it sometimes seem they let you know something is possible. But to incorporate the ideas into another project seems to often require reverse engineering to try to recover the thought process used so that you can implement a solution to a different problem. If the demonstrations were encouraged to include usable code at the bottom they might be more useful. $\endgroup$ – Bill May 26 '19 at 18:52
2
$\begingroup$

From point from with direction direction onto the parabola f The incident beam is in blue, the reflected in green and the normal is dashed red.

Clear[beam];
beam[from_, direction_, parabola_] := Module[{lambda, p, x, y, solx, dir = direction/Norm[direction], normal, vref}, 
solx = Solve[dir[[1]] parabola[x] == from[[2]] dir[[1]] + (x - from[[1]]) dir[[2]], x]; 
If[Abs[dir[[1]]] > 0.00001,
  lambda = Max[(x - from[[1]])/dir[[1]] /. solx], 
  lambda = Max[(parabola[x] - from[[2]])/dir[[2]] /. solx]
]; 
x = from[[1]] + lambda dir[[1]];
normal = {-D[parabola[y], y], 1} /. {y -> x};
normal = normal/Norm[normal];
vref = 2 normal + dir;
vref = vref/Norm[vref];
Return[{{x, parabola[x]}, vref, normal, lambda}]
]


f[x_] = x^2/8;
{x[t_], y[t_]} = {t, f[t]};
gr0 = ParametricPlot[{x[t], y[t]}, {t, -4, 4}, PlotStyle -> {{Blue, Thickness[0.02]}}, AxesLabel -> {"x", "y"}];

from = {1, 8};
direction = {1, -4};
parabola = f;
{int, vref, normal, lambda} = beam[from, direction, f]
gr1 = ParametricPlot[from + mu direction/Norm[direction], {mu, 0, lambda}, PlotStyle -> Blue];
gr2 = ParametricPlot[int + mu vref, {mu, 0, lambda}, PlotStyle -> Green];
gr3 = ParametricPlot[int + mu normal, {mu, 0, lambda}, PlotStyle -> {Red, Dashed}];
Show[gr1, gr2, gr3, gr0, PlotRange -> {{-4, 4}, {0, 8}}]

enter image description here

| improve this answer | | | | |
$\endgroup$
2
$\begingroup$

I upvoted Cesareo's answer, but I thought demonstrating the reflection property of a parabola deserves a cute toy for the purpose:

DynamicModule[{foc = {0, 2}, source = {-2, 2}, target = {2, 1/2}}, 
              Dynamic[Show[Plot[With[{a = Last[foc]}, (x^2)/(4 a)], {x, -6, 6}, 
                                AspectRatio -> Automatic, PlotRange -> {0, 6}], 
                           Graphics[{{Directive[Arrowheads[Small], AbsoluteDashing[{5, 5}], 
                                                Magenta], 
                                      Dynamic[Arrow[{source, target}], 
                                              TrackedSymbols :> {source, target}], 
                                      Dynamic[Arrow[{target, 
                                                     target + Norm[source - target]
                                                     Normalize[source - target - 
                                                               2 Projection[source - target,
                                                                            {2 Last[foc],
                                                                             First[target]}]]}]]},
                                     {Directive[AbsolutePointSize[6], Blue], 
                                      Dynamic[Point[source], TrackedSymbols :> {source}], 
                                      Locator[Dynamic[source, TrackedSymbols :> {source}], 
                                              Appearance -> None]},
                                     {Directive[AbsolutePointSize[6], Blue], 
                                      Dynamic[Point[target], TrackedSymbols :> {target}], 
                                      Locator[Dynamic[target,
                                              (target = With[{u = First[#]},
                                                             {u, (u^2)/(4 Last[foc])}];) &, 
                                                      TrackedSymbols :> {foc, target}], 
                                                      Appearance -> None]},
                                     {Directive[AbsolutePointSize[8], Red], 
                                      Dynamic[Point[foc], TrackedSymbols :> {foc}], 
                                      Locator[Dynamic[foc, (foc = {0, Max[0, Last[#]]}; 
                                              target = With[{u = First[target]},
                                                            {u, (u^2)/(4 Last[foc])}];) &, 
                                                      TrackedSymbols :> {foc, target}],
                                                      Appearance -> None]}}], 
                                    Method -> {"AxesInFront" -> False}]]]

reflection on a parabola

Here, you can adjust the position of the red dot (the focus) to change the parabola, and the two blue dots define the ray to be reflected by the parabola.

The key formula here relies on the proper application of Projection[] for computing the position of the reflected ray. Here is a simpler demonstration of the formula:

With[{source = {-2, 1}/3, target = AngleVector[π/6]/4, direction = AngleVector[π/6]}, 
     Graphics[{{AbsoluteThickness[4], InfiniteLine[{0, 0}, direction]},
               {AbsoluteDashing[{5, 5}], InfiniteLine[target, Cross[direction]]},
               Arrow[{source, target}], 
               Arrow[{target, target + Norm[source - target]
                                       Normalize[source - target -
                                                 2 Projection[source - target,
                                                              direction]]}]}, 
              PlotRange -> 1]]

reflection over a line

Going back to the parabola, I encourage you, the reader, to look at what happens in the following two situations:

  1. The movable arrow is oriented vertically
  2. The movable arrow passes through the red dot
| improve this answer | | | | |
$\endgroup$
0
$\begingroup$

This works, but it's not clear if you want also handle the case where beams are not parallel to y-axis.

Clear[f, parabola, beam];
f[x_] = x^2/8;
parabola = 
  Plot[f[t]}, {t, -4, 4}, 
   PlotStyle -> {{Blue, Thickness[0.01]}}, AxesLabel -> {"x", "y"}];
beam[x_] := Module[{yc = f[x], m = RotationMatrix[2 ArcTan[f'[x]]]},
   {Line[{{x, 6}, {x, yc}}], Line[{{x, yc}, {x, yc} + m.{0, 6}}]}
   ];
Show[parabola, Table[Graphics[beam[i]], {i, 1, 2, 0.5}], 
 PlotRange -> All]```
| improve this answer | | | | |
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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