File:Quadruple pendulum normal modes.gif
Quadruple_pendulum_normal_modes.gif (800 × 398 pixel, dimensione del file: 4,69 MB, tipo MIME: image/gif, ciclico, 501 frame, 50 s)
Nota: a causa di limitazioni tecniche, le miniature delle immagini GIF ad alta risoluzione come questa non saranno animate.
Questo file e la sua pagina di descrizione (discussione · modifica) si trovano su Wikimedia Commons (?) |
Dettagli
DescrizioneQuadruple pendulum normal modes.gif |
English: A quadruple pendulum has 4 degrees of freedom and thus 4 "orthogonal" modes. If the system was linear, those modes would be truly orthogonal and wouldn't interact. But since this is a non-linear system, the modes are coupled and can exchange energy. |
Data | |
Fonte | https://twitter.com/j_bertolotti/status/1493969051659517956 |
Autore | Jacopo Bertolotti |
Licenza (Riusare questo file) |
https://twitter.com/j_bertolotti/status/1030470604418428929 |
Mathematica 13.0 code
npendula = 4; (*In principle the code can run with any number of pendula, but some minor adjustments might be needed here and there to be sure to select the right frequencies etc.*)
\[Theta] = ToExpression[ StringJoin["\[Theta]", #] & /@ Evaluate[ToString /@ Range[npendula]]];
l = ToExpression[StringJoin["l", #] & /@ Evaluate[ToString /@ Range[npendula]]];
m = ToExpression[StringJoin["m", #] & /@ Evaluate[ToString /@ Range[npendula]]];
g =.;
p = {0, 0};
pos = Reap[For[j = 1, j <= npendula, j++,
p = p + l[[j]] {Sin[\[Theta][[j]][t]], -Cos[\[Theta][[j]][t]]};
Sow[p];
]][[2, 1]];
vel = D[#, t] & /@ pos;
T = FullSimplify[Sum[m[[j]]/2 (vel[[j, 1]]^2 + vel[[j, 2]]^2), {j, 1, npendula}] ];
V = g Sum[m[[j]] *pos[[j, 2]], {j, 1, npendula}];
L = T - V; (*Lagrangian of the system*)
eq = Flatten[Table[
FullSimplify[
(D[D[L, Evaluate[D[\[Theta][[j]][t], t]] ], t] -
D[L, \[Theta][[j]][t] ]) == 0
]
, {j, 1, npendula}] ] /. {Join[{ g -> 1},
Table[l[[j]] -> 1, {j, 1, npendula}],
Table[m[[j]] -> 1, {j, 1, npendula}]]}; (*Equations of motion*)
L1 = (Normal@Series[(L /. Flatten@Join[
Table[{\[Theta][[j]][t] -> \[Epsilon] \[Theta][[j]][t]}, {j,
1, npendula}]
,
Table[{\[Theta][[j]]'[
t] -> \[Epsilon] \[Theta][[j]]'[t]}, {j, 1, npendula}]
]), {\[Epsilon], 0, 2}]) /. {\[Epsilon] -> 1}; (*Linearized Lagrangian*)
eq1 = Table[
FullSimplify[
(D[D[L1, \[Theta][[j]]'[t] ], t] - D[L1, \[Theta][[j]][t] ]) == 0
]
, {j, 1, npendula}] // Flatten; (*Linearized equations of motion*)
f\[Theta] =
ToExpression[
StringJoin["f\[Theta]", #] & /@
Evaluate[ToString /@ Range[npendula]]]; (*Dummy variables*)
M = Normal@CoefficientArrays[Table[
eq1[[j]] /.
Join[Table[\[Theta][[j]][t] -> f\[Theta][[j]], {j, 1,
npendula}],
Table[\[Theta][[j]]'[t] -> I \[Omega] f\[Theta][[j]], {j, 1,
npendula}],
Table[\[Theta][[j]]''[t] -> - \[Omega]^2 f\[Theta][[j]], {j,
1, npendula}] ]
, {j, 1, npendula}], f\[Theta]][[2]];
naturalfreq1 =
N@Solve[Det[(M /.
Join[{g -> 1}, Table[l[[j]] -> 1, {j, 1 npendula}],
Table[m[[j]] -> 1, {j, 1 npendula}]])] == 0, \[Omega]]; (*Natural frequencies. Selecting the correct ones is probably the biggest thing to check if you use a odd number of pendula.*)
e = ToExpression[ StringJoin["e", #] & /@ Evaluate[ToString /@ Range[npendula]]]; (*Dummy variables*)
modes = Table[
FullSimplify@ Solve[(M /. Join[{\[Omega] -> naturalfreq1[[2*j, 1, 2]], g -> 1}, Table[l[[j]] -> 1, {j, 1 npendula}], Table[m[[j]] -> 1, {j, 1 npendula}]]) . e == Table[0, {j, 1, npendula}], e]
, {j, 1, npendula}];
orthogonalmodes = Simplify@Table[e/e1 /. modes[[j, 1]], {j, 1, npendula}]
metric = Normal@CoefficientArrays[eq1, Table[\[Theta][[j]]''[t], {j, 1, npendula}]][[2]]; (*If you are changing the number of pendula, make sure you are selecting the correct matrix.*)
metric1 = (metric /. {Join[{ g -> 1}, Table[l[[j]] -> 1, {j, 1, npendula}], Table[m[[j]] -> 1, {j, 1, npendula}]]})[[1]];
eq = Flatten[Table[
FullSimplify[
(D[D[L, Evaluate[D[\[Theta][[j]][t], t]] ], t] -
D[L, \[Theta][[j]][t] ]) == 0
]
, {j, 1, npendula}] ] /. {Join[{ g -> 1},
Table[l[[j]] -> 1, {j, 1, npendula}],
Table[m[[j]] -> 1, {j, 1, npendula}]]};
eqbound = (Join[eq,
Table[\[Theta][[j]][0] == 1.*orthogonalmodes[[1, j]], {j, 1,
npendula}],
Table[\[Theta][[j]]'[0] == 0, {j, 1, npendula}]]) /. {Join[{
g -> 1}, Table[l[[j]] -> 1, {j, 1, npendula}],
Table[m[[j]] -> 1, {j, 1, npendula}]]};
vars = Table[\[Theta][[j]][t], {j, 1, npendula}];
tmax = 150;
sol = NDSolve[eqbound, vars, {t, 0, tmax}, Method -> {"EquationSimplification" -> "Residual"}] (*Solve the equations of motion.*)
solpos = (pos /. Table[l[[j]] -> 1, {j, 1, npendula}]) /. sol;
frames = Table[
modepos =
Table[(pos /. Table[l[[j]] -> 1, {j, 1, npendula}]) /.
Table[\[Theta][[j]][t] -> orthogonalmodes[[k, j]]*
Simplify[
orthogonalmodes[[k]] . metric1 .
Evaluate[((Table[\[Theta][[j]][t], {j, 1, npendula}] /.
sol) /. {t -> \[Tau]})[[1]] ] ]/(orthogonalmodes[[
k]] . metric1 . orthogonalmodes[[k]])
, {j, 1, npendula}], {k, 1, npendula}];
GraphicsGrid[{{
Graphics[{
Line[Join[{{0, 0}}, Table[solpos[[1, j]], {j, 1, npendula}]] ],
Disk[{0, 0}, 0.075],
Table[Disk[solpos[[1, j]], 0.1], {j, 1, npendula}],
Text[
Style["Quadruple pendulum", Bold, FontSize -> 14], {0, 3.5}]
},
PlotRange ->
1.1 {{-npendula, npendula}, {-npendula, npendula}}
]
, SpanFromLeft,
Graphics[{
Line[
Join[{{0, 0}}, Table[modepos[[1, j]], {j, 1, npendula}]] ],
Disk[{0, 0}, 0.075],
Table[Disk[modepos[[1, j]], 0.1], {j, 1, npendula}],
Text[
Style["\!\(\*SuperscriptBox[\(1\), \(st\)]\) mode", Bold,
FontSize -> 14], {0, 3.5}]
},
PlotRange ->
1.1 {{-npendula, npendula}, {-npendula, npendula}}
]
,
Graphics[{
Line[
Join[{{0, 0}}, Table[modepos[[2, j]], {j, 1, npendula}]] ],
Disk[{0, 0}, 0.075],
Table[Disk[modepos[[2, j]], 0.1], {j, 1, npendula}],
Text[
Style["\!\(\*SuperscriptBox[\(2\), \(nd\)]\) mode", Bold,
FontSize -> 14], {0, 3.5}]
},
PlotRange ->
1.1 {{-npendula, npendula}, {-npendula, npendula}}
]
}, {SpanFromAbove, SpanFromBoth,
Graphics[{
Line[
Join[{{0, 0}}, Table[modepos[[3, j]], {j, 1, npendula}]] ],
Disk[{0, 0}, 0.075],
Table[Disk[modepos[[3, j]], 0.1], {j, 1, npendula}],
Text[
Style["\!\(\*SuperscriptBox[\(3\), \(rd\)]\) mode", Bold,
FontSize -> 14], {0, 3.5}]
},
PlotRange ->
1.1 {{-npendula, npendula}, {-npendula, npendula}}
]
,
Graphics[{
Line[
Join[{{0, 0}}, Table[modepos[[4, j]], {j, 1, npendula}]] ],
Disk[{0, 0}, 0.075],
Table[Disk[modepos[[4, j]], 0.1], {j, 1, npendula}],
Text[
Style["\!\(\*SuperscriptBox[\(4\), \(th\)]\) mode", Bold,
FontSize -> 14], {0, 3.5}]
},
PlotRange ->
1.1 {{-npendula, npendula}, {-npendula, npendula}}
]
}}, Frame -> All, ImageSize -> 600]
, {t, 0, tmax/1, 0.3}];
ListAnimate[frames] (*Plot everything.*)
Licenza
Questo file è reso disponibile nei termini della licenza Creative Commons CC0 1.0 Universal. | |
La persona che ha associato un'opera con questo atto legale ha donato tale opera nel pubblico dominio rinunciando a tutti i diritti sull'opera in tutto il mondo, inclusi tutti i diritti connessi o altri diritti simili, per quanto permesso dalla legge. Puoi copiare, modificare, distribuire ed utilizzare l'opera, anche a fini commerciali, senza chiedere alcun permesso.
http://creativecommons.org/publicdomain/zero/1.0/deed.enCC0Creative Commons Zero, Public Domain Dedicationfalsefalse |
Elementi ritratti in questo file
raffigura
normal mode inglese
Valore sconosciuto senza un elemento Wikidata
16 feb 2022
image/gif
Cronologia del file
Fare clic su un gruppo data/ora per vedere il file come si presentava nel momento indicato.
Data/Ora | Miniatura | Dimensioni | Utente | Commento | |
---|---|---|---|---|---|
attuale | 11:11, 17 feb 2022 | 800 × 398 (4,69 MB) | Berto | Uploaded own work with UploadWizard |
Pagine che usano questo file
La seguente pagina usa questo file:
Utilizzo globale del file
Anche i seguenti wiki usano questo file:
- Usato nelle seguenti pagine di sw.wiktionary.org:
Metadati
Questo file contiene informazioni aggiuntive, probabilmente aggiunte dalla fotocamera o dallo scanner usati per crearlo o digitalizzarlo. Se il file è stato modificato, alcuni dettagli potrebbero non corrispondere alla realtà.
Commento del file GIF | Created with the Wolfram Language : www.wolfram.com |
---|