Line Scaled Segment or Arc length parametrization for Line
Method 1, old code tweak
LineScaledCoordinate
is not ReadProtected
so I took and changed two lines:
LineScaledSegment[coord_?MatrixQ, rr0_] := Module[
{dist, dist2, sta, sto, newpos, total, rr = rr0}
, If[SameQ[coord, {}], Return[{}]]
; If[Equal[Length @ coord, 1], Return[coord[[1]]]]
; If[Greater[rr, 1], rr = 1]
; If[Less[rr, 0], rr = 0]
; dist = Map[Norm, Drop[coord + -RotateLeft[coord], -1]]
; total = Total @ dist
; If[LessEqual[total, $MachineEpsilon], Return[coord[[1]]]]
; DivideBy[dist, total]
; dist2 = FoldList[Plus, 0, dist]
; Part[dist2, Length[dist2]] = 1.
; sto = Part[
Flatten[
Position[dist2, PatternTest[_, GreaterEqual[#, rr] &]]
]
, 1
]
; If[Equal[sto, 1], Return[ coord[[{1, 1}]]]] (*1 -> {1,1}*)
; sta = sto - 1
; newpos = Plus[coord[[sta]]
, Divide[
(rr + -Part[dist2, sta]) * (Part[coord,
sto] + -Part[coord, sta])
, Part[dist2, sto] + -Part[dist2, sta]
]
]
; Append[coord[[;; sto - 1]], newpos] (*previously just newpos*)
]
path2 = RandomReal[10, {10^3, 2}];
t = 0;
LabeledSlider@Dynamic@t
Graphics[{
Line@path2, Thick, Red,
Line@Dynamic@LineScaledSegment[path2, t]
}, ImageSize -> 500]
Modifying Kuba's code using Interpolation
it seems maybe (??) to work faster...
coord=RandomReal[10,{10^3,2}];
dist=Map[Norm,Drop[coord+-RotateLeft[coord],-1]];
total=Total@dist;
DivideBy[dist,total];
dist2=FoldList[Plus,0,dist];
ff=Interpolation[Thread@{dist2,Range@Length@dist2},InterpolationOrder->0];
fxy=Interpolation[Thread@{dist2,coord},InterpolationOrder->1];
then
LabeledSlider[Dynamic@t]
Graphics[{Line@coord, Thick, Red,
Line@Dynamic@Append[coord[[;; IntegerPart[ff[t]] - 1]], fxy[t]]},
PlotRange -> {{0, 10}, {0, 10}}]