5
$\begingroup$

I am dealing with the root finding of two parametric data curves (data below).

I have already checked Parametric Interpolation of 2D data, which I found useful for plotting, though it is not adequate for interpolating the data and consequently, for finding the point/s where both curves cross.

dat=# {1,10}&/@SortBy[im,-#[[1]]&];
a=First@dat;
b=Rest@dat;
pathim={1,.1} #&/@First@Last@Reap@Do[b=DeleteCases[b,a=Sow@Nearest[b,a][[1]],1];,{Length@b}];
dat=# {1,10}&/@SortBy[re,-#[[1]]&];
a=First@dat;
b=Rest@dat;
pathre={1,.1} #&/@First@Last@Reap@Do[b=DeleteCases[b,a=Sow@Nearest[b,a][[1]],1];,{Length@b}];
Graphics[Line@{pathre,pathim},AspectRatio->1,Frame->True]

Crossing of parametric curves

Consider that if you perform a parametric interpolation, you would still have the problem that both curves will have different parameters $t$ and $t'$.

Any help will be welcome. Thanks in advance,

Francisco

im={{0.0531041079509168`,0.4537856055185257`},{0.05466627362026595`,0.4363323129985824`},{0.055371695336473604`,0.47123889803846897`},{0.0587862063093332`,0.4188790204786391`},{0.05966729343396994`,0.4886921905584123`},{0.06002132511085396`,0.415948661223835`},{0.06002132511085396`,0.4896587722299967`},{0.06575305305020286`,0.4014257279586958`},{0.06620599426144534`,0.5061454830783556`},{0.07002487929599628`,0.3948582697541205`},{0.07002487929599628`,0.5135624010553028`},{0.07512591694116288`,0.5235987755982988`},{0.07616913318690677`,0.3839724354387525`},{0.08002843348113861`,0.37928209464467316`},{0.08002843348113861`,0.5333666581380405`},{0.08446817154140783`,0.5410520681182421`},{0.09003198766628094`,0.36758426429054275`},{0.09003198766628094`,0.5502658471113652`},{0.09086816581576561`,0.3665191429188092`},{0.09506524408809112`,0.5585053606381855`},{0.10003554185142327`,0.3585188972184474`},{0.10003554185142327`,0.5668389658408651`},{0.10599987363255793`,0.5759586531581288`},{0.11003909603656559`,0.3499821309207754`},{0.11003909603656559`,0.5822588977132048`},{0.11118556664133165`,0.3490658503988659`},{0.11751340259454512`,0.5934119456780721`},{0.12004265022170792`,0.344202114592412`},{0.12004265022170792`,0.5973515337967324`},{0.12869769426292388`,0.6108652381980153`},{0.13004620440685025`,0.33895717609139303`},{0.13004620440685025`,0.6131207072459866`},{0.13943871850933623`,0.6283185307179586`},{0.14004975859199256`,0.3337693543200807`},{0.14004975859199256`,0.6293735517037298`},{0.1448928765578632`,0.33161255787892263`},{0.15001734189017396`,0.6457718232379019`},{0.1500533127771349`,0.3299538513479695`},{0.1500533127771349`,0.6458374688532782`},{0.16005686696227722`,0.32724984607051905`},{0.16005686696227722`,0.663160407666875`},{0.1600947333741542`,0.6632251157578453`},{0.16939105761415585`,0.6806784082777885`},{0.17006042114741954`,0.32510426347930604`},{0.17006042114741954`,0.6820027152855632`},{0.17834315993959135`,0.6981317007977318`},{0.18006397533256188`,0.323456717685147`},{0.18006397533256188`,0.7020915043821209`},{0.18659140121444864`,0.7155849933176751`},{0.1900675295177042`,0.3224938152915452`},{0.1900675295177042`,0.7234506689272742`},{0.19432724424416561`,0.7330382858376184`},{0.20007108370284654`,0.32194010589163236`},{0.20007108370284654`,0.7473057900969771`},{0.20140343554157758`,0.7504915783575618`},{0.20824586759352762`,0.767944870877505`},{0.21007463788798886`,0.32198227941312596`},{0.21007463788798886`,0.7735544586917432`},{0.21440848678980026`,0.7853981633974483`},{0.22007819207313117`,0.32268480961476603`},{0.23008174625827352`,0.323717711816065`},{0.24008530044341583`,0.32536509061435503`},{0.2500888546285582`,0.32760449250820817`},{0.2600924088137005`,0.33028549462451157`},{0.26430223561363364`,0.33161255787892263`},{0.2700959629988428`,0.3339970032425843`},{0.2800995171839851`,0.33833635585161864`},{0.29010307136912744`,0.3431145125802778`},{0.3001066255542698`,0.348219551120407`},{0.3016794563236875`,0.3490658503988659`},{0.31011017973941213`,0.35487194552795387`},{0.32011373392455444`,0.36175350208401263`},{0.32674322227218133`,0.3665191429188092`},{0.33011728810969676`,0.3694992086937793`},{0.3401208422948391`,0.3779490778028813`},{0.34724156791654076`,0.3839724354387525`},{0.35012439647998145`,0.3869800216501857`},{0.36012795066512376`,0.397301449763025`},{0.3642757416734221`,0.4014257279586958`},{0.3701315048502661`,0.40818604597717256`},{0.3798968075860652`,0.4188790204786391`},{0.3801350590354084`,0.4191811250284763`},{0.3901386132205507`,0.4316677521878405`},{0.39414905060506983`,0.4363323129985824`},{0.4001421674056931`,0.44396444613816133`},{0.4080491550187325`,0.4537856055185257`},{0.4101457215908354`,0.45676212790254306`},{0.4201492757759777`,0.4696249603539099`},{0.42149486869254693`,0.47123889803846897`},{0.43015282996112003`,0.48258796657484376`},{0.4350833036679111`,0.4886921905584123`},{0.44015638414626235`,0.4954819929471901`},{0.4487072833146444`,0.5061454830783556`},{0.45015993833140466`,0.508055663432461`},{0.46016349251654703`,0.5202514638628473`},{0.46307521883939134`,0.5235987755982988`},{0.47016704670168935`,0.5322780570272747`},{0.477914190905029`,0.5410520681182421`},{0.48017060088683167`,0.5437317838666962`},{0.490174155071974`,0.5544902541741973`},{0.4941879210211103`,0.5585053606381855`},{0.5001777092571164`,0.5648273949103115`},{0.5101812634422587`,0.5748053095034658`},{0.5114599742898591`,0.5759586531581288`},{0.520184817627401`,0.5841495962231561`},{0.5301883718125433`,0.5931600434577045`},{0.5304986382227892`,0.5934119456780721`},{0.5401919259976856`,0.6015014405876375`},{0.5501954801828279`,0.6092182031363506`},{0.5525479998123303`,0.6108652381980153`},{0.5601990343679702`,0.6165152214659495`},{0.5702025885531126`,0.6233328283352525`},{0.5781515740734545`,0.6283185307179586`},{0.5802061427382549`,0.6296561108077645`},{0.5902096969233973`,0.6355223762629595`},{0.6002132511085396`,0.6408151697372594`},{0.6102168052936819`,0.6457035790124366`},{0.6103667848233747`,0.6457718232379019`},{0.6202203594788243`,0.6504250134981324`},{0.6302239136639666`,0.6543542727813271`},{0.6402274678491089`,0.6577018258959079`},{0.6502310220342512`,0.6608382810360297`},{0.65893148745905`,0.6632251157578453`},{0.6602345762193935`,0.6636086146790213`},{0.6702381304045358`,0.6660358970840763`},{0.6802416845896782`,0.6679454676068672`},{0.6902452387748205`,0.6692245391152624`}};re={{0.3766619334176538`,0.6283185307179586`},{0.3774833614565732`,0.6457718232379019`},{0.37836289304330173`,0.5934119456780721`},{0.3794436621915606`,0.6632251157578453`},{0.3800679818708404`,0.5844653112819048`},{0.3800679818708404`,0.667375571838723`},{0.3818120099506517`,0.5759586531581288`},{0.38212616179315456`,0.6806784082777885`},{0.38540217552140743`,0.6981317007977318`},{0.3882567605401741`,0.5585053606381855`},{0.38938774795241116`,0.7155849933176751`},{0.39006977086744143`,0.5551487025539988`},{0.39006977086744143`,0.7184208526690175`},{0.39384490677070083`,0.7330382858376184`},{0.3983398475296372`,0.5410520681182421`},{0.3990895276046064`,0.7504915783575618`},{0.4000715598640425`,0.5390451811857366`},{0.4000715598640425`,0.7536360014898048`},{0.40490154189174227`,0.767944870877505`},{0.4100733488606436`,0.5288508576882919`},{0.4100733488606436`,0.7829547200266151`},{0.4109671363156394`,0.7853981633974483`},{0.41590869326136504`,0.5235987755982988`},{0.42007513785724465`,0.5208888749031353`},{0.4300769268538457`,0.5152293488576334`},{0.4400787158504468`,0.5105095807330549`},{0.45008050484704787`,0.5063401987861282`},{0.45064664649866976`,0.5061454830783556`},{0.4600822938436489`,0.5036814650968815`},{0.47008408284024994`,0.5014626165676501`},{0.48008587183685103`,0.4996348462112899`},{0.4900876608334521`,0.4982219621388478`},{0.5000894498300532`,0.49707951766544517`},{0.5100912388266542`,0.4964390647155012`},{0.5200930278232553`,0.4958486047744673`},{0.5300948168198564`,0.49545500725491304`},{0.5400966058164574`,0.49521155256588884`},{0.5500983948130584`,0.49514685900067146`},{0.5601001838096595`,0.4952291466547238`},{0.5701019728062606`,0.4952990199882136`},{0.5801037618028617`,0.4954981261098205`},{0.5901055507994627`,0.49581927136967574`},{0.6001073397960638`,0.4961027882281859`},{0.6101091287926649`,0.4963622147030731`},{0.6201109177892659`,0.4966042118151429`},{0.630112706785867`,0.49683858164676903`},{0.640114495782468`,0.49705190249915443`},{0.6501162847790691`,0.49712592063118116`},{0.6601180737756702`,0.49718413826216856`},{0.6701198627722712`,0.4972295004992033`},{0.6801216517688723`,0.4972077101740653`},{0.6901234407654734`,0.4970539255431156`}};
$\endgroup$
  • $\begingroup$ Please put semicolons at the ends of such long data lists. Thanks. $\endgroup$ – Michael E2 May 27 '15 at 19:55
  • $\begingroup$ Thanks to everyone for the very useful help you gave me. You helped me to rethink the problem. I finally understood that I had to interpolate separately the x and y components of the curves. $\endgroup$ – Francisco May 27 '15 at 22:24
  • $\begingroup$ Ok Michael, sorry, I will put semicolons. I am really new to posting on this site. $\endgroup$ – Francisco May 27 '15 at 22:25
9
$\begingroup$

You've already done the hard work in putting the path together. Now you could just do a quick and dirty interpolation and FindRoot.

rex = Interpolation[Thread[{Range@Length@pathre, First /@ pathre}]];
rey = Interpolation[Thread[{Range@Length@pathre, Last /@ pathre}]];
imx = Interpolation[Thread[{Range@Length@pathim, First /@ pathim}]];
imy = Interpolation[Thread[{Range@Length@pathim, Last /@ pathim}]];

{rex[t], rey[t]} /. FindRoot[{rex[t] - imx[s], rey[t] - imy[s]}, {{s, 1}, {t, 1}}]

{0.436125,0.512288}

1

$\endgroup$
  • $\begingroup$ Thank you, it seems to work fine, I have to process about 300 of this kind of plots, so I hope it works fine with all of them. By the way, with your method I arrived to a different result: {0.449139, 0.50672}(seems correct anyway), and this error: InterpolatingFunction::dmval: "Input value {-244.665} lies outside the range of data in the interpolating function. Extrapolation will be used. " $\endgroup$ – Francisco May 27 '15 at 22:15
7
$\begingroup$

Perhaps this is close enough?

Graphics`Mesh`FindIntersections[{Line@re, Line@im}]
(*  {{0.436215, 0.512333}}  *)
$\endgroup$
  • $\begingroup$ Hi Michael, maybe my question is very basic, but I could not make your code work on my version 9 of Mathematica $\endgroup$ – Francisco May 28 '15 at 18:33
5
$\begingroup$

A few of your points in the im list seemed to be wrong. I couldn't fully reproduce your plot. After removing those I did:

pathreInt1 = Interpolation[pathre[[All, 1]]];
pathreInt2 = Interpolation[pathre[[All, 2]]];
pathimInt1 = Interpolation[pathim[[All, 1]]];
pathimInt2 = Interpolation[pathim[[All, 2]]];

pathreInt1["Domain"]
(* {{1., 51.}} *)

pathimInt1["Domain"]
(* {{1., 119.}} *)

sol = 
 NMinimize[{(pathreInt1[t1] - pathimInt1[t2])^2 + (pathreInt2[t1] - 
       pathimInt2[t2])^2, 1 <= t1 <= 51, 1 <= t2 <= 119}, {t1, t2}, 
  MaxIterations -> 1000]
(* {2.013*10^-17, {t1 -> 26.3953, t2 -> 34.3709}} *)

Graphics[Line@{pathre, pathim}, AspectRatio -> 1, 
 Frame -> True, 
 Epilog -> {Red, Point[{pathreInt1[t1], pathreInt2[t1]} /. sol[[2]]]}]

Mathematica graphics


By the way: you didn't tell this, but your code is intended to order your points such that neighboring points are next to each other in the list in order to prevent this from happening:

Graphics[Line@{re, im}]

Mathematica graphics

However, there is already a built-in function that does this: ListCurvePathPlot.

Show[ListCurvePathPlot[re], ListCurvePathPlot[im], PlotRange -> All]

Mathematica graphics

$\endgroup$
  • $\begingroup$ After getting the output from ListCurvePathPlot[], you can then use Michael's method… $\endgroup$ – J. M. will be back soon May 27 '15 at 21:22
  • $\begingroup$ Hi, I tried all the options in the thread I referenced mathematica.stackexchange.com/questions/47332/…, and found the one that gave me the best results. Try to apply the method you mention to the set of data on that thread, and you will look that it fails. $\endgroup$ – Francisco May 27 '15 at 22:02
  • 1
    $\begingroup$ You are right, some points were wrong, it was an issue while pasting the data, now I corrected it. Thanks for the observation, and for your long response. $\endgroup$ – Francisco May 27 '15 at 22:42
2
$\begingroup$

BSplineFunction + NArgMin

{f1, f2} = BSplineFunction /@ {pathre, pathim};
τ = Last @ Quiet @ NArgMin[{Norm[f1[t] - f2[α t]], 0 <= t <= 1, 0 <= α < 1}, {α, t}]

0.4763124688614422

ParametricPlot[{f1@t, f2@t}, {t, 0, 1},  Epilog -> {Red, PointSize[.03], Point @ f1 @ τ}]

enter image description here

$\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.