Wolfram Language

Calcul infinitésimal numérique et symbolique

Trouvez la distribution de charge sur une sphère

Trouvez les positions qui minimisent le potentiel de Coulomb pour que des particules de même charge puissent se déplacer librement sur une sphère. Voici la répartition des charges à l'équilibre.

Appelez n le nombre de particules.

In[1]:=
Click for copyable input
n = 50;

Soit , les coordonnées cartésiennes de la ème particule.

In[2]:=
Click for copyable input
vars = Join[Array[x, n], Array[y, n], Array[z, n]];

L'objectif est de minimiser le potentiel de Coulomb.

In[3]:=
Click for copyable input
potential = Sum[((x[i] - x[j])^2 + (y[i] - y[j])^2 + (z[i] - z[j])^2)^-(1/ 2), {i, 1, n - 1}, {j, i + 1, n}];

Les particules se trouvant sur une sphère, leurs coordonnées doivent satisfaire à des contraintes de magnitude unitaire.

In[4]:=
Click for copyable input
sphereconstr = Table[x[i]^2 + y[i]^2 + z[i]^2 == 1, {i, 1, n}];

Choisissez des points initiaux sur la sphère à l'aide de coordonnées sphériques aléatoires.

In[5]:=
Click for copyable input
rpts = ConstantArray[1, n]; thetapts = RandomReal[{0, Pi}, n]; phipts = RandomReal[{-Pi, Pi}, n]; spherpts = Transpose[{rpts, thetapts, phipts}];

Transformez les points initiaux en coordonnées cartésiennes.

In[6]:=
Click for copyable input
cartpts = CoordinateTransform["Spherical" -> "Cartesian", spherpts];

Réorganisez les points initiaux pour correspondre à la commande de variables.

In[7]:=
Click for copyable input
initpts = Flatten[Transpose[cartpts]];

Minimisez le potentiel de Coulomb soumis à la contrainte de la sphère.

In[8]:=
Click for copyable input
sol = FindMinimum[{potential, sphereconstr}, Thread[{vars, initpts}]];

Extrayez les positions d'équilibre des particules de la solution.

In[9]:=
Click for copyable input
solpts = Table[{x[i], y[i], z[i]}, {i, 1, n}] /. sol[[2]];

Tracez le résultat.

In[10]:=
Click for copyable input
Show[ListPointPlot3D[solpts, PlotRange -> {{-1.1, 1.1}, {-1.1, 1.1}, {-1.1, 1.1}}, PlotStyle -> {{PointSize[.03], Blue}}, AspectRatio -> 1, BoxRatios -> 1, PlotLabel -> "Particle Distribution"], Graphics3D[{Opacity[.5], Sphere[]}]]
Out[10]=

Exemples connexes

de en es ja ko pt-br ru zh