22
$\begingroup$

Further to this question I found on MSE, I tried to replicate

enter image description here

from here

this is as far as I got:

fun[a_, b_, c_, x_, y_] := 
  Point[{#[[1]] + x, #[[2]] + y} &[
    Part[CirclePoints[360] c, 
     If[a + b == 360, 360, Mod[a + b, 360]]]]];
tab = With[{a = #}, 
     Flatten[Table[
       Table[fun[a, 90 + 15 n, 1 - .15 m, -1 + .5 n, -.35 m], {m, 0, 
         10}], {n, 0, 24}], 1]] & /@ Range[1, 360, 15];

Module[{t, x, y, fun, xf, yf, a}, x = -.5; y = 1;
 fun[a_, b_, c_, x_, y_] := 
  Point[{#[[1]] + x, #[[2]] + y} &[
    Part[CirclePoints[360] c, 
     If[a + b == 360, 360, Mod[a + b, 360]]]]];
 xf[t_, a_, b_] := a t - b Sin[t]; yf[t_, a_, b_] := a - b Cos[t];
 Animate[
  Show[
   Graphics[
    {PointSize[.01], tab[[a]]},
    PlotRange -> {{-1 - x, 10 + x}, {-1 - y, 1}}
    ],
   ParametricPlot[
    {(Pi/2) xf[t + 2 Pi a/24, 1.25, .6] - 4 Pi a/24 - Pi^2 + .05,  
     2.05 - 1.65 yf[t + 2 Pi a/24, 1.25, .6]},
    {t, -4 Pi, 4 Pi}, Axes -> False
    ]
   ],
  {a, 1, 24, 1}, ControlPlacement -> Top, AnimationRate -> 5, 
  AnimationDirection -> Backward
  ]
 ]

which is not very efficient (I'm sure Part could be applied more efficiently), and despite various tweeks, I couldn't quite manage to get the cycloid to line up with the points.

What is a better way to approach this?

$\endgroup$
33
$\begingroup$
DynamicModule[{t = 0, d = 5, a = .08, base, distortion, pts, r, f, n = 10},

 r[y_] := .08 y^4;
 f[x_] := -2 Pi Dynamic[t] + d x; 
 (*f does not evaluate to a number but FE will take care of that later*)

 base = Array[List, n {3, 1}, {{0, Pi}, {0, 1}} ];

 distortion = Array[ 
   Function[{x, y}, r[y] {Cos @ f @ x, Sin @ f @ x}], n {3, 1}, {{0, Pi}, {0, 1}} 
 ];

 pts = base + distortion;

 Row[{
   Animator[Dynamic @ t, AnimationRate -> .8, AppearanceElements -> {}],
   Graphics[{   
     LightBlue,
     Polygon @ Join[ pts[[;; , -1]], {Scaled[{1, 0}], Scaled[{0, 0}]}],

     Darker @ Blue, AbsolutePointSize @ 5, Point @ Catenate @ pts,

     AbsolutePointSize @ 7, Orange, Thick,
     Point @ pts[[15, -1]],  Circle[base[[15, -1]], r @ base[[15, -1, 2]]],
     Point @ pts[[15, 7]],  Circle[base[[15, 7]], r @ base[[15, 7, 2]]]     
     },
    PlotRange -> {{0 + .1, Pi - .1}, {0, 1.2}}, 
    PlotRangePadding -> 0,
    PlotRangeClipping -> True, ImageSize -> 800]
   }]
 ]

enter image description here

$\endgroup$
  • $\begingroup$ thanks - a vastly better approach! $\endgroup$ – martin Mar 18 at 13:34
  • $\begingroup$ @martin thanks, let me know if anything is not clear. $\endgroup$ – Kuba Mar 19 at 21:31
  • $\begingroup$ a = .08 doesn't get used; maybe you meant r[y_] := a y^4? (Also, how did you pick the form of r[y]?) $\endgroup$ – J. M. is away Mar 22 at 14:50
  • 1
    $\begingroup$ @J.M.isslightlypensive right, should be deleted. About formulas, I got them from looking at the original .gif :-) I was too lazy to think about physics etc so I assumed something like that should work. I also ignored OP's code :( $\endgroup$ – Kuba Mar 22 at 14:55

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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