2
$\begingroup$

I have few hundred data points corresponding to an irregular shape closed curve. As the result I have data points that have the same value of y but different values of x. I want to create an interpolation curve and find the intersection of the curve with a straight line. When I try to interpolate the data Mathematica tells me that there are duplicates. Is there any way of finding the intersection of the curve with a straight line?

Here is how I was trying to do it

aa = Interpolation[Data, InterpolationOrder -> 1];
Interpolation::inddp: "The point -6.72 in dimension 1 is duplicated"

FindRoot[aa[x] - x, {x, bestguess}]

Thank you in advance.

$\endgroup$
1
  • $\begingroup$ Do you mean that there are points with the same $x$ value but different $y$ values? That will cause errors. Having the same $y$ value but different $x$ values will not cause errors. Why interpolation would work in the first case is quite clear. You would need to decide what to do (how to interpolate) in those points and describe that in the question. Then people can advise you on how to implement your idea. $\endgroup$
    – Szabolcs
    Feb 26, 2014 at 18:49

2 Answers 2

3
$\begingroup$

Here's a way to do it with Interpolation and FindRoot. Note that using Interpolation[] this way (one coordinate at a time) you'll not get the "duplicate point" error message:

SeedRandom[42];
len = 200;
lineParms = RandomReal[{-1, 1}, 2];
list = Table[{Cos[t], Sin[t]}, {t, RandomReal[{0, 2 Pi}, len]}];
curve = FindCurvePath[list];
{xc, yc} = Interpolation[#, PeriodicInterpolation->True]&/@ Transpose@list[[First@curve]];
myline[x_, y_] := y + #1 x + #2 & @@ lineParms;
fr = First@FindRoot[myline[xc[t], yc[t]], {t, len}]
{xc[t], yc[t]} /. fr
(*
t -> 189.04
{-0.997462, 0.0701403}
*)

Showing the intersection:

GraphicsRow[{
    Plot[myline[xc[t], yc[t]], {t, 1, 2 (len + 1)}, 
         Epilog -> {Red, PointSize@Large, Point@({t, myline[xc[t], yc[t]]} /. fr)}], 
    Show[
         ContourPlot[myline[x, y] == 0, {x, -1, 1}, {y, -1, 1}], 
         ParametricPlot[{xc[t], yc[t]}, {t, 1, (len + 1)}], 
         Graphics[{Red, PointSize[Large], Point@({xc[t], yc[t]} /. fr)}]]}]

Mathematica graphics

$\endgroup$
2
  • $\begingroup$ I guess FindCurvePath is the key here. Very nice. $\endgroup$
    – user484
    Feb 27, 2014 at 13:26
  • $\begingroup$ @RahulNarain The only caveat is that FindCurvePath[] isn't very clever. I've had to roll up my own in some not-so-special cases $\endgroup$ Feb 27, 2014 at 13:58
1
$\begingroup$

Not exactly what you want, but perhaps useful as an approximation:

list = Table[{Cos[t], Sin[t]}, {t, RandomReal[{0, 2 Pi}, 100]}];
curve = FindCurvePath[list];
myPoly = Polygon@list[[curve[[1]]]];
myLine = Line@{{-1, -1}, {-.5, 1}};
pts = Graphics`Mesh`FindIntersections[{myLine, myPoly}];
Graphics[{Blue, FaceForm[None], EdgeForm[{Thick, Blue}], myPoly, 
         Green, Thickness[.02], myLine, 
         Red, PointSize[.05], Point@pts}]

Mathematica graphics

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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