I have a list of data in the form of {x,y} (30K only). The discrete data give two curves with a cross point.

pts = ToExpression /@ Import["~\\testdata.csv"];
ListPlot[pts, PlotRange -> {{0, 3}, {-1, 0.1}}, Frame -> True, ImageSize -> 300, AspectRatio -> 0.6]

enter image description here

My goal:

I would like to plot 2 independent smooth curves according to these points in one graphic as follows. The 2 curves are expected based on their physical meaning.

enter image description here

My trial:

  1. I have tried to separate the two curves using the Unshuffle function provided by @Victor K. in this answer, but it seems that when the two curves are crossing, that code cannot separate them as expected.

    {LstA, LstB} = Unshuffle[pts]; unshufflePlot = ListPlot[{LstA, LstB}, PlotStyle -> {Black, Green}, PlotRange -> {{1, 1.5}, {-0.4, -0.15}}, Frame -> True, ImageSize -> 400, AspectRatio -> 0.6]

enter image description here

  1. I also tried FindCurvePath, which even only gives a small part of the plot...

    curves = FindCurvePath[pts]; FindCurvePlot = ListLinePlot[pts[[curves[1]]], PlotRange -> {{1, 1.5}, {-0.4, -0.15}}, Frame -> True, ImageSize -> 400, AspectRatio -> 0.6]

enter image description here

  1. As suggested by @Domen, I tried the findCurves function in this link, however, it still cannot separate the different curves from the mixed dataset. What it gives is some mixed curves depending on the value of eps in findCurves.

Now, I have no idea to solve this problem. Can someone give some suggestions? Thank you in advance :)

  • $\begingroup$ Your question is very similar to this Q&A have you tried the approach on those answers? $\endgroup$
    – rhermans
    Commented Mar 1, 2023 at 12:30
  • $\begingroup$ @Jsxs Your question has been flagged as a duplicate. Please edit your question to explain how is it different from the other similar questions on the site. Otherwise you risk having the question closed, unable to receive further answers. $\endgroup$
    – rhermans
    Commented Mar 1, 2023 at 14:10
  • $\begingroup$ @rhermans, thank you for your suggestion. I have tested with the answer in the post you provided, that method gives two curves as a whole. Please also see my update. $\endgroup$
    – lxy
    Commented Mar 1, 2023 at 14:32
  • $\begingroup$ "it still cannot separate the different curves from the mixed dataset" is not enough, you have to show your diligence. Please explain what fails and how, show your code attempts, show the outputs. You are making it hard to help you. $\endgroup$
    – rhermans
    Commented Mar 1, 2023 at 14:34
  • $\begingroup$ @jsxs, using my answer from question provided above as curves = findCurves[data, .03] produces desired results. $\endgroup$
    – Domen
    Commented Mar 1, 2023 at 14:38

2 Answers 2


Your data has a simple structure with some flaws. The main feature is that there is always one point of one curve and then a point of the other curve. Therefore, I think one should exploit this feature.

However, there are some irregularities tat need fixing. The first 6 point belong exclusively to curve 2. Then there are 3 points without a partner on the other curve, namely point no.: 351,380,381. Further from point no.: 878 the curves are reversed.

To fix this, we may first reverse the order of the points from point no:. 878 on:

pts[[878 ;;]] = Transpose[Reverse /@ Partition[pts[[878 ;;]], 2]];

Then we can delete the singular points:

pts = Delete[pts, {{351}, {980}, {981}}];

Finally we may disassemble the points by taking the first 6 points:

d0 = dat[[;; 6]];

Then we partition the rest of the points according to the 2 curves:

{d1, d2} = Transpose[Partition[pts[[7 ;;]], 2]];

Then we add the first 6 points to curve 2:

d2 = Join[d0, d2];

Now we have the points separated into 2 curves:

ListLinePlot[{d1, d2}]

enter image description here

If you want functions, you can write:

f1= Interpolation[d1];
f2= Interpolation[d2];

pts = Import["/Users/roberthanlon/Downloads/testdata.csv", "Data"];

{xmin, xmax} = MinMax[pts[[All, 1]]]

(* {0., 2.995} *)

Use FindCurvePath to separate the segments

pts4 = pts[[#]] & /@ FindCurvePath[pts];

 PlotRange -> All,
 PlotLegends -> Placed[Automatic, {.3, .4}]]

enter image description here

Join the line segments

pts2 = {Join[pts4[[1]], pts4[[3]]], Join[pts4[[2]], pts4[[4]]]};

Using FindFormula to fit the curves

funcs = FindFormula[#, x] & /@ pts2

(* {0.0176757 x - 0.419725 x^2 + 0.416205 x^3 - 0.292456 x^4 + 
     0.0928377 x^5 - 0.0106112 x^6, 
   -0.288809 + 0.0187772 x + 0.00952705 x^2 - 0.00298774 x^3} *)

Plot[funcs, {x, xmin, xmax}]

enter image description here


Not the answer you're looking for? Browse other questions tagged or ask your own question.