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.

Improve this question
$\endgroup$
1
  • $\begingroup$ It seems that you want an arc length reparametrization. I think there is a previous question about it $\endgroup$
    – Dr. belisarius
    Commented Oct 24, 2014 at 1:51

2 Answers 2

Reset to default
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.

Improve this answer
$\endgroup$
2
  • $\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
    Commented Oct 24, 2014 at 13:01
  • $\begingroup$ @MichaelE2 Nice! I updated the post. $\endgroup$
    – C. E. ♦
    Commented Oct 24, 2014 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

Improve this answer
$\endgroup$
2
  • $\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. ♦
    Commented Oct 24, 2014 at 9:29
  • 1
    $\begingroup$ @Pickett I'm still on V9, so no ArcLength[]:(. $\endgroup$
    – Dr. belisarius
    Commented Oct 24, 2014 at 11:43

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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