2
$\begingroup$

I want to determine the intermediate values of

P[i][t] = {X[i][t], Y[i][t]} 

for the following system of nonlinear differential equations:

ClearAll["Global`*"]

n = 3;

P[i_][t_] = {X[i][t], Y[i][t]};

p[j_, i_] = Norm[P[i][t] - P[j][t]];

A@p[j, i] = (a*(P[i][t] - P[j][t]))/Exp[b*p[j, i]];

R@p[j, i] = (c*(P[i][t] - P[j][t]))/p[j, i]^2;

summand1 = R@p[j, i] - A@p[j, i];

A@p[i, j] = (a*(P[j][t] - P[i][t]))/Exp[b*p[i, j]];

R@p[i, j] = (c*(P[j][t] - P[i][t]))/p[i, j]^2;

summand2 = A@p[i, j] - R@p[i, j];

sys = Table[D[P[i][t], t] == Sum[If[j < i, summand1, 0], {j, 1, n}] + Sum[If[i < j, summand2,
0], {j, 1, n}] + {.1 (1/Norm[{0, Y[i][t]} - P[i][t]] - 1/Norm[P[i][t] - {10, Y[i][t]}]), 
.1 (1/Norm[{X[i][t], -1} - P[i][t]] - 1/Norm[P[i][t] - {X[i][t], 3}])}, {i, 1, n}];

sol = ParametricNDSolveValue[{sys, P[1][0] == {1, 1}, P[2][0] == {2, 2}, P[3][0] == {3, 2}}, 
Table[P[i][t], {i, 1, n}], {t, 0, 100}, {a, b, c}];

Manipulate[ParametricPlot[sol[a, b, c] // Evaluate, {t, 0, T}, PlotRange -> {{0, 10}, 
{0, 10}}, ImageSize -> Large, AspectRatio -> 1], {{a, 1}, .1, 5}, {{b, 1}, .1, 5}, 
{{c, 1}, .1, 5}, {{T, 1}, .1, 100}]

My goal is to draw lines between each pair

P[i][t], P[j][t] 

for $i \neq j$. Basically, my goal is drawing connections between the endpoints of the solution curves in order to visualize a certain equilibrium state (which might for example be an equilateral triangle in this case). For me it suffices to include the connections for

t = T

Is it possible to draw these lines within Manipulate?

Any tips are appreciated.

$\endgroup$
3
$\begingroup$

If I understand what you are looking form, it could be a simple fix. For instance, you could add a Polygon object as an Epilog to your ParametricPlot, whose vertices are the values of the solution at $t=T$, i.e. something like:

Polygon[sol[a, b, c] /. t -> T]

Here is your minimally modified Manipulate:

Manipulate[
 ParametricPlot[
    sol[a, b, c] // Evaluate, {t, 0, T},
    PlotRange -> {{0, 10}, {0, 10}},
    ImageSize -> Large, AspectRatio -> 1,
    (* This line below is the only change: *)
    Epilog -> {EdgeForm[Red], FaceForm[None], Polygon[sol[a, b, c] /. t -> T]}
  ],
  {{a, 1}, .1, 5}, {{b, 1}, .1, 5}, {{c, 1}, .1, 5},
  {{T, 1}, .1, 100}
]

with triangle

$\endgroup$
  • $\begingroup$ Exactly what I was asking for (even better because you can see the triangle evolving in time!). Is there a build-in which can display the properties of polygons such as the lengths of the sides and the angles in between? By the way, as far as I understand Polygon[sol[a, b, c] /. t -> T] creates n lines (between 'endpoints') without giving us the choice to say create a triangle out of four solution curves? I am asking this because there's a phenomenon called clustering for greater values of n in which we don't want Mathematica to draw irrelevant lines between solution curves. $\endgroup$ – E4M2227601 May 11 '18 at 22:00
  • $\begingroup$ @E4M2227601 You are correct that Polygon will generate an $n$-dimensional polygon when given $n$ points. Can you specify how you would like to generate a triangle from four points? Are you looking for the convex hull of those points perhaps (see ConvexHullMesh) ? Note also that your code fails if I change $n$ to e.g. 4, so I couldn't quite try it out. $\endgroup$ – MarcoB May 11 '18 at 22:25
  • $\begingroup$ That's because you also need 4 solution curves and thus 4 initial conditions (I tried P[1][0] == {1, 0}, P[2][0] == {1, 1.5}, P[3][0] == {1.5, 2}, P[4][0] == {2, 2} and got a nice polygon, for example the setup a = 5 b = .65 and c = 4 gives a rhombus as the curves evolve in time). What I'm thinking of is for example $n = 6$ divided into 2 triangles (polygons). I want to specify the polygons between the curves by myself. $\endgroup$ – E4M2227601 May 11 '18 at 22:35

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.