How to extract points from a closed curve

Question

OK, let's create a simple closed curve

C0 = ContourPlot[x^2/4 + y^2/9 == 1, {x, -5, 5}, {y, -5, 5}];

and let's plot the corresponding points

data = C0[[1, 1]];
S0 = ListPlot[{data}] 

Now I want to be able to create a new list, data2 containing N points of the curve. These N points should not be random but have equal distances from each other. Any suggestions?

Two important notes:

(1). The above ellipse is just a simple scenario. The real data file corresponds to a closed curve with unknown implicit function. So, the suggested solution should not take into account the particular function. Only data is known.

(2). If we assume that data contains N0 points (on our example N0 = 200) the solution should also work for N > N0.

A good starting point would be to find a solution in our example when N = 100 and when N = 300, taking always into account the two above-mentioned important notes.

Many thanks in advance.

EDIT

Using @gpap approach for N = 100 the output is the following

Aw we can see the points are not equally spaced.

Answer 1

Borrowing from one of Vitaliy Kaurov's answers to Generating evenly spaced points on a curve, here is a way to get 100 points. Change the setting to Mesh to get a different number.

plot = ContourPlot[x^2/4 + y^2/9 == 1, {x, -5, 5}, {y, -5, 5}, 
  MeshFunctions -> {"ArcLength"}, Mesh -> 100];

Cases[Normal@plot, Point[p_] :> p, Infinity]
(*
  {{-0.505748, -2.89977}, {-0.648738, -2.83537},
   ...
   {-0.0474628, -2.99777}, {-0.203681, -2.98306}
*)

---

Or, if the data is "given" -- i.e., we do not have the function from ContourPlot -- then interpolating the curve, as LLlAMnYP does, and plotting can work:

sifn = Interpolation[
   MapIndexed[{#2 - 1, #1} &,
    data[[First@FindCurvePath[data]]]
    ],
   PeriodicInterpolation -> True];

plot = ParametricPlot[sifn[t], {t, 0, 200}, 
   MeshFunctions -> {"ArcLength"}, Mesh -> 100
   ];
Cases[Normal@plot, Point[p_] :> p, Infinity]

Answer 2

Given that a list of points might be viewed a polygonal path, my answer to Equidistant points on a polyline may be applied here:

With[{loop = Append[data, First@data], n = 100},
 arclengths = Accumulate[Norm /@ Differences@loop];
 pfn = Interpolation[
   Transpose@{List /@ Rescale@Prepend[arclengths, 0.], loop}, 
   InterpolationOrder -> 1, PeriodicInterpolation -> True];

 Show[
  C0, Graphics[{Red, Point[pfn@Subdivide[n - 1]]}]
  ]
 ]

Answer 3

Here's a very inefficient way. Generate an interpolation:

ifunc = Interpolation@MapIndexed[{First@#2,#1}&,data]

Oversample the data:

datafine = ifunc/@Range[1,Length@data,.1];

Use a rather inefficient replacement rule:

datafiltered = datafine //. {h___List, a_List, b_List, t___List} :>
                            {h, a, t} /; Norm[a - b] < 0.1;

Plot with correct aspect ratio:

ListPlot[datafiltered, AspectRatio -> Automatic]

Answer 4

You can resample each list of coordinates (if you undersample with respect to the fine details of the curve, this won't work as well):

points=40;
newList=Transpose[ArrayResample[#, points] & /@ Transpose@data];
ListPlot@newList

Alternatively, you can use the MeshFunctions option of ListLinePlot.

---EDIT---

Initially I thought that #3 is just arc length but it is not the case as you pointed out. I noticed @MichaelE2 has a named mesh function {"ArcLength"} so this works here just as well(I am not sure it will on v9 though). You still need to add a point manually:

newList2=Cases[ListLinePlot[data, MeshFunctions -> {"ArcLength"}, Mesh -> points][[1]] // Normal, Point[a_] :> a, Infinity];
ListPlot@newList2

Answer 5

Here's a different approach. It's similar to a post that was just written, then deleted (by Michael_E2, I think). Let's get a cyclic interpolation of the data:

ifunc = Interpolation[({{0, Last@data}}~Join~
    MapIndexed[{First@#2, #1} &, data]), 
  PeriodicInterpolation -> True]
{sol} = NDSolve[g'[t] == Norm[D[fun[t], t]] && g[1] == 0, g, {t, 0, 200}];

This is assuming, we are dealing with a closed curve. g appears to be roughly linear, this is exploited in selecting the starting value in the following FindRoot command:

tvals = t /. 
   With[{n = 30, g = g /. sol}, 
    FindRoot[g[t] == #, {t, 200/g[200]*#}] & /@ 
     Range[g[200]/n, g[200], g[200]/n]] // Quiet;

Using this...

ListPlot[(ifunc /@ tvals), AspectRatio -> Automatic]