Das Rollpendel

ClearAll[x1,x2,y1,y2,ϕ,t,T,m1,m2,V,L,g, LagGlen, LagGlenInit, parameter, initials, lsg]

1) Koordinaten

x1[t_]:=q1[t];
ϕ[t_]:= q2[t];
x2[t_]:=q1[t]+l*Sin[q2[t]];
y1[t_]:=0;
y2[t_]:=-l*Cos[q2[t]];

2) Lagrange-Funktion

2.1) kinetische Energie T

T[t_]=(m1/2)*(((((∂_t) x1[t]))^2)+((((∂_t) y1[t]))^2))+(m2/2)*(((((∂_t) x2[t]))^2)+((((∂_t) y2[t]))^2)) //FullSimplify

2.2) potentielle Energie V

V[t_]=m1*g*y1[t]+m2*g*y2[t] //FullSimplify

2.3) Lagrange - Funktion L

L[t_]=T[t]-V[t] //FullSimplify

3) Lagrange - Gleichungen

LagGlen={D[D[L[t],q1'[t]],t]-D[L[t],q1[t]]==0,
D[D[L[t],q2'[t]],t]-D[L[t],q2[t]]==0} //FullSimplify

4) Lösen der Lagrange - Gleichungen

(a);
parameter= {m1 -> 1, m2-> 1, l-> 1, g-> 10};
initials={q1[0]==0, q1'[0]==1, q2[0]==0, q2'[0]==0};

LagGlenInit=Flatten[{LagGlen, initials}]/.parameter

lsg=NDSolve[LagGlenInit,{q1[t],q2[t]},{t,0,10},MaxSteps->500000 ];

Plot[Evaluate[q1[t]/.lsg],{t,0,10},AxesLabel-> {t, x1},AxesOrigin-> {0,0}]
Plot[Evaluate[q2[t]/.lsg],{t,0,10},AxesLabel-> {t, ϕ},AxesOrigin-> {0,0}]
ParametricPlot[{q1[t],q2[t]}/.lsg,{t,0,10},AxesLabel-> {x1, ϕ},AspectRatio-> 0.5]
Animate[Evaluate[Graphics[{Line[{{0,0},{x1[t],y1[t]}}],Line[{{x1[t],y1[t]},{x2[t],y2[t]}}],Disk[{x1[t],y1[t]},0.3],Disk[{x2[t],y2[t]},0.3],{Blue,Disk[{0,0},0.2]}},PlotRange-> {{-10,10},{-10,10}}]/.parameter/.lsg],{t,0,10,0.01},AnimationRate-> 1]

(b);
parameter= {m1 -> 1, m2-> 1, l-> 1, g-> 10};
initials={q1[0]==0, q1'[0]==0, q2[0]==1, q2'[0]==0};

LagGlenInit=Flatten[{LagGlen, initials}]/.parameter

lsg=NDSolve[LagGlenInit,{q1[t],q2[t]},{t,0,10},MaxSteps->500000 ];

Plot[Evaluate[q1[t]/.lsg],{t,0,10},AxesLabel-> {t, x1},AxesOrigin-> {0,0}]
Plot[Evaluate[q2[t]/.lsg],{t,0,10},AxesLabel-> {t, ϕ},AxesOrigin-> {0,0}]
ParametricPlot[{q1[t],q2[t]}/.lsg,{t,0,10},AxesLabel-> {x1, ϕ},AspectRatio-> 0.5]
Animate[Evaluate[Graphics[{Line[{{0,0},{x1[t],y1[t]}}],Line[{{x1[t],y1[t]},{x2[t],y2[t]}}],Disk[{x1[t],y1[t]},0.3],Disk[{x2[t],y2[t]},0.3],{Blue,Disk[{0,0},0.2]}},PlotRange-> {{-10,10},{-10,10}}]/.parameter/.lsg],{t,0,10,0.01},AnimationRate-> 1]

(c);
parameter= {m1 -> 1, m2-> 100, l-> 1, g-> 10};
initials={q1[0]==0, q1'[0]==0, q2[0]==1, q2'[0]==0};

LagGlenInit=Flatten[{LagGlen, initials}]/.parameter

lsg=NDSolve[LagGlenInit,{q1[t],q2[t]},{t,0,10},MaxSteps->500000 ];

Plot[Evaluate[q1[t]/.lsg],{t,0,10},AxesLabel-> {t, x1},AxesOrigin-> {0,0}]
Plot[Evaluate[q2[t]/.lsg],{t,0,10},AxesLabel-> {t, ϕ},AxesOrigin-> {0,0}]
ParametricPlot[{q1[t],q2[t]}/.lsg,{t,0,10},AxesLabel-> {x1, ϕ},AspectRatio-> 0.5]
Animate[Evaluate[Graphics[{Line[{{0,0},{x1[t],y1[t]}}],Line[{{x1[t],y1[t]},{x2[t],y2[t]}}],Disk[{x1[t],y1[t]},0.3],Disk[{x2[t],y2[t]},0.3],{Blue,Disk[{0,0},0.2]}},PlotRange-> {{-10,10},{-10,10}}]/.parameter/.lsg],{t,0,10,0.01},AnimationRate-> 1]

(d);
parameter= {m1 -> 1, m2-> 1, l-> 1, g-> 10};
initials={q1[0]==0, q1'[0]==0, q2[0]==0, q2'[0]==1};

LagGlenInit=Flatten[{LagGlen, initials}]/.parameter

lsg=NDSolve[LagGlenInit,{q1[t],q2[t]},{t,0,10},MaxSteps->500000 ];

Plot[Evaluate[q1[t]/.lsg],{t,0,10},AxesLabel-> {t, x1},AxesOrigin-> {0,0}]
Plot[Evaluate[q2[t]/.lsg],{t,0,10},AxesLabel-> {t, ϕ},AxesOrigin-> {0,0}]
ParametricPlot[{q1[t],q2[t]}/.lsg,{t,0,10},AxesLabel-> {x1, ϕ},AspectRatio-> 0.5]
Animate[Evaluate[Graphics[{Line[{{0,0},{x1[t],y1[t]}}],Line[{{x1[t],y1[t]},{x2[t],y2[t]}}],Disk[{x1[t],y1[t]},0.3],Disk[{x2[t],y2[t]},0.3],{Blue,Disk[{0,0},0.2]}},PlotRange-> {{-10,10},{-10,10}}]/.parameter/.lsg],{t,0,10,0.01},AnimationRate-> 1]

(e);
parameter= {m1 -> 1, m2-> 10, l-> 1, g-> 10};
initials={q1[0]==0, q1'[0]==0, q2[0]==0, q2'[0]==1};

LagGlenInit=Flatten[{LagGlen, initials}]/.parameter

lsg=NDSolve[LagGlenInit,{q1[t],q2[t]},{t,0,10},MaxSteps->500000 ];

Plot[Evaluate[q1[t]/.lsg],{t,0,10},AxesLabel-> {t, x1},AxesOrigin-> {0,0}]
Plot[Evaluate[q2[t]/.lsg],{t,0,10},AxesLabel-> {t, ϕ},AxesOrigin-> {0,0}]
ParametricPlot[{q1[t],q2[t]}/.lsg,{t,0,10},AxesLabel-> {x1, ϕ},AspectRatio-> 0.5]
Animate[Evaluate[Graphics[{Line[{{0,0},{x1[t],y1[t]}}],Line[{{x1[t],y1[t]},{x2[t],y2[t]}}],Disk[{x1[t],y1[t]},0.3],Disk[{x2[t],y2[t]},0.3],{Blue,Disk[{0,0},0.2]}},PlotRange-> {{-10,10},{-10,10}}]/.parameter/.lsg],{t,0,10,0.01},AnimationRate-> 1]

(f);
parameter= {m1 -> 1, m2-> 1, l-> 1, g-> 10};
initials={q1[0]==0, q1'[0]==1, q2[0]==1, q2'[0]==0};

LagGlenInit=Flatten[{LagGlen, initials}]/.parameter

lsg=NDSolve[LagGlenInit,{q1[t],q2[t]},{t,0,10},MaxSteps->500000 ];

Plot[Evaluate[q1[t]/.lsg],{t,0,10},AxesLabel-> {t, x1},AxesOrigin-> {0,0}]
Plot[Evaluate[q2[t]/.lsg],{t,0,10},AxesLabel-> {t, ϕ},AxesOrigin-> {0,0}]
ParametricPlot[{q1[t],q2[t]}/.lsg,{t,0,10},AxesLabel-> {x1, ϕ},AspectRatio-> 0.5]
Animate[Evaluate[Graphics[{Line[{{0,0},{x1[t],y1[t]}}],Line[{{x1[t],y1[t]},{x2[t],y2[t]}}],Disk[{x1[t],y1[t]},0.3],Disk[{x2[t],y2[t]},0.3],{Red,Disk[{0,0},0.2]}},PlotRange-> {{-10,10},{-10,10}}]/.parameter/.lsg],{t,0,10,0.01},AnimationRate-> 1]

(g);
parameter= {m1 -> 1, m2-> 1, l-> 1, g-> 10};
initials={q1[0]==0, q1'[0]==0, q2[0]==1, q2'[0]==1};

LagGlenInit=Flatten[{LagGlen, initials}]/.parameter

lsg=NDSolve[LagGlenInit,{q1[t],q2[t]},{t,0,10},MaxSteps->500000 ];

Plot[Evaluate[q1[t]/.lsg],{t,0,10},AxesLabel-> {t, x1},AxesOrigin-> {0,0}]
Plot[Evaluate[q2[t]/.lsg],{t,0,10},AxesLabel-> {t, ϕ},AxesOrigin-> {0,0}]
ParametricPlot[{q1[t],q2[t]}/.lsg,{t,0,10},AxesLabel-> {x1, ϕ},AspectRatio-> 0.5]
Animate[Evaluate[Graphics[{Line[{{0,0},{x1[t],y1[t]}}],Line[{{x1[t],y1[t]},{x2[t],y2[t]}}],Disk[{x1[t],y1[t]},0.3],Disk[{x2[t],y2[t]},0.3],{Green,Disk[{0,0},0.2]}},PlotRange-> {{-10,10},{-10,10}}]/.parameter/.lsg],{t,0,10,0.01},AnimationRate-> 1]