7
$\begingroup$

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 GraphUtilities`LineScaledCoordinate 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 ]

enter image description here

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.

Improve this question
$\endgroup$
1

4 Answers 4

Reset to default
2
$\begingroup$

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

Blockquote

Improve this answer
$\endgroup$
3
$\begingroup$

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]

enter image description here

Improve this answer
$\endgroup$
1
$\begingroup$

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]

Mathematica graphics

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

Mathematica graphics

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} ]
Improve this answer
$\endgroup$
6
  • $\begingroup$ But how to quickly draw the line too? Feeding tthis to ParametricPlot should probably be avoided. $\endgroup$ Commented Oct 12, 2017 at 6:06
  • $\begingroup$ @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? $\endgroup$ Commented Oct 12, 2017 at 13:25
  • $\begingroup$ 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. $\endgroup$ Commented Oct 12, 2017 at 15:54
  • $\begingroup$ 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. $\endgroup$ Commented Oct 12, 2017 at 16:05
  • $\begingroup$ So 'segment' not a point :) arc length parametrized position is given by LineScaledCoordinate anyway. Thanks and no hurry of course. $\endgroup$ Commented Oct 12, 2017 at 17:31
0
$\begingroup$

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

enter image description here

Improve this answer
$\endgroup$
3
  • 1
    $\begingroup$ because each segment in bsf takes 1/numberOfSegments instead of being rescaled by its length. $\endgroup$ Commented Oct 11, 2017 at 19:49
  • $\begingroup$ @Kuba So it is not your after? $\endgroup$ Commented Oct 11, 2017 at 19:49
  • $\begingroup$ nope, it is not. I need arc length parametrization $\endgroup$ Commented Oct 11, 2017 at 19:51

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.