6
$\begingroup$

Writing:

L = 42.195;
R = 36.500 + Union[{0.30}, Table[1.22 n + 0.20, {n, 8}]];

ρ[r_, ω_, t_, ϕ_] := Piecewise[{{Sqrt[(r/Sin[ω t + ϕ])^2], ArcTan[r/L] <= Mod[ω t + ϕ, π] <= π - ArcTan[r/L]},
                                {Sqrt[(L Cos[ω t + ϕ])^2] + Sqrt[r^2 - (L Sin[ω t + ϕ])^2], True}}]
γ[r_, ω_, t_, ϕ_] := ρ[r, ω, t, ϕ] {Cos[ω t + ϕ], Sin[ω t + ϕ]}

rings = Table[ParametricPlot[γ[R[[n]], 1, t, 0], {t, 0, 2π}, PlotStyle -> Pink], {n, 9}];

line = Graphics[{Green, Line[{{L, -R[[1]]}, {L, -R[[9]]}}]}];

Φ = Table[f[x_?NumericQ] := NIntegrate[Norm[D[γ[R[[n]], 1, t, x - ArcTan[R[[n]]/L]], t]], {t, 0, 2π - x}];   
          FindRoot[f[x] == 4 L + 2π R[[1]], {x, 0}][[1, 2]] - ArcTan[R[[n]]/L], {n, 9}];

points = Table[Graphics[{Blue, PointSize[Large], Point[γ[R[[n]], 1, t, Φ[[n]]]]}], {n, 9}, {t, 0, 2π, 2π/25}];

frames = Table[Show[{rings, line, Transpose[points][[n]]}, AspectRatio -> Automatic, AxesLabel -> {"x [m]", "y [m]"}, 
               PlotRange -> {{-90, 90}, {-60, 60}}, ImageSize -> 1000], {n, 26}];

Export["image.gif", frames, "AnimationRepetitions" -> ∞, "DisplayDurations" -> 0.5];

I get:

enter image description here

in which there are two things that don't convince me:

  1. the slowness of the code, if you could speed it up a bit it would be a good thing;

  2. the fact that they don't reach the green finish line all together, even if the start is staggered and the angular velocity is set unitary.

Ideas what am I doing wrong? Thank you!


Thanks to the answers of Michael E2 and cvgmt I realized that I was unnecessarily complicating the problem (in addition to being stubborn about the angular velocity) and I changed the code to the following:

L = 42.195;
R = 36.500 + Union[{0.30}, Table[1.22 n + 0.20, {n, 8}]];

v0 = 9.3;
T = (4 L + 2 π R)/v0;
s[s0_, t_] := s0 + v0 t

γ[r_, s0_, t_] := Piecewise[{
    {{L + r Sin[s[s0, t]/r], -r Cos[s[s0, t]/r]}, 0 <= s[s0, t] <= π r},
    {{L + π r - s[s0, t], r}, π r <= s[s0, t] <= 2 L + π r},
    {{-L + r Sin[(s[s0, t] - 2 L)/r], -r Cos[(s[s0, t] - 2 L)/r]}, 2 L + π r <= s[s0, t] <= 2 L + 2 π r},
    {{-3 L - 2 π r + s[s0, t], -r}, 2 L + 2 π r <= s[s0, t] <= 4 L + 2 π r}}]

space = Table[f[s0_?NumericQ] := NIntegrate[Norm[D[γ[R[[n]], s0, t], t]], {t, 0, T[[n]]}];
              Chop[Quiet[FindRoot[f[s0] == 4 L + 2 \[Pi] R[[1]], {s0, 0}]][[1, 2]]], {n, 9}];

rings = Table[ParametricPlot[γ[R[[n]], 0, t], {t, 0, T[[n]]}, PlotStyle -> Pink], {n, 9}];

lines = Graphics[{Green, Line[{{L, R[[1]]}, {L, R[[9]]}}], Line[{{-L, R[[1]]}, {-L, R[[9]]}}], 
                   Line[{{-L, -R[[1]]}, {-L, -R[[9]]}}], Line[{{L, -R[[1]]}, {L, -R[[9]]}}]}];

points = Table[Graphics[{Blue, PointSize[Medium], Point[γ[R[[n]], space[[n]], t]]}],
               {t, 0, T[[1]], T[[1]]/22}, {n, 9}];

frames = Table[Show[{rings, lines, points[[n]]}, AspectRatio -> Automatic, AxesLabel -> {"x", "y"},
                Epilog -> {Text[Style[StringJoin["t = ", ToString[NumberForm[T[[1]] (n - 1)/22,
                           {∞, 2}]], " s"], Red, Bold, 20], {15, 5}],
                           Text[Style[StringJoin["s = ", ToString[NumberForm[space[[1]] + v0 T[[1]] (n - 1)/22,
                           {∞, 2}]], " m"], Red, Bold, 20], {15, 10}]}, PlotRange -> {{-90, 90}, {-50, 50}},
                Ticks -> {Range[-90, 90, 10], Range[-50, 50, 10]}, ImageSize -> 1000], {n, 23}];

Export["image.gif", frames, "AnimationRepetitions" -> ∞, "DisplayDurations" -> 1];

getting what I wanted:

enter image description here

On the other hand, flinty's answer opened up new avenues for me, as well as confirming the fact that when you think about something MMA has already thought about it for years!

$\endgroup$
3
  • 1
    $\begingroup$ I don't think that fixed angular velocity will make them come to the finish line together -- you can see that the outer runner is much faster than the inner one. You should set their "proper" (linear) velocities to be equal. $\endgroup$
    – Domen
    Aug 6, 2021 at 15:11
  • 2
    $\begingroup$ The position at distance s (arclength) from finishing line on a lane of straightaway length L and turn radius R: ClearAll[pos]; pos[s_, L_, R_] := pos[s, L, R, 2 (L + Pi R)]; pos[s_, L_, R_, T_] := With[{s0 = Mod[s, T]}, Piecewise[{ {{L/2, 0} + R {Sin[s0/R], -Cos[s0/R]}, s0 < Pi R}, {{L/2, R} + {-s0 + Pi R, 0}, s0 < Pi R + L}, {{-L/2, 0} + R {Sin[(s0 - L)/R], -Cos[(s0 - L)/R]}, s0 < 2 Pi R + L}, {{-L/2, -R} + {s0 - L - 2 Pi R, 0}, s0 < T} }] ];. Starting positions at s = -400 meters, I suppose, for appropriate L and Rs. $\endgroup$
    – Michael E2
    Aug 6, 2021 at 17:07
  • 2
    $\begingroup$ Example: myP = Table[pos[s, 2, R], {R, 1, 1.5, 0.1}]; ParametricPlot[myP, {s, -2 (2 + Pi), 0}, Mesh -> 9]. I leave the rest to you, if you find this helpful. $\endgroup$
    – Michael E2
    Aug 6, 2021 at 17:07

2 Answers 2

9
$\begingroup$

Here's my attempt without using formulae but using a StadiumShape discretization instead, mainly to show another way to do it for better performance:

width = 42.195;
radii = 36.500 + Union[{0.30}, Table[1.22 n + 0.20, {n, 8}]];
(* generate some tracks as StadiumShape discretizations *)
tracks = Table[
   DiscretizeRegion[
    RegionBoundary[StadiumShape[{{-width/2, 0}, {width/2, 0}}, r]],
    MaxCellMeasure -> .1], {r, radii}];

(* Create lines from StadiumShape track coordinates *)
track2line[tr_] := Line@MeshCoordinates@tr

(* Interpolations of the coordinates to get parametric curves *)
intps = With[{c = MeshCoordinates@#},
  {Length@c, Interpolation /@ Transpose[c]}
 ] & /@ tracks;

(* get the position at t for the nth curve *)
curves[n_, t_] := Quiet[#[t*intps[[n, 1]]] & /@ intps[[n, 2]]]

(* relative lengths of the tracks compared to innermost *)
rellengths = #/#[[1]] &@(RegionMeasure /@ tracks);

start = .4;
anim = Animate[
  Graphics[{Red, track2line /@ tracks, Blue, 
    Point[Table[
      curves[i, Mod[(t - start)/#, 1] &@rellengths[[i]]], {i, 
       Length@tracks}]]}]
  , {t, -start, start}]

olympic track StadiumShape animation

Not sure if it's entirely correct logic, but they all arrive at the finish line at the same time.

$\endgroup$
0
2
$\begingroup$

Use {s,-400,0} we can get the result by the author.

l = 42.195;
radiis = 36.500 + Union[{0.30}, Table[1.22 n + 0.20, {n, 8}]];
c1[r_][s_] = {l, 0} + r*{Cos[-π/2 + s/r], Sin[-π/2 + s/r]};
c2[r_][s_] = {-l, 0} + r*{Cos[π/2 + s/r], Sin[π/2 + s/r]};
l1[r_][s_] = {l, r} + s*{-1, 0};
l2[r_][s_] = {-l, -r} + s*{1, 0};
arc[r_] = π*r + 2 l + π*r + 2 l;
c[r_][s_] = 
  Which[0 <= s <= π*r, c1[r][s], 0 <= s - π*r <= 2 l, 
   l1[r][s - π*r], 0 <= s - π*r - 2 l <= π*r, 
   c2[r][s - π*r - 2 l], 0 <= s - π*r - 2 l - π*r <= 2 l, 
   l2[r][s - π*r - 2 l - π*r]];
cc[r_][s_] = c[r][Mod[s, arc[r]]];
fig = Show[
   Table[ParametricPlot[c[r][s], {s, 0, arc[r]}, 
     PlotStyle -> {Thin, Red}], {r, radiis}], PlotRange -> All];
Manipulate[
 Show[fig, 
  Graphics[{{Green, 
     Line[{cc[First@radiis][0], cc[Last@radiis][0]}]}, {Point@
      Table[cc[r][s], {r, radiis}]}}]], {s, -400, 0}, 
 ControlPlacement -> Bottom]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.