How to make an animation of following gif in Mathematica?
Edit: The animation shown above was created by Charlie Deck in processing.
And how to make 3D analog?
I tried first few steps
line = Graphics[Line[{{1, 1}, {2, 2}}]]
Manipulate[
Show[line, line /. l : Line[pts_] :> Rotate[l, n, Mean[pts]]], {n, 0,Pi}]
I'd like to expand on Quantum_Oli's answer to give an intuitive explanation for what's happening, because there's a neat geometric interpretation. At one point in the animation it looks like there is a circle of colored dots moving about the center, this is a special case of so called hypocycloids known as Cardano circles. A hypocyloid is a curve generated by a point on a circle that moves along the inside of a larger circle. It is closely related to the epicycloid, for which I have previously written some code. Here's a hypocycloid generated with code modified from that answer:
The parametric equations for a hypocycloid are (as on Wikipedia) $$ x (\theta) = (R - r) \cos \theta + r \cos \left( \frac{R - r}{r} \theta \right) $$ $$ y (\theta) = (R - r) \sin \theta - r \sin \left( \frac{R - r}{r} \theta \right), $$ where $r$ is the radius of the smaller circle and $R$ is the radius of the larger circle. In a Cardano circle all points on the smaller circle move in straight lines, the relationship that characterizes a Cardano circle is $R = 2 r$.
The question is, how does this relate to Quantum_Oli's answer? The equation that he gives for his points is {x,y} = Sin[ω t + φ] {Cos[φ], Sin[φ]}, we can rewrite this with TrigReduce:
TrigReduce[Sin[ω t + φ] {Cos[φ], Sin[φ]}]
{1/2 (Sin[t ω] + Sin[2 φ + t ω]), 1/2 (Cos[t ω] - Cos[2 φ + t ω])}
That's neat; the form of this expression is the same as the form of the expression for a hypocycloid on Wikipedia. Identifying parameters between the formulae we find that $$ R - r = 1,\quad \frac{R-r}{r} = 1 \implies r = 1, R = 2 $$ thus proving that it's the formula for a Cardano circle, since the radii satisfy the condition that $R = 2 r$.
Obviously, though, the points aren't stationary on the circle the way that they are in my example above. The animation is created by moving the points about, we can see in the expression above that Quantum_Oli solved this by introducing a phase offset $2φ$, and then changing this differently for different points in a certain way that he came up with. I extracted the part that generates the phase offset:
phases[t_] := Table[t + Pi i, {i, 0, 1, 1/(3 \[Pi] - Abs[9.43 - t])}]
Plugging the phase offset into the equations for the hypocycloid and using the code for generating a plot that was used above we then get
This is the code that was used to generate the animation:
fx[θ_, phase_: 0, r_: 1, k_: 2] := r (k - 1) Cos[θ] + r Cos[(k - 1) θ + 2 phase Degree]
fy[θ_, phase_: 0, r_: 1, k_: 2] := r (k - 1) Sin[θ] - r Sin[(k - 1) θ + 2 phase Degree]
center[θ_, r_, k_] := {r (k - 1) Cos[θ], r (k - 1) Sin[θ]}
gridlines = Table[{x, GrayLevel[0.9]}, {x, -6, 6, 0.5}];
epilog[θ_, phases_, r_: 1, k_: 2] := {
Thick,
LightGray, Circle[{0, 0}, k r],
LightGray, Circle[center[θ, r, k], r],
MapIndexed[{
Black, PointSize[0.03], Point[{fx[θ, #], fy[θ, #]}],
Hue[First[#2]/10], PointSize[0.02],
Point[{fx[θ, #], fy[θ, #]}]
} &, phases]
}
plot[max_, phases_] := ParametricPlot[
Evaluate[Table[{fx[θ, phase], fy[θ, phase]}, {phase, phases}]],
{θ, 0, 2 Pi},
PlotStyle -> MapIndexed[Directive[Hue[First[#2]/10], Thickness[0.01]] &, phases],
Epilog -> epilog[max, phases],
GridLines -> {gridlines, gridlines},
PlotRange -> {-3, 3},
Axes -> False
]
phases[t_] := Table[t + Pi i, {i, 0, 1, 1/(3 π - Abs[9.43 - t])}]/Degree
Manipulate[plot[t, phases[t]], {t, 0, 6 Pi}]
Edit: Added the reversal and some refinements
ω = 1;
posP[t_, φ_] := Sin[ω t + φ] {Cos[φ], Sin[φ]}
posL[φ_] := {-#, #} &@{Cos[φ], Sin[φ]}
Animate[
Graphics[{PointSize[0.02],
Table[{Black, Line[posL[π i]], Hue[i], Point[posP[t, π i]]}, {i, 0, 1, 1/(3π-Abs[9.43-t])}]
},
PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}}
],
{t, 0, 6π, 0.2}
]
