Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
xmin = -3.6; xmax = 3.6;
p[x_] := 6 - Sqrt[6^2 - x^2] (* circle *)
p[x_] := x^2/7.5 (* parabola *)
img[t_, rays_] :=
Show[
Graphics[
{Thick, RGBColor[0.243, 0.62, 0.612],
Table[Line[{{xi, -t}, {xi, 20}}], {xi, xmin + 0.25, xmax - 0.25, (xmax - xmin - 0.5)/rays}],
Table[Line[{{xi, p[xi]}, {xi - t*((2*Derivative[1][p][xi])/(1 + Derivative[1][p][xi]^2)),
p[xi] + t*(-1 + 2/(1 + Derivative[1][p][xi]^2))} +
p[xi]*{(-2*Abs[t]*Derivative[1][p][xi])/(Sqrt[4*Abs[(t*Derivative[1][p][xi])/
(1 + Derivative[1][p][xi]^2)]^2 + Abs[t - (2*t)/(1 + Derivative[1][p][xi]^2)]^2]*
(1 + Derivative[1][p][xi]^2)), (-Abs[t] + (2*Abs[t])/(1 + Derivative[1][p][xi]^2))/
Sqrt[4*Abs[(t*Derivative[1][p][xi])/(1 + Derivative[1][p][xi]^2)]^2 +
Abs[t - (2*t)/(1 + Derivative[1][p][xi]^2)]^2]}}],
{xi, xmin + 0.25, xmax - 0.25, (xmax - xmin - 0.5)/rays}
]
}
],
Plot[
p[x], {x, xmin, xmax},
PlotStyle -> {RGBColor[{0.337, 0.314, 0.431}], Thick}, Filling -> -10, FillingStyle -> White
],
PlotRange -> {{xmin, xmax}, {-0.1, 7.1}}, Axes -> False, AspectRatio -> 1, Background -> White,
PlotRangeClipping -> True
]
Manipulate[img[t, rays], {{t, 3.4}, -6.15, 15}, {{rays, 7}, 2, 50, 2}]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment