HA5 A13: Geschachtelte Oszillatoren

by Jan Totz, jantotz@itp.tu.berlin.de

Berechnung

lagrangianEquations[kin_,pot_,Q_:0,genCoords_List]:=Module[
{L=kin-pot},
(D[D[L,D[#,t]],t] == Q + D[L,#])& /@ genCoords
];

genCoords0={s,x};
genCoords=#[t]&/@genCoords0;
Clear[m,mm,km,kmm,g,α];
kin=mm/2 s'[t]^2+m/2(x'[t]^2+s'[t]^2)+m x'[t]s'[t]Cos[α];
pot=-(mm+m)g s[t] Sin[α]+0.5kmm s[t]^2+km x[t]^2;

lagrangianEquations[kin,pot,0,genCoords]

tfinal=20.0;
{m,mm,km,kmm,g,α}={1.0,1.0,1.0,1.0,9.81,π/8};
ic={s[0]==1.0,s'[0]==0.0,x[0]==0.0,x'[0]==1.0};
sol=NDSolve[{lagrangianEquations[kin,pot,0,genCoords],ic},genCoords0,{t,0,tfinal}];

Plot der Dynamik

ParametricPlot[{Evaluate[{s[t] Cos[α],-s[t] Sin[α]}/.sol],Evaluate[{s[t] Cos[α]+x[t],-s[t] Sin[α]}/.sol]},{t,0,tfinal},ImageSize->500,PlotRange->{{-1,15},{-6,0}},Frame->True,FrameLabel->{"x","y"},LabelStyle->Directive[Black,18]]

Animation der Schwerpunktsbewegung

Manipulate[
Show[
ParametricPlot[{Evaluate[{s[t] Cos[α],-s[t] Sin[α]}/.sol],Evaluate[{s[t] Cos[α]+x[t],-s[t] Sin[α]}/.sol]},{t,0,tt},ImageSize->1000,PlotRange->{{-1,15},{-6,0}},Frame->True,FrameLabel->{"x","y"},RotateLabel->False,LabelStyle->Directive[Black,24],PerformanceGoal->"Quality"],
Graphics[{ColorData[97,1],Disk[#[[1;;2]],0.1],ColorData[97,2],Disk[#[[3;;4]],0.1]}]&@Evaluate[{s[tt] Cos[α],-s[tt] Sin[α],s[tt] Cos[α]+x[tt],-s[tt] Sin[α]}/.sol][[1]]
]
,{{tt,0.1,"time t"},0.1,tfinal,0.001,Appearance->"Open",AnimationRate->1},TrackedSymbols:>{tt}]

Animation der Blockbewegung

{dxa,dya,dxb,dyb}={6.0,4.0,0.5,0.5};
Manipulate[
Show[
(*Graphics[{White,EdgeForm[{Black,AbsoluteThickness[1]}],Rotat3[Rectangle[{x0-0.5dx,y0+0.08(*-0.5dy*)},{x0+0.5dx,y0+(*0.5*)dy+0.08}],-α ],*)
Graphics[{White,EdgeForm[{Black,AbsoluteThickness[1]}],
Rotate[Rectangle[{#[[1]]-0.5dxa,#[[2]]+0.2},{#[[1]]+0.5dxa,#[[2]]+dya+0.2}],-α ],
Rectangle[{#[[3]]-0.5dxb,#[[4]]+0.2+0.5dya-0.5dyb},{#[[3]]+0.5dxb,#[[4]]+0.5dya+0.5dyb+0.2}],
Black,
Line[{{(#[[4]]+0.5dyb-#[[2]])/Tan[90°-α]-0.5 1.08dxa+#[[1]],(#[[4]]+0.5dya+0.5dyb+0.2)},{(#[[4]]+0.5dyb-#[[2]])/Tan[90°-α]+0.5 1.08dxa+#[[1]],(#[[4]]+0.5dya+0.5dyb+0.2)}}],
Line[{{(#[[4]]-0.5dyb-#[[2]])/Tan[90°-α]-0.5 1.08dxa+#[[1]],(#[[4]]+0.5dya-0.5dyb+0.2)},{(#[[4]]-0.5dyb-#[[2]])/Tan[90°-α]+0.5 1.08dxa+#[[1]],(#[[4]]+0.5dya-0.5dyb+0.2)}}],
Line[{{-3,3Tan[α]},{7.5/Tan[α],-7.5},{-3,-7.5},{-3,3Tan[α]}}]
(*,Line[{{-3,3Tan[α]},{-3,6}}],
Line[{{-3,3Tan[α]+0.5dya+0.2},{#[[1]]-0.5dxa,5}}]*)
},ImageSize->1000,
PlotRange->{{-5,20},{-8,7}},Frame->True,FrameLabel->{"x","y"},RotateLabel->False,LabelStyle->Directive[Black,24]]
(*Plot[Tan[90°-α](x+0.5 1.08 dxa(*0.5Sqrt[dxa^2+dya^2]Cos[ArcTan[dya/dxa]-α]*)-#[[1]])+#[[2]]+0.5dya+0.2,{x,-3,20}],
Plot[Tan[90°-α](x-0.5 1.08dxa-#[[1]])+#[[2]]+0.5dya+0.2,{x,-3,20}]*)
(*ParametricPlot[{Evaluate[{s[t] Cos[α],-s[t] Sin[α]}/.sol],Evaluate[{s[t] Cos[α]+x[t],-s[t] Sin[α]}/.sol]},{t,0,tt},ImageSize->1000,PlotRange->{{-1,15},{-6,0}},Frame->True,FrameLabel->{"x","y"},RotateLabel->False,LabelStyle->Directive[Black,24],PerformanceGoal->"Quality"],*)
(*,Graphics[{ColorData[97,1],Disk[#[[1;;2]],0.1],ColorData[97,2],Disk[#[[3;;4]],0.1]}]*)
]&@Evaluate[{s[tt] Cos[α],-s[tt] Sin[α],s[tt] Cos[α]+x[tt],-s[tt] Sin[α]}/.sol][[1]]
,{{tt,0.1,"time t"},0.1,tfinal,0.001,Appearance->"Open",AnimationRate->1},TrackedSymbols:>{tt}]

Feder Animation (unfertig)

With[{stretch=2,revs=8},

ParametricPlot[
{
.1 stretch (2 t revs-Sin[2 π t revs+π/2])+.1 stretch,
(1-Cos[2 π t revs+π/2])
}
,{t,0,1}]]

spring2D[start_,end_,loops_,radius_]:=Module[{detail=40,steps},
steps=detail (loops+.5);
Translate[Rotate[Line@Table[{radius+(Norm[end-start]-2 radius) a/steps+radius Cos[2 Pi a/detail+Pi],4radius Sin[2 Pi a/detail]},{a,0,steps}],{{1,0},end-start}],start]]


(*spring2D[start_,end_,loops_,radius_]:=Module[{detail=40,steps},
steps=detail (loops+.5);
stretch=10;
Translate[Rotate[Line@Table[{.1 stretch ((Norm[end-start]-2 radius) a/steps-radius Sin[2 π a/detail +π/2])+.1 stretch,2radius (1-Cos[2 π a/detail +π/2])},{a,0,steps}],{{1,0},end-start}],start]]
*)

Manipulate[Graphics[spring2D[p1,p2,loops,radius],PlotRange->5],{{p1,{-2,0}},Locator},{{p2,{2,0}},Locator},{{loops,8},4,20,1},{{radius,.2},.2,2}]