Auf Seite 1 wurde die Wurfparabel nach Newton mit der Wurfparabel nach Einstein verglichen. Da letztere sowohl nach
Eigenzeit (die des Wurfgegenstands) als auch
Koordinatenzeit (die des Beobachters at infinity) geplottet werden kann links die Eigenzeit und rechts die Koordinatenzeit im Vergleich. Um die Zeit eines stationären Beobachters im Abstand R vom Schwerpunkt zu erhalten wird die Koordinatenzeit einfach durch √(1-rs/R) dividiert. Wie man sieht kommt der Wurfgegenstand nach endlicher Eigenzeit, aber erst nach unendlicher Koordinatenzeit an (Animation stoppt bei ZD-Faktor 2^48 ≈ 3e14):
Startwinkel: π/2-1 Radiant, Startgeschwindigkeit: √(G·M/r0) = neutonische Orbitalgeschwindigkeit
Code:
(* relativistische Wurfparabel, proper vs coordinate | yukterez.net 2016 | Syntax: Mathematica *)
G = 678*^-13; M = 6*^24; c = 3*^8; rs = 2 G M/c^2;
r0 = 10 rs; vo = Sqrt[G M/r0]; φ = 1; vr0 = vo Cos[φ]; vθ0 = vo/r0 Sin[φ]; θ0 = 0; T =7*^-9;
d1 = 5*^-9; d2 = d1/3; wp = 30; step = 5*^-11;
sol = NDSolve[{
r''[t] == -((G M)/r[t]^2) + r[t] θ'[t]^2 - (3 G M)/c^2 θ'[t]^2,
r'[0] == vr0,
r[0] == r0,
θ''[t] == -((2 r'[t] θ'[t])/r[t]),
θ'[0] == vθ0,
θ[0] == θ0,
τ'[t] == Sqrt[c^2 r[t] + r[t] r'[t]^2 - c^2 rs + r[t]^3 θ'[t]^2 - r[t]^2 rs θ'[t]^2]/(c Sqrt[r[t] - rs] Sqrt[1 - rs/r[t]]),
τ[0] == 0
}, {r, θ, τ}, {t, 0, T}, WorkingPrecision -> wp,
MaxSteps -> Infinity, Method -> Automatic,
InterpolationOrder -> All];
t[ξ_] :=
Quiet[χ /.
FindRoot[
Evaluate[τ[χ] /. sol][[1]] - ξ, {χ, 0},
WorkingPrecision -> wp, Method -> Automatic]];
Τ := Quiet[t[ι]];
x[t_] := (Sin[Evaluate[θ[t] /. sol]] Evaluate[r[t] /. sol])[[1]]
y[t_] := (Cos[Evaluate[θ[t] /. sol]] Evaluate[r[t] /. sol])[[1]]
s[text_] := Style[text, FontSize -> font]; font = 11;
Do[Print[
Rasterize[Grid[{{Show[Graphics[{
{Black, Circle[{0, 0}, rs]},
{Lighter[Gray], Dashed, Circle[{0, 0}, r0]}},
Frame -> True, ImageSize -> 400, PlotRange -> 14 rs],
Graphics[{PointSize[0.01], Red, Point[{x[т], y[т]}]}],
ParametricPlot[{x[η], y[η]}, {η, 0, т},
ColorFunction -> Function[{x, y, η},
Hue[0.85, 1, 0.5, Max[Min[(-т + (η + d1))/d1, 1], 0]]],
ColorFunctionScaling -> False],
ParametricPlot[{x[η], y[η]}, {η, 0, т},
ColorFunction -> Function[{x, y, η},
Hue[0, 1, 0.5, Max[Min[(-т + (η + d2))/d2, 1], 0]]],
ColorFunctionScaling -> False]]},
{Grid[{
{" ", s["Eigenzeit"], " = ", s[N[т, 8]], s["sek"]},
{" ", s["Koordinatenzeit"], " = ", s[N[Evaluate[τ[т] /. sol][[1]], 8]], s["sek"]},
{" ", s["Zeitdilatation"], " = ", s[N[Evaluate[τ'[т] /. sol][[1]], 8]], s["dτ/dt"]},
{" ", s["Winkel"], " = ", s[N[Evaluate[(θ[т] /. sol) 180/Pi][[1]], 8]], s["grad"]},
{" ", s["radialer Abstand"], " = ", s[N[Evaluate[r[т] /. sol][[1]], 8]], s["m"]},
{" ", s["x-Achse"], " = ", s[N[x[т], 8]], s["m"]},
{" ", s["y-Achse"], " = ", s[N[y[т], 8]], s["m"]}
}, Alignment -> Left]}}, Alignment -> Left]]
], {т, step, T, step}]
Do[Print[
Rasterize[Grid[{{Show[Graphics[{
{Black, Circle[{0, 0}, rs]},
{Lighter[Gray], Dashed, Circle[{0, 0}, r0]}},
Frame -> True, ImageSize -> 400, PlotRange -> 14 rs],
Graphics[{PointSize[0.01], Red, Point[{x[Τ], y[Τ]}]}],
ParametricPlot[{x[η], y[η]}, {η, 0, Τ},
ColorFunction ->
Function[{x, y, η},
Hue[0.85, 1, 0.5, Max[Min[(-Τ + (η + d1))/d1, 1], 0]]],
ColorFunctionScaling -> False],
ParametricPlot[{x[η], y[η]}, {η, 0, Τ},
ColorFunction ->
Function[{x, y, η},
Hue[0, 1, 0.5, Max[Min[(-Τ + (η + d2))/d2, 1], 0]]],
ColorFunctionScaling -> False]]},
{Grid[{
{" ", s["Eigenzeit"], " = ", s[N[Τ, 8]], s["sek"]},
{" ", s["Koordinatenzeit"], " = ", s[N[ι, 8]], s["sek"]},
{" ", s["Zeitdilatation"], " = ", s[N[Evaluate[τ'[Τ] /. sol][[1]], 8]], s["dτ/dt"]},
{" ", s["Winkel"], " = ", s[N[Evaluate[(θ[Τ] /. sol) 180/Pi][[1]], 8]], s["grad"]},
{" ", s["radialer Abstand"], " = ", s[N[Evaluate[r[Τ] /. sol][[1]], 8]], s["m"]},
{" ", s["x-Achse"], " = ", s[N[x[Τ], 8]], s["m"]},
{" ", s["y-Achse"], " = ", s[N[y[Τ], 8]], s["m"]}
}, Alignment -> Left]}}, Alignment -> Left]]
], {ι, step, T, step}]
julian apostata hat geschrieben:
Direkt hier im Forum laufen die Animationen recht zäh. Zum Beispiel hat das newtonische Objekt innerhalb des großen Kreises eine geringere Geschwindigkeit als außerhalb davon. Ich wollt dich deswegen schon kritisieren. Dann hab ich es direkt auf meinen Rechner kopiert und jetzt läuft das Objekt so, wie man es gemäß der Kepler-gleichung erwartet. Mit Quicktime kann ich die Animation auch anhalten. Aber hat man in Mathematica denn keine Möglichkeit, den Betrachter mehr interaktiv teilhaben zu lassen, wie hier zum Beispiel? geogebra.org/m/W8ByVKFX?doneurl=%2Fmaterials
Man könnte meinen Code auch in die Geogebra-Sprache
übersetzen, dann könnte man auch ein solches Applet draus machen. Allerdings hatte ich noch nie die Zeit mir dieses Programm richtig anzuschauen und ich habe den Code auch noch nicht auf Geschwindigkeit optimiert (mit
MachinePrecision und begrenztem
Intervall erreicht man leider keine sehr genauen Ergebnisse) so dass die interaktive live-Berechnung in diesem Fall auch ziemlich zeitintensiv ist. Du kannst dir aber auch Mathematica
downloaden und die Startparameter direkt verändern oder indem du
Do[Print[...], {t,t1,t2}] durch
Manipulate[..., {t,t1,t2}, {M,M1,M2}, {r0,r1,r2}, {etc,usw,usf}] ersetzt ein interaktives Arbeitsblatt draus machen. Wenn du versprichst das Programm nur zur Verherrlichung der RT einzusetzen könnte ich dir sogar eine Lizenz dafür schenken, ich habe noch ein paar auf Vorrat die ich in diesem Jahr nicht mehr brauche.
Entgegenkommend,
Anmelden
Registrieren
FAQ
Suche
hat geschrieben:
, 
