BrianWeinstein

G = 1;
time = 20;
spScale = 8;

mA = 1.3;
xA0 = 0;
yA0 = 0;
zA0 = 0;
vxA0 = 0;
vyA0 = 0;

BrianWeinstein

x1[t_] := R1*Sin[\[Theta]1[t]]
y1[t_] := (-R1)*Cos[\[Theta]1[t]]
x2[t_] := R1*Sin[\[Theta]1[t]] + R2*Sin[\[Theta]2[t]]
y2[t_] := (-R1)*Cos[\[Theta]1[t]] - R2*Cos[\[Theta]2[t]]
v1[t_] := Sqrt[D[x1[t], t]^2 + D[y1[t], t]^2]
v2[t_] := Sqrt[D[x2[t], t]^2 + D[y2[t], t]^2]

T1[t_] := (1/2)*m1*v1[t]^2
T2[t_] := (1/2)*m2*v2[t]^2
U[t_] := m1*g*y1[t] + m2*g*y2[t]

BrianWeinstein

vs = 1; \[Lambda] = 25; 

dots[t_, vx_] := Flatten[Table[{vx*tt + (vs*(t - tt))*Cos[arg], 
    (vs*(t - tt))*Sin[arg]}, {tt, 0, t, vs*\[Lambda]}, 
    {arg, 0, 2*Pi, 0.1}], 1]
    (* To scale the SmoothDensityHistogram colors, use arg step 
    size .5/(t -tt/1.1) instead of 0.1 *)
    
wavefront[t_, vx_] := Graphics[{{Purple, Thick, 
    Table[Circle[{vx*tt, 0}, vs*(t - tt)], 

BrianWeinstein

Ueff[x_, y_, m1_, x1_, y1_, m2_, x2_, y2_] := 
  -((G*m1)/Sqrt[(x - x1)^2 + (y - y1)^2]) - 
   (G*m2)/Sqrt[(x - x2)^2 + (y - y2)^2] - (G*(m1 + m2)*(x^2 + y^2))/(2*Sqrt[(x1 - x2)^2 + (y1 - y2)^2]^3)
   
G = 1; m1 = 1; x1 = -1.25; y1 = 0; m2 = 0.45; x2 = 1.25; y2 = 0; 
 
L1 = {FindRoot[D[Ueff[x, 0, m1, x1, y1, m2, x2, y2], x], {x, 0.5}][[1,2]], 0}; 
L2 = {FindRoot[D[Ueff[x, 0, m1, x1, y1, m2, x2, y2], x], {x, 1.5}][[1,2]], 0}; 
L3 = {FindRoot[D[Ueff[x, 0, m1, x1, y1, m2, x2, y2], x], {x, -1.5}][[1,2]], 0}; 
L4 = FindRoot[{D[Ueff[x, y, m1, x1, y1, m2, x2, y2], x] == 0, 

BrianWeinstein

m = 1; xd = 1; yd = 2; zd = 3; Ix = (1/12)*m*(yd^2 + zd^2); 
Iy = (1/12)*m*(zd^2 + xd^2); Iz = (1/12)*m*(xd^2 + yd^2); 

soln = 
  NDSolve[
    {Ix*Derivative[2][\[Theta]x][t] == (Iy - Iz)*Derivative[1][\[Theta]y][t]*Derivative[1][\[Theta]z][t], 
     Iy*Derivative[2][\[Theta]y][t] == (Iz - Ix)*Derivative[1][\[Theta]z][t]*Derivative[1][\[Theta]x][t], 
     Iz*Derivative[2][\[Theta]z][t] == (Ix - Iy)*Derivative[1][\[Theta]x][t]*Derivative[1][\[Theta]y][t], 
     \[Theta]x[0] == 0, \[Theta]y[0] == 0, \[Theta]z[0] == 3*(Pi/2), Derivative[1][\[Theta]x][0] == 0, 
     Derivative[1][\[Theta]y][0] == 1, Derivative[1][\[Theta]z][0] == 0.0005}, 

BrianWeinstein

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}],

BrianWeinstein

nc = 15; nr = 3; 
cx = Table[ToExpression[StringJoin["cx", ToString[i]]], {i, 1, nc}]; 
cy = Table[ToExpression[StringJoin["cy", ToString[i]]], {i, 1, nc}]; 
rx = Table[ToExpression[StringJoin["rx", ToString[i]]], {i, 1, nr}]; 
ry = Table[ToExpression[StringJoin["ry", ToString[i]]], {i, 1, nr}]; 
coordList = Flatten[{Transpose[{cx, cy}], Transpose[{rx, ry}]}]; 
cspeed = 1; 
rspeed = 1.1; 

eqns = Flatten[

BrianWeinstein

(* Rutherford model *)

es[t_] := {{Cos[t + Pi], 2.5*Sin[t + Pi], 2*Sin[t + Pi]}, 
           {Cos[t + (4*Pi)/5], 2*Sin[t + (4*Pi)/5], -1.5*Sin[t + (4*Pi)/5]}, 
           {2*Sin[t + (3*Pi)/5], Cos[t + (3*Pi)/5], 2*Sin[t + (3*Pi)/5]}, 
           {2.5*Sin[t + (2*Pi)/5], Cos[t + (2*Pi)/5], -1.5*Sin[t + (2*Pi)/5]}}
Manipulate[Show[
    ParametricPlot3D[Evaluate[es[2*u]], {u, 0, 2*Pi}, PlotStyle -> Directive[Thick, Dotted]], 
    Graphics3D[
           {Specularity[White, 200], 

BrianWeinstein

x[n_, \[Theta]_] := 2*Cos[Pi/(2*n)]*Cos[(1/2)*(\[Theta] + (Pi/n)*(2*Floor[(n*\[Theta])/(2*Pi)] + 1))] - Cos[(Pi/n)*(2*Floor[(n*\[Theta])/(2*Pi)] + 1)]

y[n_, \[Theta]_] := 2*Cos[Pi/(2*n)]*Sin[(1/2)*(\[Theta] + (Pi/n)*(2*Floor[(n*\[Theta])/(2*Pi)] + 1))] - Sin[(Pi/n)*(2*Floor[(n*\[Theta])/(2*Pi)] + 1)]

reuRotate[n_, \[Phi]_] := 
  {pts[n, \[Phi]] = Table[RotationMatrix[\[Phi]] . {x[n, \[Theta]], y[n, \[Theta]]}, {\[Theta], 0, 2*Pi, (2*Pi)/100}]; 
   xmin = Min[pts[n, \[Phi]][[All,1]]]; 
   ymin = Min[pts[n, \[Phi]][[All,2]]];
   xmax = Max[pts[n, \[Phi]][[All,1]]]; 
   ymax = Max[pts[n, \[Phi]][[All,2]]]; 

BrianWeinstein

x[A1_, A2_, f1_, f2_, p1_, p2_, d1_, d2_, t_] := A1 Sin[t f1 + p1] E^(-d1 t) + A2 Sin[t f2 + p2] E^(-d2 t)
y[A3_, A4_, f3_, f4_, p3_, p4_, d3_, d4_, t_] := A3 Sin[t f3 + p3] E^(-d3 t) + A4 Sin[t f4 + p4] E^(-d4 t)
 
 
Manipulate[
 ParametricPlot[
  {x[A1, A2, f1, f2, p1, p2, d1, d2, t],
   y[A3, A4, f3, f4, p3, p4, d3, d4, t]},
  {t, 0, tmax},
  PlotPoints -> 200, Axes -> False, PlotStyle -> {Thick, Opacity[0.5]}, PlotRange -> All