# Movement of a disk by Angle x Time

I created two lists in which each one of them contains the information of time and position.

time = {0.0, 2.3, 3.5, 4.9, 8.4, 10};
position = {0, 20, 80, -120, 190, 0} Degree;


I made an interpolation to show how the position relates to time.

list=Transpose[{time,position,}]


The position is described in degrees.

eq = Fit[list1, {1, x, x^2, x^3, x^4}, x];

Plot[eq, {x, time[], time[[-1]]}] It is possible to create an animation that shows this movement? The graphical element could be a disc like this:

Graphics[Disk[{1, 0}, {.2, .2}]]

• I think that you forgot to show how you managed to list1 – LCarvalho Sep 27 '16 at 18:57

You can create an animated GIF in this way:

time = {0.0, 2.3, 3.5, 4.9, 8.4, 10};

position = {0, 20, 80, -120, 190, 0} Degree;


I called his disc as element:

element = Disk[{1, 0}, {.2, .2}]


Here I tried angles to divide it into several parts, because at some points they change of motion. Sometimes it is clockwise, the other is not.

step1 = Subdivide[position[], position[], 20];
step2 = Subdivide[position[], position[], 20];
step3 = Subdivide[position[], position[], 20];
step4 = Subdivide[position[], position[], 20];
step5 = Subdivide[position[], position[], 20];
steps = Join[step1, step2, step3, step4, step5]


Or so,

steps = Flatten[
Subdivide[position[[#]], position[[# + 1]], 30] & /@
Range[Length[position] - 1]]

frames = Flatten@Table[Graphics[{
GeometricTransformation[
element,
RotationTransform[#, origin = {0, 0}]
]},
Axes -> True,
ImageSize -> 400,
Ticks -> Automatic,
PlotRange -> {{-5, 5}, {-5, 5}}
], 1] & /@ steps;

SetDirectory[
"C:\\Users\\LMC\\Wolfram Mathematica"];

Export["Animation.gif", frames] This plots the sine of angle v time next to the fitted motion (this could be vastly improved with pre-calculation):

fit[x_] :=
Sin[-0.09688801022291954 + 4.11394327494722 x -
2.320678893832451 x^2 + 0.39258094728128384 x^3 -
0.020147699820365496 x^4]
f[u_] := Show[
Plot[fit[x], {x, 0, 10},
Epilog -> {PointSize[0.02], Blue,
Point[{u, fit[u]}]}], Graphics[{Circle[], Red, PointSize[0.02],
Point[{Sqrt[1 - fit[u]^2], fit[u]}],
Line[{{u, fit[u]}, {Sqrt[1 - fit[u]^2], fit[u]}}]}],
PlotRange -> {{-1, 10}, {-2, 2}}, Frame -> True,
AspectRatio -> Automatic,
PlotLabel -> Framed@Row[{"t=", NumberForm[u, 2]}]]


Animated gif made from f/@Range[0,10,0.05] You don't really specified what you want to have for an animation but perhaps this is what you want:

Animate[Graphics[{Circle[{0,0},1],Red,Line[{{0,0},{Cos[eq/.x->t],Sin[eq/.x->t]}}],Disk[{Cos[eq/.x->t],Sin[eq/.x->t]},0.05]}],{t,First@time,Last@time}]


or for a gif-file:

imgs=Table[Graphics[{Circle[{0,0},1],Red,Line[{{0,0},{Cos[eq/.x->t],Sin[eq/.x->t]}}],Disk[{Cos[eq/.x->t],Sin[eq/.x->t]},0.05]},PlotRange->{{-1.1,1.1},{-1.1,1.1}},AspectRatio->1],{t,First@time,Last@time,((Last@time)-(First@time))/200}];
Export["se127351.gif",imgs] Clear[eq]

time = {0.0, 2.3, 3.5, 4.9, 8.4, 10};
position = {0, 20, 80, -120, 190, 0} Degree;

list1 = Transpose[{time, position}];

eq[x_] = Fit[list1, {1, x, x^2, x^3, x^4}, x];


With a fixed plot

Animate[
plt = Plot[eq[x], {x, time[], time[[-1]]},
AxesLabel -> {"time", "position"}];
Show[
plt,
Graphics[{Red,
Disk[{t, eq[t]}, {.3, .2}]}]],
{{t, time[], "time"}, time[], time[[-1]]}] With an evolving plot

Animate[
plt = Plot[eq[x], {x, time[], t},
AxesLabel -> {"time", "position"},
PlotRange -> {{time[], time[[-1]]}, {-1.3, 3.3}},
Epilog -> {Red, Disk[{t, eq[t]}, {.3, .2}]}],
{{t, time[] + .001, "time"}, time[] + .001, time[[-1]]}]
` 