# Timing moving figures

I have an animation that simulates rectangles going through a line.

1. I wonder if it is possible to time the events of each figure.

I separated the rectangles by color for easy recognition of each.

The simulation was not created by Mathematica Software. Was obtained from the After Effects software. I'm still creating the code

One can also use this mathematica generated animation:

SeedRandom@1
speed = RandomReal[{1, 2}, 5];
dat = Table[
ColorNegate@
Binarize@
Rasterize[
Graphics[{Thick, Line[{{0, 80}, {100, 80}}], Thickness[.03],
Table[Line[{{-10 + 20 x, 10 + t speed[[x]]}, {-10 + 20 x,
25 + t speed[[x]]}}], {x, 5}]},
PlotRange -> {{0, 100}, {0, 100}}, ImageSize -> {200, 200}],
ImageSize -> {200, 200}], {t, 80}];

ListAnimate@dat

• Maybe related to this. Sep 3, 2016 at 0:32
• It's an interesting question and I'm working on it, but can you reduce the gif a bit and aviod multiple runs? After imported your gif I found out that this animation was ran for multiple times......Part will be ugly
– Wjx
Sep 3, 2016 at 10:04
• @Shutao Tang I was never programmer. I am a mechanical engineer. And as the trend is to know programming want to have good knowledge to help my son in the future. Sep 3, 2016 at 11:49
• @Wjx That cool you have edited, but just modify the animation. Sep 5, 2016 at 19:13
• @LeandroMacieldeCarvalho I'm working on it when I have spare time, but the motion blur created by AE is a great barrier, so I modified it into several rasterized graphics.
– Wjx
Sep 6, 2016 at 0:51

This is a start. In the following:

• Manipulate is used to remove the top(digits and line)
• as the labeling of the components crosses fun relabels
• the animated gif was by exporting vis[] (what is posted is downsampled to allow posting)
• what is displayed are frames where there are discernible two objects
• exponential moving average smoothing was used to smooth the "wobble" of the centroid
• obviously this can be rescaled by whatever the display duration is

imlist = Import["http://i.imgur.com/LDQfqep.gif"];
Manipulate[ImageTake[imlist[[1]], -p], {p, 10, 1000}];
cm[i_] :=
ComponentMeasurements[Dilation[ColorNegate@Binarize[i], 10],
"Centroid"]
cn = cm /@ (ImageTake[#, -235] & /@ imlist);
pick = Pick[imlist, Length[#] == 2 & /@ cn];
pc = Pick[cn, Length[#] == 2 & /@ cn];
fun[u_] :=
If[Abs[(1 /. u)[[1]] - pc[[1, 1, 2, 1]]] < 20, u,
u /. {1 -> 2, 2 -> 1}]
pcf = fun /@ pc;
dis[u_] := EuclideanDistance[#, u[[1]]] & /@ u;
vis[] := Module[{pts1 = 1 /. pcf, pts2 = 2 /. pcf, an, d, v, lp, if1,
if2, sp},
Show[#3,
Graphics[{Black, PointSize[0.04], Point@#1, Blue,
Point@#2}]] &, {pts1, pts2, pick}];
d = dis /@ {pts1, pts2};
v = Transpose@d;
lp = MapIndexed[
ListPlot[d, Frame -> True, Joined -> True,
Epilog -> {PointSize[0.04], Red,
Point[{#2[[1]], v[[#2[[1]], 1]]}], Green,
Point[{#2[[1]], v[[#2[[1]], 2]]}]},
PlotStyle -> {Black, Blue}, ImageSize -> 300] &, v, 1];
{if1, if2} =
Interpolation /@ (ExponentialMovingAverage[#, 0.1] & /@ d);
sp = Plot[{D[if1[x], x], D[if2[x], x]}, {x, 1, 114},
Evaluated -> True, PlotStyle -> {Black, Blue}, ImageSize -> 300];
MapThread[Framed@Row[{#1, Column[{#2, sp}]}] &, {an, lp}]
]