I have a list of several hundreds of InterpolatingFunction
generated by numerical continuations based on different starting points. A list can be downloaded here [68Mb, that's what I needed to have something representative].
My problem is easily understood by plotting the InterpolatingFunction
:
data = Import["list.m"];
Table[With[{fun = data[[i]]},
ParametricPlot3D[fun[[1]], {t, fun[[2, 1]], fun[[2, 2]]}]], {i, 1, Length@data}]
In this figure, I manually circled "similar" curves. Two curves are considered "similar" when they overlap on an interval of non-zero length (let's say of length 1). For obvious reasons, I'd like to keep only one curve of each kind; only the longest one should be conserved. So in this example it would give me only 5 curves (one for each color). The difficulty is that each curve has a different parametrization, so the range of the parameter t
is arbitrary (it has at least $0$ and is at most $[-100,100]$) and @bbgodfrey
's approach fails now that I have added additional curves: it measures a larger difference between the number 1 and number -2 (second to last) than between number 1 and number 7 (the yellow one).
The following approach works, but I'm wondering if there are more efficient alternatives. For example, the above figure was generated in about 3 seconds, so maybe a graphical-based strategy could be better.
In the following code, I compare the point on the first curve corresponding to parameter $t=0$ to the closest point of each other curve. Note: if different curves may intersect in multiple points (e.g. curves red and yellow), the probability that they intersect at a specified location (here, the point of curve 1 for $t=0$) is extremely small.
Table[With[{pt0 = data[[1, 1]] /. t -> 0, fun = data[[i, 1]],
tmin = data[[i, 2, 1]], tmax = data[[i, 2, 2]]},
NMinimize[{Norm[pt0 - fun], tmin < t < tmax}, t][[1]]], {i, Length@data}] // Chop
(* {0, 0, 0, 0.883892, 0.883892, 3.17593, 2.97059, 0, 0, 0.883892, 0, 2.58457,
0.883892, 2.97059, 2.58457, 2.58457, 2.58457, 0, 2.97059, 3.17593, 0,
3.17593, 0.883892, 1.59063, 3.17593, 2.97059, 0.883892, 3.17593, 0, 3.17593} *)
Mathematica.m
withdata = Get["https...
, as in the question, I was able to download the 8 MB file directly to disk. Unfortunately, Mathematica 11.0.1 has been struggling for over 45 minutes to load the code. Therefore, I suggest that you provide a notebook file with say, tenInterpolatingFunctions
that illustrate the issues involved with your question. $\endgroup$ – bbgodfrey Oct 5 '16 at 0:52