Movement of a disk by Angle x Time

Question

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[[1]], 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}]]

Answer 1

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[[1]], position[[2]], 20];
step2 = Subdivide[position[[2]], position[[3]], 20];
step3 = Subdivide[position[[3]], position[[4]], 20];
step4 = Subdivide[position[[4]], position[[5]], 20];
step5 = Subdivide[position[[5]], position[[6]], 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]

Answer 2

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[Thread[{time, Sin /@ position}]], Green, 
     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]

Answer 3

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]

Answer 4

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[[1]], time[[-1]]},
   AxesLabel -> {"time", "position"}];
 Show[
  plt,
  Graphics[{Red,
    Disk[{t, eq[t]}, {.3, .2}]}]],
 {{t, time[[1]], "time"}, time[[1]], time[[-1]]}]

With an evolving plot

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