# Plot discrete points as curves with crossing [duplicate]

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]


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.

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]

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]

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 :)

• Your question is very similar to this Q&A have you tried the approach on those answers? Commented Mar 1, 2023 at 12:30
• @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. Commented Mar 1, 2023 at 14:10
• @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.
– lxy
Commented Mar 1, 2023 at 14:32
• "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. Commented Mar 1, 2023 at 14:34
• @jsxs, using my answer from question provided above as curves = findCurves[data, .03] produces desired results. Commented Mar 1, 2023 at 14:38

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}]


If you want functions, you can write:

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

Clear["Global*"]

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

(* {0., 2.995} *)


Use FindCurvePath to separate the segments

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

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


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}]
`