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$
  • $\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 '14 at 18:49
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$
  • $\begingroup$ I guess FindCurvePath is the key here. Very nice. $\endgroup$ – Rahul Feb 27 '14 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$ – Dr. belisarius Feb 27 '14 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, privacy policy and cookie policy

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