6
$\begingroup$

Suppose I have a data set of 3D coordinates that form a pretty continuous path in space. I would like to measure the total arc length (or path length) of the entire system. At this point the coordinates are not connected. Here's what I have so far

$\endgroup$
  • 6
    $\begingroup$ Are the points in the correct order or do you need to order them first? $\endgroup$ – Jason B. Oct 12 '16 at 20:14
  • $\begingroup$ The points are in the correct order! $\endgroup$ – Erika Oct 17 '16 at 18:24
  • 1
    $\begingroup$ then all you need is ArcLength@Line@pts $\endgroup$ – Jason B. Oct 17 '16 at 18:29
11
$\begingroup$

The very best method

Bob Hanlon, in a comment below, solved the issue with what I further call an "ingenious method":

Total[RegionMeasure@*Line /@ (list[[#]] & /@ FindCurvePath[list])]

working with list of points forming a nicely behaving (e.g., no loops) curve in 2D or 3D.


Straightforward approach

data = Table[{x, x^2, x^3}, {x, 0, 1, 0.01}];

ListPointPlot3D @ data

enter image description here

The "exact" result in this case is

NIntegrate[Norm @ D[{x, x^2, x^3}, x], {x, 0, 1}]

1.86302

A rough estimate might be the sum of distances between consecutive pairs of points:

Total @ (EuclideanDistance @@@ Partition[data, 2, 1])

1.86301

or in a compact form

RegionMeasure @ Line[data] (* thanks: Szabolcs *)

1.86301

or

ArcLength @ Line @ data (* thanks: JasonB *)

1.86301


Overcoming some caveats

The above assumes that the points are ordered in the "correct" way. Simple Sort won't work when the curve "runs back", and the points are not in the correct order. As an illustration let's take

f[x_] := -1 + 4 x - 4 x^2 + x^3

data2 = Table[{f[x], x^2, x^3}, {x, 0, 3, 0.01}];

ListPointPlot3D @ data2

enter image description here

NIntegrate[Norm @ D[{f[x], x^2, x^3}, x], {x, 0, 3}]

30.0472

and

RegionMeasure @ Line[data2]

30.0472

or

ArcLength @ Line @ data2

30.0472

coincide nicely. Here's what happens when the points are in random order:

data3 = RandomSample @ data2;

RegionMeasure @ Line[data3]

2747.76

and Sort fails miserably:

RegionMeasure @ Line[Sort@data3]

1548.66

I define a set

data4 = data3;

in which I find the "smallest" point:

start = Min /@ Transpose@data4

{-1., 0., 0.}

which for future use I'll make a copy of:

s0 = {start};

and now I seek point after point the point nearest to the preceding:

data5 = s0~Join~Reap[Do[
      data4 = Complement[data4, {start}]; 
      Sow[start = Nearest[data4, start][[1]]];, {i, 300}
      ]
     ][[2, 1]];
(* I guess this could be done in a different way, possibly with NestList, or with some other ingenious method *)

which gives

data5 == data2

True

and of course

RegionMeasure @ Line[data5]

30.0472


Another approach can employ FindShortestTour (thanks: JulienKluge and Rahul):

start = Min /@ Transpose@data3
end = Max /@ Transpose@data3

t1 = Max @ Position[data3, start]
t2 = Max @ Position[data3, end]

First @ FindShortestTour[data3, t1, t2]

30.0472


Wrapping things up in a single function

curveLength[data_] := Block[{data4 = data, start, s0, data5},
  start = Min /@ Transpose@data4;
  s0 = {start};
  data5 = s0~Join~Reap[Do[
       data4 = Complement[data4, {start}]; 
       Sow[start = Nearest[data4, start][[1]]];, {i, 
        Length @ data4 - 1}
       ]
      ][[2, 1]];
  RegionMeasure @ Line[data5]
  ]

curveLength[data]

1.86301


ISSUE

None of the above approaches (except for the FindCurvePath one) will work with curves like this:

enter image description here

because the starting point was found as a point with its coordinates smallest in the data set, which is not the case now. One can of course provide the starting point manually, and then the length of the curve can be still obtained.

| improve this answer | |
$\endgroup$
  • 6
    $\begingroup$ Lazy man's way: RegionMeasure@Line[data]. $\endgroup$ – Szabolcs Oct 12 '16 at 21:08
  • 1
    $\begingroup$ For the last Part: you could have also used FindShortestTour $\endgroup$ – Julien Kluge Oct 12 '16 at 22:09
  • 1
    $\begingroup$ @JulienKluge I thought about that, but RegionMeasure@Line@data3[[FindShortestTour[data3][[2]]]] gives 58.6909; one needs first to find the starting point (which is on position 196 in this case) and swap it with the first element in the list, which appears not to be so trivial. If you can come up with an idea I'd love to hear it. $\endgroup$ – corey979 Oct 12 '16 at 22:21
  • $\begingroup$ Ohh okay. Thanks for the clarification. $\endgroup$ – Julien Kluge Oct 12 '16 at 22:22
  • 2
    $\begingroup$ Total[RegionMeasure@*Line /@ (data3[[#]] & /@ FindCurvePath[data3])] $\endgroup$ – Bob Hanlon Oct 13 '16 at 0:13

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.