How do we cluster separate curves in a set of data?

Below, I have included some data. (It is long, but I don't like to host data elsewhere and provide links that might some day be broken.)

Plotting this set of data, we have:

ListPlot@data


There are clearly some curves in this data that "naturally" belong together, as shown below (the two curves labeled by arrows should be associated with each other, but I suspect I'll have to link those two by hand).

However, the data are scrambled, so I can't easily separate the data set into chunks that correspond to these separate curves. For this reason, I need to find a way to cluster this data set to separate the curves.

While I'm not sure that FindClusters is the right tool for the job, the best I've been able to manage using this function is the following:

ListPlot[FindClusters[data, 7, Method -> {"Agglomerate", "Linkage" -> "Complete"}]]


resulting in

We can see that the two clusters that almost cross are clustered together, and also split apart in a strange way. Alternatively, I tried

ListPlot[FindClusters[data, 7, Method -> {"Agglomerate"}]]


resulting in

which is better in that it's not obviously splitting up pieces of a curve that should be together, but it's worse in that it's clustering two clearly separated curves.

• Is FindClusters the right tool for the job, and if so, how do we use it to separate the curves?

• If it's not the right tool for the job, what is? Is there a built-in Mathematica function that will do this job for us, or is there some clustering algorithm specifically designed to find curves like this?

• Note that there are other data sets as well, similar to this one, that I'll need to cluster. The different curves are not always separated vertically as they are here, and there's always one outer curve that subsumes some number of the smaller curves inside it.

• I understand that this will require some amount of manual tinkering at the end, but I'd like to get most of the way there using some automated procedure.

data = {{0.00001, 1.19442}, {0.00001, 1.90161}, {0.00001, 2.14588},
{0.00001, 2.14588}, {0.00001, 2.97948}, {0.00001, 3.80987},
{0.00001, 4.85379}, {0.00001, 5.71745}, {0.00001, 6.74646},
{0.00001, 7.62493}, {0.00001, 8.6456}, {0.00001, 9.53239},
{0.06001, 0.0880935}, {0.06001, 0.0880935}, {0.06001, 0.285726},
{0.06001, 1.13484}, {0.06001, 1.9261}, {0.06001, 2.97527},
{0.06001, 3.82167}, {0.06001, 4.85268}, {0.06001, 5.72497},
{0.06001, 6.74611}, {0.06001, 7.63031}, {0.06001, 8.64556},
{0.06001, 9.53648}, {0.12001, 0.601368}, {0.12001, 1.0439},
{0.12001, 1.94366}, {0.12001, 2.97182}, {0.12001, 3.82973},
{0.12001, 4.85236}, {0.12001, 5.72981}, {0.12001, 6.74655},
{0.12001, 7.63353}, {0.12001, 8.64632}, {0.12001, 9.53873},
{0.18001, 1.95572}, {0.18001, 2.96907}, {0.18001, 3.83448},
{0.18001, 4.85289}, {0.18001, 5.73217}, {0.18001, 6.74786},
{0.18001, 7.63471}, {0.18001, 8.64794}, {0.18001, 9.53919},
{0.24001, 1.96422}, {0.24001, 2.96694}, {0.24001, 3.83652},
{0.24001, 4.85433}, {0.24001, 5.73238}, {0.24001, 6.75011},
{0.24001, 7.63403}, {0.24001, 8.65051}, {0.24001, 9.53798},
{0.30001, 0.00258367}, {0.30001, 0.00258367}, {0.30001, 0.00258367},
{0.30001, 1.97092}, {0.30001, 2.9654}, {0.30001, 3.83636},
{0.30001, 4.85679}, {0.30001, 5.73068}, {0.30001, 6.75344},
{0.30001, 7.63163}, {0.30001, 8.65417}, {0.30001, 9.53518},
{0.36001, 1.97727}, {0.36001, 2.96438}, {0.36001, 3.83435},
{0.36001, 4.86039}, {0.36001, 5.72718}, {0.36001, 6.758},
{0.36001, 7.62754}, {0.36001, 8.65908}, {0.36001, 9.53077},
{0.42001, 0.00726357}, {0.42001, 0.00726357}, {0.42001, 0.00726357},
{0.42001, 1.98438}, {0.42001, 2.96386}, {0.42001, 3.83069},
{0.42001, 4.86531}, {0.42001, 5.7219}, {0.42001, 6.76402},
{0.42001, 7.62169}, {0.42001, 8.66548}, {0.42001, 9.52465},
{0.48001, 1.99315}, {0.48001, 2.96376}, {0.48001, 3.82547},
{0.48001, 4.87176}, {0.48001, 5.71471}, {0.48001, 6.77175},
{0.48001, 7.61391}, {0.48001, 8.67365}, {0.48001, 9.51659},
{0.54001, 0.0139354}, {0.54001, 2.00429}, {0.54001, 2.96404},
{0.54001, 3.81869}, {0.54001, 4.88002}, {0.54001, 5.70541},
{0.54001, 6.78153}, {0.54001, 7.6039}, {0.54001, 8.68393},
{0.54001, 9.50629}, {0.60001, 0.017363}, {0.60001, 2.01834},
{0.60001, 2.96463}, {0.60001, 3.81027}, {0.60001, 4.89045},
{0.60001, 5.69365}, {0.60001, 6.79381}, {0.60001, 7.59126},
{0.60001, 8.69681}, {0.60001, 9.49331}, {0.66001, 0.0203981},
{0.66001, 2.03573}, {0.66001, 2.96545}, {0.66001, 3.80007},
{0.66001, 4.90352}, {0.66001, 5.67898}, {0.66001, 6.80918},
{0.66001, 7.57543}, {0.66001, 8.71291}, {0.66001, 9.47705},
{0.72001, 2.05681}, {0.72001, 2.96643}, {0.72001, 3.7879},
{0.72001, 4.91988}, {0.72001, 5.66073}, {0.72001, 6.82843},
{0.72001, 7.5556}, {0.72001, 8.73308}, {0.72001, 9.45666},
{0.78001, 2.08187}, {0.78001, 2.96745}, {0.78001, 3.7735},
{0.78001, 4.94042}, {0.78001, 5.638}, {0.78001, 6.85271},
{0.78001, 7.53065}, {0.78001, 8.75855}, {0.78001, 9.43091},
{0.84001, 2.11123}, {0.84001, 2.96839}, {0.84001, 3.75656},
{0.84001, 4.96648}, {0.84001, 5.60943}, {0.84001, 6.88378},
{0.84001, 7.49879}, {0.84001, 8.79126}, {0.84001, 9.39788},
{0.90001, 2.14523}, {0.90001, 2.96907}, {0.90001, 3.73667},
{0.90001, 5.00024}, {0.90001, 5.00024}, {0.90001, 5.00024},
{0.90001, 5.57278}, {0.90001, 6.92475}, {0.90001, 7.45692},
{0.90001, 8.83466}, {0.90001, 9.35412}, {0.96001, 2.18434},
{0.96001, 2.96929}, {0.96001, 3.71336}, {0.96001, 5.0459},
{0.96001, 5.52388}, {0.96001, 6.98234}, {0.96001, 7.39833},
{0.96001, 8.89666}, {0.96001, 9.29171}, {1.02001, 2.22921},
{1.02001, 2.96872}, {1.02001, 3.686}, {1.02001, 5.11431},
{1.02001, 5.45183}, {1.02001, 7.08229}, {1.02001, 7.08229},
{1.02001, 7.08229}, {1.02001, 7.29726}, {1.02001, 9.01467},
{1.02001, 9.17323}, {1.08001, 2.28081}, {1.08001, 2.96687},
{1.08001, 3.65384}, {1.14001, 0.0440134}, {1.14001, 2.34068},
{1.14001, 2.96295}, {1.14001, 3.61585}, {1.20001, 0.0524166},
{1.20001, 2.41148}, {1.20001, 2.95537}, {1.20001, 3.57069},
{1.26001, 0.0618122}, {1.26001, 2.49856}, {1.26001, 2.94044},
{1.26001, 3.51641}, {1.32001, 0.0722359}, {1.32001, 2.61739},
{1.32001, 2.90528}, {1.32001, 3.45017}, {1.38001, 0.0837295},
{1.38001, 3.36789}, {1.38001, 3.36789}, {1.38001, 3.36789},
{1.44001, 0.0963406}, {1.44001, 3.26654}, {1.44001, 3.26654},
{1.44001, 3.26654}, {1.44001, 3.26654}, {1.50001, 0.110122},
{1.50001, 3.1645}, {1.50001, 3.1645}, {1.50001, 3.1645},
{1.50001, 3.1645}, {1.50001, 3.1645}, {1.50001, 3.1645},
{1.50001, 3.1645}, {1.56001, 0.125131}, {1.56001, 3.10205},
{1.56001, 3.10205}, {1.56001, 3.10205}, {1.56001, 3.10205},
{1.56001, 3.10205}, {1.62001, 0.141433}, {1.62001, 3.06998},
{1.62001, 3.06998}, {1.62001, 3.06998}, {1.62001, 3.06998},
{1.62001, 3.06998}, {1.68001, 0.159097}, {1.68001, 3.0501},
{1.68001, 3.0501}, {1.68001, 3.0501}, {1.68001, 3.0501},
{1.68001, 3.0501}, {1.74001, 0.178202}, {1.74001, 3.0349},
{1.74001, 3.0349}, {1.74001, 3.0349}, {1.74001, 3.0349},
{1.74001, 3.0349}, {1.74001, 3.0349}, {1.74001, 3.0349},
{1.80001, 0.198834}, {1.80001, 3.02131}, {1.80001, 3.02131},
{1.80001, 3.02131}, {1.80001, 3.02131}, {1.80001, 3.02131},
{1.80001, 3.02131}, {1.80001, 3.02131}, {1.86001, 0.221089},
{1.86001, 3.00786}, {1.86001, 3.00786}, {1.86001, 3.00786},
{1.86001, 3.00786}, {1.86001, 3.00786}, {1.86001, 3.00786},
{1.86001, 3.00786}, {1.92001, 0.245072}, {1.92001, 2.99369},
{1.92001, 2.99369}, {1.92001, 2.99369}, {1.92001, 2.99369},
{1.92001, 2.99369}, {1.98001, 0.270904}, {1.98001, 2.97826},
{1.98001, 2.97826}, {1.98001, 2.97826}, {1.98001, 2.97826},
{1.98001, 2.97826}, {2.04001, 0.298719}, {2.04001, 2.96116},
{2.04001, 2.96116}, {2.04001, 2.96116}, {2.04001, 2.96116},
{2.04001, 2.96116}, {2.10001, 0.328668}, {2.10001, 2.94206},
{2.10001, 2.94206}, {2.10001, 2.94206}, {2.10001, 2.94206},
{2.10001, 2.94206}, {2.16001, 0.360928}, {2.16001, 0.360928},
{2.16001, 0.360928}, {2.16001, 2.92066}, {2.16001, 2.92066},
{2.16001, 2.92066}, {2.16001, 2.92066}, {2.16001, 2.92066},
{2.22001, 0.3957}, {2.22001, 2.89665}, {2.22001, 2.89665},
{2.22001, 2.89665}, {2.22001, 2.89665}, {2.22001, 2.89665},
{2.28001, 0.433221}, {2.28001, 2.86974}, {2.28001, 2.86974},
{2.28001, 2.86974}, {2.28001, 2.86974}, {2.28001, 2.86974},
{2.28001, 2.86974}, {2.34001, 0.473772}, {2.34001, 2.8396},
{2.34001, 2.8396}, {2.34001, 2.8396}, {2.34001, 2.8396},
{2.34001, 2.8396}, {2.34001, 2.8396}, {2.34001, 2.8396},
{2.34001, 2.8396}, {2.34001, 2.8396}, {2.40001, 0.517693},
{2.40001, 2.80585}, {2.40001, 2.80585}, {2.40001, 2.80585},
{2.40001, 2.80585}, {2.40001, 2.80585}, {2.46001, 0.5654},
{2.46001, 2.76805}, {2.46001, 2.76805}, {2.46001, 2.76805},
{2.46001, 2.76805}, {2.46001, 2.76805}, {2.52001, 0.617417},
{2.52001, 0.617417}, {2.52001, 0.617417}, {2.52001, 2.72566},
{2.52001, 2.72566}, {2.52001, 2.72566}, {2.58001, 0.674419},
{2.58001, 2.678}, {2.58001, 2.678}, {2.58001, 2.678},
{2.58001, 2.678}, {2.64001, 0.737304}, {2.64001, 2.62416},
{2.64001, 2.62416}, {2.64001, 2.62416}, {2.64001, 2.62416},
{2.70001, 2.56289}, {2.70001, 2.56289}, {2.76001, 0.886298},
{2.88001, 1.08495}, {2.88001, 1.08495}, {2.94001, 1.22081},
{2.94001, 2.18143}, {2.94001, 1.22081}};


1 Answer

EDIT: Added missing definition

This uses a little manual intervention

segments = Reverse[data[[#]] & /@ FindCurvePath[data]];

segments =
ReplacePart[
segments, -1 ->
Sequence[
ss = Select[segments[[-1]], 1.5 < #[[2]] < 3 && #[[1]] < 1.4 &],
Complement[segments[[-1]], ss]]];

ListPlot[segments, PlotLegends -> Automatic]


• I can't seem to get your code to run (because segments isn't defined before you use it inside ReplacePart), but I get the general gist: essentially, we need to manually select the curve that's "inside" the other one, but the rest will work fine. It doesn't look like FindCurvePath has any customization at all, so there's no way to tell it to fiddle with it the way we can fiddle with FindClusters, which is too bad. Nonetheless, this is a hopeful approach, since it does most of the work. Oct 17, 2018 at 5:05