3
$\begingroup$

I had around $1000$ data points $(x,y,z)$ and when I plot them they seem to lie on a closed curve. I carefully checked the data points and the points do not repeat rather they are somewhat close to points.

A sample data:

data = Import["https://pastebin.com/raw/HXX5Tgcd", "Table"]

I just need the perimeter (go around exactly once)..is there a method where I can count the number of turns it makes? and may be average out over the full perimeter?

or maybe we can sort the data in such a way around the curve.

I was thinking if we could calculate the length of such a closed curve provided I have data points. enter image description here

$\endgroup$
9
  • 2
    $\begingroup$ What have you tried? Is there any difficulty in simply computing the norm of the vectors between points? $\endgroup$ Aug 1 at 5:46
  • 2
    $\begingroup$ You got answers about how to do it within Mathematica; but mathematically, you're looking for a formula for the arc length of curve. $\endgroup$
    – Neinstein
    Aug 1 at 17:01
  • 2
    $\begingroup$ It's hard for me to judge which answer is best or even correct without the actual data points. Each answer seems correct in its own way and good on possibly different types of data. As such, they are answering slightly different questions. Alexey Popkov's is the best unless it doesn't work, in which case cvgmt's is, unless the data is noisy in which case none are currently very good. $\endgroup$
    – Michael E2
    Aug 1 at 17:33
  • $\begingroup$ Nice answers! I wonder how can I post the data I have? $\endgroup$
    – BAYMAX
    Aug 2 at 5:51
  • 2
    $\begingroup$ You can post it on pastebin.com. $\endgroup$ Aug 2 at 8:18

5 Answers 5

8
$\begingroup$

Use FindShortestTour Or ReconstructionMesh.

data = Table[{Cos[t], Sin[t], Sin[t]*Cos[t]}, {t, 0, 2 \[Pi], .1}];
data = RandomSample[data, Length@data];
{length, indexes} = FindShortestTour[data];
reg = Line[data[[indexes]]];
plot = Graphics3D[reg]
{length, reg // ArcLength, ReconstructionMesh[data] // ArcLength}

enter image description here

{7.63423, 7.63423, 7.63423}

$\endgroup$
2
  • 3
    $\begingroup$ I would suggest applying ArcLength directly to the Line. Using DiscretizeGraphics risks things going wrong in a difficult to control and version dependent manner. $\endgroup$
    – Szabolcs
    Aug 1 at 12:37
  • $\begingroup$ @Szabolcs Thanks, updated. $\endgroup$
    – cvgmt
    Aug 1 at 14:47
6
$\begingroup$

The simplest thing would be to add up the straight lines between points. But that gives a somewhat too short a length because the line is not straight but curved. A better approach seems therefore to interpolate the data points and then calculate the length.

The interpolation is done on the x/y/z component separately:

data = Table[{Cos[t], Sin[t], Sin[t]*Cos[t]}, {t, 0, 2 \[Pi], .1}];
AppendTo[data, data[[1]]];
int[t_] = Interpolation[#, Method -> "Spline"][t] & /@ Transpose@data
NIntegrate[Norm[int'[t]], {t, 1, 64}]

enter image description here

The length is now calculated by integrating the norm of the derivative from the first to the last point:

NIntegrate[Norm[int'[t]], {t, 1, 64}]

(* 7.6404 *)
$\endgroup$
3
  • $\begingroup$ You forgot to append the starting point to data. Therefore your curve isn't closed, and you end up with smaller value than it should be. $\endgroup$ Aug 1 at 14:48
  • $\begingroup$ Also, addition of Method -> "Spline" to Interpolation allows to obtain much better approximation (compare with the exact value ArcLength[{Cos[t], Sin[t], Sin[t]*Cos[t]}, {t, 0, 2 π}]). $\endgroup$ Aug 1 at 14:56
  • $\begingroup$ Alexey, thanks, both improvements applied. $\endgroup$ Aug 1 at 16:00
6
$\begingroup$

Probably the simplest way is to compute the ArcLength of the line. Don't forget to add the first point to the end of the line to make it closed:

data = Table[{Cos[t], Sin[t], Sin[t]*Cos[t]}, {t, 0, 2 π, .1}];
pts = Append[data, data[[1]]];
len1 = ArcLength@Line[pts]
7.634227745692222`

One can also generate an interpolating spline curve with centripetal parametrization using ResourceFunction["LeeInterpolatingNodes"], and then compute its length:

int = Interpolation[Transpose[{ResourceFunction["LeeInterpolatingNodes"][pts], pts}], 
   Method -> "Spline"];
len2 = NIntegrate[Norm[int'[t]], {t, 0, 1}, PrecisionGoal -> 10]
7.640389067320646`

This value is expectedly larger because the line segments are curved rather than straight. Compare with the theoretical arc length of the curve:

l = ArcLength[{Cos[t], Sin[t], Sin[t]*Cos[t]}, {t, 0, 2 π}] // N
7.640395578055424`

By increasing the InterpolationOrder, we can achieve even better approximation:

int = Interpolation[Transpose[{ResourceFunction["LeeInterpolatingNodes"][pts], pts}], 
   Method -> "Spline", InterpolationOrder -> 4];
len3 = NIntegrate[Norm[int'[t]], {t, 0, 1}, PrecisionGoal -> 10]
7.640398305829719`

However, in this case uniform parametrization gives even better result (it is equivalent to the method used by Daniel Huber):

int = Interpolation[Transpose[{ResourceFunction["LeeInterpolatingNodes"][pts, 0], pts}], 
   Method -> "Spline", InterpolationOrder -> 3];
len4 = NIntegrate[Norm[int'[t]], {t, 0, 1}, PrecisionGoal -> 10]
7.640396695308711`

Compare with the theoretical value:

{len1, len2, len3, len4} - l

out

P.S. Strongly related answers: (1), (2).

$\endgroup$
1
  • $\begingroup$ It's interesting that uniform parametrization here works better than the other parametrizations... I'll have to file this example in my notes. $\endgroup$ Aug 2 at 13:05
4
$\begingroup$

This answer concerns the simplest thing that one can do, namely add up the length of the line segments joining the data points. Assuming data is of the form {{x1,y1,z1},...,{xn,yn,zn}}, one can use:

len[data_] := Sum[Norm[data[[i+1]]-data[[i]]],{i,1,Length[data]-1}];

or

len[data_] := Total[Map[Norm,Rest[data]-Most[data]]];

Two comments:

  • I have assumed that OPs data points are "in the right order" already. (OP expresses surprise that the data points give a nice curve. I do not know if this means that the points may be randomly permuted.)
  • If the data points represent a closed curve, where the last and first data point must also be joined, one can use len[Join[data,{First[data]}]].
$\endgroup$
1
  • 2
    $\begingroup$ Or Total@Sqrt@Total[Differences@data^2, {2}] $\endgroup$
    – Michael E2
    Aug 1 at 17:32
3
$\begingroup$

The approach I am about to share will not always work, but when it does, it works very well.

data = Import["https://pastebin.com/raw/HXX5Tgcd", "Table"];

If we plot the data, it looks as if it only slightly deviates from being flat:

data

Because of that, we can try centering the data, apply an SVD, rotate the data to align the $z$-axis to the right singular vector corresponding to the smallest singular value, and then project to 2D (i.e. discard the $z$-coordinate):

dacent = Standardize[data, Mean, 1 &];
vec = Flatten[Last[SingularValueDecomposition[dacent, -1, Tolerance -> 0]]];
proj = Drop[RotationTransform[{vec, {0, 0, 1}}][dacent], None, -1];

Look at the projected data:

ListPlot[proj]

projected data

The reason for projecting to 2D is that we can now use FindCurvePath[], like so:

path = First[FindCurvePath[proj]];

Do some checks:

{Length[path], Length[data], path[[{1, -1}]]}
   {1001, 1000, {783, 783}}

and we see that all points are captured, and the last and first point are the same.

Confirm that we have managed to bring order to chaos:

Graphics3D[Line[data[[path]]]]

line from reordered points

We can now do things as simple as

ArcLength[Line[data[[path]]]]
   18.184031777001636

or as elaborate as

ndata = data[[path]];
tvals = ResourceFunction["LeeInterpolatingNodes"][ndata];
iFun = Interpolation[Transpose[{tvals, ndata}]];
NIntegrate[Sqrt[iFun'[t] . iFun'[t]], {t, 0, 1},
           Method -> "InterpolationPointsSubdivision"]
   18.184100430230554
$\endgroup$
4
  • $\begingroup$ Did you by any chance forget to add Method -> "Spline" to Interpolation? $\endgroup$ Aug 2 at 13:50
  • $\begingroup$ I purposely didn't add it, but now that I tried it out, it doesn't make much difference. $\endgroup$ Aug 2 at 13:51
  • $\begingroup$ Are there any advantages of FindCurvePath over FindShortestTour? $\endgroup$ Aug 2 at 13:57
  • $\begingroup$ Hmm, I hadn't realized FindShortestTour[] directly works on 3D points... now I'm not actually sure which is better than which. $\endgroup$ Aug 2 at 14:03

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.