5

I have a list of points that my line must go through, all at varying distances from one another. I'd like to draw just a piece of this line in an Animate, where the various segments are traversed at unit speed. For example, 

points={{0,0},{1,0},{4,4}};
Animate[Graphics[Line[func[points,time]]],{time,0,10}];

Ideally, the line would be drawn gradually, starting at {0,0}, heading towards {1,0}, then turning and heading towards {4,3}. I'd like the line to do this at a speed proportionate to the distance between successive points: so for example, it takes the line 5 times as long to go from {1,0} to {4,4} (distance 5) as it does to go from {0,0} to {1,0} (distance 1).

I suppose there's the possibility of generating a bunch of "interpolating" points, but I'm hoping for something smoother.

Steve D
  • 2,199
  • 1
  • 17
  • 22

2 Answers2

9
points = {{0, 1}, {1, 0}, {1, 1}, {4, 4}, {0, 4}, {3, 0}};

interp[points_] := Module[{d},
  d = Prepend[Accumulate[Norm /@ Differences@points], 0];
  Interpolation[Transpose@{List /@ d, points}, InterpolationOrder -> 1]
  ]

f = interp[points];

Animate[
 ParametricPlot[f[t], {t, 0, time}, 
  PlotRange -> {Min @ points[[All,1]], Max @ points[[All,2]]}],
 {time, 0, Last@Accumulate[Norm /@ Differences@points]}
 ]

Animation

The independent variable is taken to be the distance travelled instead of time, which is how constant velocity is achieved. Credit goes to MichaelE2 for improved interpolation.

C. E.
  • 70,533
  • 6
  • 140
  • 264
  • You can also interpolate the points without separating the coordinates: Try f = Interpolation[Transpose@{List /@ d, points}, InterpolationOrder -> 1] where d is as in your Module. – Michael E2 Oct 24 '14 at 13:01
  • @MichaelE2 Nice! I updated the post. – C. E. Oct 24 '14 at 13:35
6

Uniform displacement by arc-length reparametrization - Some code stolen from @Mark McClure

points = {{0, 0}, {.5, 4}, {1, 0}, {4, 4}}
f = Interpolation[points, InterpolationOrder -> 1];
$Assumptions = {t > 0};
arcLength[t_?NumericQ]   := arcLength[t]   = NIntegrate[Norm[{1, f'[tau]}], {tau, 0, t}];
timeFromArc[s_?NumericQ] := timeFromArc[s] = t /. FindRoot[arcLength[t] == s, {t, 1}];
Animate[Plot[f[t], {t, #[[1, 1]], timeFromArc@arc}, PlotRange -> #], 
       {arc, 0., arcLength@#[[1, 2]]}] &[{Min @@ #, Max @@ #} & /@ Transpose@points]

enter image description here

It works for any InterpolationOrder. In fact, for any "reasonable" function. Here for InterpolationOrder -> 3:

enter image description here

Community
  • 1
Dr. belisarius
  • 115,881
  • 13
  • 203
  • 453