Pelota rebotando sobre una Parábola

 Descargar como Notebook

Se deja caer una pelota sobre una parábola bajo la acción únicamente de la fuerza de gravedad, su trayectoria genera la envolvente lineal de una nueva parábola.

Primero se resuelve la Ecuación Diferencial de forma numérica.

Clear["Global`*"]

g = 9.81;

tmax = 15;

rebote = ReflectionTransform[{1, 2 x[t]}][{-x'[t], -y'[t]}];

solucion[x0_, y0_] := 

  NDSolveValue[{y''[t] == -g, x''[t] == 0, x'[0] == 0, y'[0] == 0, 

    x[0] == x0, y[0] == y0, 

    WhenEvent[

     y[t] == x[t]^2, {x'[t], y'[t]} -> Evaluate[rebote]]}, {x, y}, {t,

     0, tmax}];

Se elige el valor inicial desde el cual se deja caer la pelota.

{xf1, yf1} = solucion[0.402, 1.];(*Cambiar el punto inicial*)

graf3 = Plot[x^2, {x, -1, 1}, PlotStyle -> Red, 

   PlotRange -> {{-1, 1}, {-0.1, 1.2}}];

Manipulate[

 max = Max[

   Transpose[

     Select[Table[{xf1[n], yf1[n]}, {n, 0, 15, 0.001}], 

      Abs[#[[1]]] < 0.001 &]][[2]]]; 

 p[a_] := Fit[{{0, max}, {xf1[0], yf1[0]}, {-xf1[0], yf1[0]}}, {1, x, 

     x^2}, x] /. {x -> a}; 

 Show[graf3, 

  If[ttt == tmax, ParametricPlot[{xf1[t], yf1[t]}, {t, 0, ttt}], 

   graf3], If[pp, Plot[p[a], {a, -1, 1}, PlotStyle -> Green], graf3], 

  Graphics[{PointSize[0.03], Blue, Point[{xf1[ttt], yf1[ttt]}]}], 

  Ticks -> None, Background -> Black], {{ttt, 0.00001, "Inicio"}, 

  0.00001, tmax, Trigger, 

  DefaultDuration -> 15}, {{pp, False, "Parábola Interna"}, {False, 

   True}}]

Para aprender más sobre Mathematica ingrese aquí sitio de aprendizaje de Wolfram o en mi website ustamathematica.wixsite.com/basicas