Wolfram言語™

球体上の電荷分布を求める

In[1]:=
`n = 50;`

In[2]:=
`vars = Join[Array[x, n], Array[y, n], Array[z, n]];`

In[3]:=
```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}];```

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

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

In[6]:=
`cartpts = CoordinateTransform["Spherical" -> "Cartesian", spherpts];`

In[7]:=
`initpts = Flatten[Transpose[cartpts]];`

In[8]:=
`sol = FindMinimum[{potential, sphereconstr}, Thread[{vars, initpts}]];`

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

In[10]:=
```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]=