# Distance between 3D curves

I would like to determine the distance bewteen two representations of the Lorenz Attractor. I have two 3D representations for different initial conditions and I want to calculate the distance between those curves.

The problem is that I have written this for the first and the second and there are only x0, yo and z0 that are different.

NDSolve[{x'[t] == -10 (x[t] - y[t]),
y'[t] == -x[t] z[t] + 28 x[t] - y[t], z'[t] == x[t] y[t] - 8/3*z[t],
x[0] == y[0] == 1, z[0] == 2}, {x, y, z}, {t, 0, 200},
MaxSteps -> Infinity]
ParametricPlot3D[Evaluate[{x[t], y[t], z[t]} /. %], {t, 0, 200},
PlotPoints -> 10000, ColorFunction -> (ColorData["Rainbow"][#4] &)]


I can't use the EuclideanDistance since I don't have the expression of the curves and I'm blocked. I would like to draw the difference between Sqrt(x^2+y^2+z^2) of the 2 curves. Thanks !

-
How would you like to define the distance between curves? Or, how would you like to define the distance between two point-sets? – Silvia Jun 2 '13 at 11:51
I'm not sure this question makes any sense. The whole point of the strange attractors (like the Lorenz equation) is that even small perturbations in an initial condition cause two curves to ultimately differ drastically. So there is no natural metric or notion of distance between two trajectories. – bill s Jun 2 '13 at 12:23

For getting a result we need to compare the solutions of the lorenz differential equations for different initial conditions. We can use the same code for calculating the solutions to different initial conditions by wrapping it in a neat function for later use:

LorenzSolution[{x0_, y0_, z0_}, maxt_] := Function[t, Evaluate[
{x[t], y[t], z[t]} /.
First@NDSolve[
{x'[t] == -10 (x[t] - y[t]),
y'[t] == -x[t] z[t] + 28 x[t] - y[t],
z'[t] == x[t] y[t] - 8/3*z[t],
x[0] == x0, y[0] == y0, z[0] == z0},
{x, y, z}, {t, 0, maxt}, MaxSteps -> Infinity
]
]]


Finding the minimum distance point

Now we can let NMinimize find the parameter arguments of the curves which minimizes the distance of the points on the curves:

With[{maxt = 200},
NMinimize[
{EuclideanDistance[
LorenzSolution[{1, 1, 2.0}, maxt][s],
LorenzSolution[{1, 1, 2.5}, maxt][t]
]
, 0 <= s <= maxt && 0 <= t <= maxt}, {s, t}
, Method -> "DifferentialEvolution"
]
]
(* {0.0324682,{s->157.173,t->153.151}} *)


Example Plot of chaotic behaviour

For seeing the chaotic behaviour regarding small disturbances in the initial conditions for one component the equivalent of your maple-example would be:

Plot[Evaluate[
{LorenzSolution[{10, 10.00, 10}, 200][t][[1]],
LorenzSolution[{10, 10.01, 10}, 200][t][[1]]}]
, {t, 0, 15}, PlotRange -> All, PlotStyle -> {Blue, Green}, AspectRatio -> 1/2.5
]


Plotting Euclidean Distance

If we want to see how the distance evolves in 3D instead of only seeing the x-component, we could do something like this:

Plot[Evaluate[
EuclideanDistance[
LorenzSolution[{10, 10.00, 10}, 200][t],
LorenzSolution[{10, 10.01, 10}, 200][t]
]]
, {t, 0, 15}, PlotRange -> All, PlotStyle -> {Blue, Green}, AspectRatio -> 1/2.5
]


Comparing two curves paramterized by arclength

Since the speed along the curves can vary for different regimes, we could instead be more interested in comparing how much two curves drift apart after completing a certain arc length. For getting the arc length of our lorenz curve it's easiest to add a fourth variable s to our ODE and let NDSolve compute it as part of the solution:

LorenzSolutionWithArclength[{x0_, y0_, z0_}, maxt_] := Function[t, Evaluate[
{x[t], y[t], z[t], s[t]} /.
First@NDSolve[
{x'[t] == -10 (x[t] - y[t]),
y'[t] == -x[t] z[t] + 28 x[t] - y[t],
z'[t] == x[t] y[t] - 8/3*z[t],
s'[t] == (x'[t]^2 + y'[t]^2 + z'[t]^2)^(1/2),
x[0] == x0, y[0] == y0, z[0] == z0, s[0] == 0},
{x, y, z, s}, {t, 0, maxt}, MaxSteps -> Infinity
]
]]


Now we can see how the arclength s evolves with t:

Plot[Evaluate[
{LorenzSolutionWithArclength[{10, 10.00, 10}, 200][t][[4]],
LorenzSolutionWithArclength[{10, 10.01, 10}, 200][t][[4]]}],
{t, 0, 15}, PlotRange -> All, PlotStyle -> {Blue, Green},
AspectRatio -> 1/2.5, AxesLabel -> {"t", "s"}
]


The cooler thing is that now we can use that fourth component to get an arc length parameterized version of our lorenz curve:

ArcLengthParametrisedLorenzSolution[ics_, maxt_] := Module[
{curve = LorenzSolutionWithArclength[ics, maxt], timefromarclength},
timefromarclength = InverseFunction@Function[t, Evaluate[curve[t][[4]]]];
Composition[curve, timefromarclength]
]


and use it to compare the 3D distance after following both curves the same amount of arc length:

With[{maxs = 1500},
Plot[Evaluate[
EuclideanDistance[
ArcLengthParametrisedLorenzSolution[{10, 10.00, 10}, maxs][s][[;; 3]],
ArcLengthParametrisedLorenzSolution[{10, 10.01, 10}, maxs][s][[;; 3]]
]]
, {s, 0, maxs}, PlotRange -> All, PlotStyle -> {Blue, Green},
AspectRatio -> 1/2.5, AxesLabel -> {"s", "distance"}]
]


-
I find that the solution varies greatly if I change the WorkingPrecision around. The curves are at a distance of about 0.01 near s -> 130.37... and t -> 199.68... with 50 digits of precision (Mma 9.0.1) – Michael E2 Jun 2 '13 at 13:29
It's more something which is like the graph on the middle of this page i would like to get. (math.cmaisonneuve.qc.ca/alevesque/chaos_fract/Lorenz/…), it's written in maple. Thanks for the answer – Hey Jun 2 '13 at 16:04
@Hey Do you mean you would like to Plot the distance, EuclideanDistance[LorenzSolution[{1, 1, 2.0}, maxt][s], LorenzSolution[{1, 1, 2.5}, maxt][t]], as a function of t? If so, would you please edit and rephrase your question? – Michael E2 Jun 2 '13 at 16:40