**Context**

As a Follow up of this question and both nice answers

given there, I am after an algorithm *which could trace the two curves
as they cross*.

We are trying to predict the formation of discs of intermediate mass black hole orbiting super massive black holes in galactic centres.

This involves finding calorific curves in energy and angular momentum space.

**Problem**

I am trying to identify sets of curves from a (very large) sets of points in order to produce a lighter figure.

For instance I want to be able to redo such figure, but with less points (without loosing the poorly sampled lines).

The challenge is that these points are found by some complex optimisation routine

and are over-numerous in places. So by lighter figure, I mean remove sets of point very close to each other while keeping more sparsely sampled points in order to draw curves

through them. **Note importantly that the curves cross.**

**Question**

How can one achieve this simultaneous downsampling and curve matching procedure?

**Attempt**

Let me define a toy problem as follows: let me produce two curves:

```
data = Flatten({Table({x, Sin(x^2/15)}, {x, 0, 20, 0.01}),
Table({x, 1 + Cos(x)}, {x, 0, 20, 0.1})}, 1);
```

and draw random points from those. **Note that the offset is now 1 not 2!**

```
pts = RandomChoice(data, Length(data));
ListPlot(pts)
```

Note again that on purpose the sampling is not the same for the two curves.

Following this (otherwise excellent) answer I can get a good resampling as follows:

```
tour = Last(FindShortestTour(pts));
tourPts = Extract(pts, List /@ tour);
peaks = Ordering(EuclideanDistance @@@ Partition(tourPts, 2, 1), -2);
{firstCurve, secondCurve} =
TakeDrop(RotateLeft(tourPts, peaks((1))), Abs(Subtract @@ peaks));
np(f_)(u_, dt_) := u + dt/Norm(f'(u))
equallySpacedPts(pts_, dt_) :=
With({bsf = BSplineFunction(pts)},
bsf /@ Most(NestWhileList(np(bsf)(#, dt) &, 0, # < 1 &)))
equallySpacedPts(#, 0.25) & /@ {firstCurve, secondCurve} // ListLinePlot
```

BUT It is clear that the two curves are not (always) properly matched, e.g. near `x=10`

.

I understand that this is not a trivial matter, but it should be of general interest for mathematica to be able to stand up to this challenge (?).