# Line Scaled Segment or Arc length parametrization for Line

## Problem

I'm interested in an efficient way to render a scaled segment of a Line[pts], for given t ( (0,1] ).

## 'Show some effort'

So something like GraphUtilitiesLineScaledCoordinate but instead of point I'd like to draw a line from the line beginning up to that point:

Needs["GraphUtilities"]

vertices = {{0, 0}, {1, 0}, {1, 3}, {2, 3}};

LabeledSlider[Dynamic@t]

Graphics[
{ Thick, Line@vertices
, AbsolutePointSize@12, Blue, Dynamic[Point[LineScaledCoordinate[N@vertices, t]]]
}
, Frame -> True
]


I am aware of Generating evenly spaced points on a curve but I want precise solution. Interpolation from equally spaced points can miss original pts.

## Requirements

• efficient, e.g. example above for ~1k points with LineScaledSegment can't be laggy

• exact segment, not a fine mesh of equally spaced points, it will scale badly and miss original vertices anyway

This does not sound like a very hard problem but I'd like to spend time on something else, the more that I feel it is solved internally and it would be nice not to reinvent the wheel.

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];


then

LabeledSlider[Dynamic@t]

Graphics[{Line@coord, Thick, Red,
Line@Dynamic@Append[coord[[;; IntegerPart[ff[t]] - 1]], fxy[t]]},
PlotRange -> {{0, 10}, {0, 10}}]


## 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]


I hope I didn't misunderstand your question. As I see it, you have the arc length directly accessible because you have points with lines in between. This means the Norm between two points gives you the length of this section.

Here an example with increasing line lengths between the points

vertices = Table[{x, x*Sin[Pi x/2]}, {x, 0, 10}];
ListLinePlot[vertices]


Using Accumulate, Partition, and Norm, you can create a list of the total so-far length in each point, where we prepend a zero at the front. Since we are not interested in the total length, we can divide this by the Total to get a list that starts with 0 and ends with 1 and all other values in the list represents the fraction of the "curve"-length we have already visited:

accum = Accumulate[#]/Total[#] &@
Prepend[Norm[Subtract @@ #] & /@ Partition[vertices, 2, 1] , 0]


Funny enough, for this discrete list, this is already our arc length parametrization and we only need to feed it into a linear interpolation, where accum is our s(t) in the usual sense

ipp = Interpolation[Transpose[{accum, vertices}], InterpolationOrder -> 1]


I hope I didn't make some stupid mistake, but that be all you need

Manipulate[
Graphics[{
Line[vertices],
Blue, PointSize[0.03],
Point[ipp[t]],
PointSize[0.01],
Red,
Point@Table[ipp[tt], {tt, 0, t, .02}]
}],
{t, 0, 1}
]


Since all you need is one linear interpolating function, this works reasonably fast even for many points.

## Appendix

As explained in the comments, you can create a function that gives you the points for drawing the lines for an arbitrary t. Count how many entries in accum are <t. You simply want to include those first n points from your vertices. The last point, which is in the middle of two vertices can be calculated using the interpolating function.

vertices = Table[{x, x*Sin[Pi x/2]}, {x, 0, 10}];
create[points_] := With[{
pts = N[points],
accum = Accumulate[#]/Total[#] &[Prepend[Norm /@ Differences[N[points]], 0]]
},
With[{ip = Interpolation[Transpose[{accum, pts}], InterpolationOrder -> 1]},
Function[t, Module[{p = pts, acc = accum},
Which[
t <= 0,
p[[{1}]],
t >= 1,
p,
True,
Append[Pick[p, Negative[acc - t]], ip[t]]
]
]
]
]
]


Then you can use

f = create[vertices];

Manipulate[
Graphics[
{Line[vertices],
Red, Thick,
Line[f[t]]
}],
{t, 0, 1}
]

• But how to quickly draw the line too? Feeding tthis to ParametricPlot should probably be avoided. – Kuba Oct 12 '17 at 6:06
• @Kuba If you want to draw it to t1: Select from accum the first position p which is >t1. You simply want to include all points but the last vertices up to p. Then, you need to make one small function drawing the fraction of vertices[[{p-1, p}]] regarding what's left using accum[[p]]-t1. It comes down to render a line with p points. Should I give an example? – halirutan Oct 12 '17 at 13:25
• I know, it is not a rocket science but that was the question :) how to render this segment. So my point was, the answer is incomplete. – Kuba Oct 12 '17 at 15:54
• I only see the interesting parts: "Line Scaled Segment or Arc length parametrization for Line" :) I see if I find some minutes tonight to clear this up and provide a function for everything. – halirutan Oct 12 '17 at 16:05
• So 'segment' not a point :) arc length parametrized position is given by LineScaledCoordinate anyway. Thanks and no hurry of course. – Kuba Oct 12 '17 at 17:31

I don't know the reason, it not very sync with your blue point

vertices = {{0, 0}, {1, 0}, {1, 3}, {2, 3}};

LabeledSlider[Dynamic@t]

Dynamic[Show[
Graphics[{Thick, Line@vertices, AbsolutePointSize@12, Blue,
Point[LineScaledCoordinate[N@vertices, t]]}, Frame -> True],
ParametricPlot[
BSplineFunction[vertices, SplineDegree -> 1][pos], {pos, 0, t},
PlotStyle -> Directive[Thickness[.02], Red]]]]


• because each segment in bsf takes 1/numberOfSegments instead of being rescaled by its length. – Kuba Oct 11 '17 at 19:49
• @Kuba So it is not your after? – yode Oct 11 '17 at 19:49
• nope, it is not. I need arc length parametrization – Kuba Oct 11 '17 at 19:51