5
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ It seems that you want an arc length reparametrization. I think there is a previous question about it $\endgroup$ – Dr. belisarius Oct 24 '14 at 1:51
9
$\begingroup$
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.

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – Michael E2 Oct 24 '14 at 13:01
  • $\begingroup$ @MichaelE2 Nice! I updated the post. $\endgroup$ – C. E. Oct 24 '14 at 13:35
6
$\begingroup$

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

$\endgroup$
  • $\begingroup$ ArcLength can save three or four lines of code here. Note that the lower bound should be Min @@ points[[All,1]] instead of 0 $\endgroup$ – C. E. Oct 24 '14 at 9:29
  • 1
    $\begingroup$ @Pickett I'm still on V9, so no ArcLength[]:(. $\endgroup$ – Dr. belisarius Oct 24 '14 at 11:43

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.