Hola, hemos encontrado la solución a lo que buscas, has scroll y la verás aquí.
Solución:
Si se aceptan enfoques más ad hoc e inexactos, una forma de generar una densidad relativamente uniforme de puntos en una esfera es utilizar el algoritmo de Monte Carlo Lloyd (modificado para el caso esférico):
With[points = 200, samples = 40000, iterations = 20,
Nest[With[randoms = Join[#, RandomPoint[Sphere[], samples]],
Table[[email protected]@Extract[randoms, Position[#, i]], i, points] &@
Nearest[# -> Automatic, randoms,
DistanceFunction -> (1 - Dot[#1, #2] &)]] &,
RandomPoint[Sphere[], points], iterations]] //
Graphics3D[Sphere[0, 0, 0, 0.999], Red, [email protected]#] &
EDITAR:
Lo anterior se puede escribir de forma más concisa y mucho más eficiente como:
With[points = 200, samples = 40000, iterations = 20,
Nest[
With[randoms = Join[#, RandomPoint[Sphere[], samples]],
[email protected]
@randoms[[#]] & /@
[email protected]@Nearest[#, randoms]] &,
RandomPoint[Sphere[], points], iterations]] //
Graphics3D[Sphere[0, 0, 0, 0.999], Red, [email protected]#] &
Aha ~ Supongo que esta pregunta se crea al resolver esto. Estoy en lo correcto @yode: P
Entonces, aquí hay una solución fácil, simple, elegante y, ¿puedo decir que incluso bastante rápida después de alguna optimización?
pt = With[p =
Table[x[i], y[i], z[i], i, 80(*number of charges*)],
p /. [email protected]
NMinimize[
Total[1/Norm[Normalize[#1] - Normalize[#2]] & @@@
Subsets[p, 2]], Flatten[p, 1]]];
Graphics3D[[email protected], [email protected], Sphere[], [email protected],
[email protected], [email protected], [email protected]*Normalize /@ pt]
El resultado es bastante bueno:
la configuración de la variable de minimización es crucial, o el punto no estará en la superficie. Pero afortunadamente, nuestra ‘física de jardín de infantes’ nos enseñó que cuando las cargas se dispersan libremente en una esfera, ¡siempre estarán en la superficie de manera uniforme! Por lo tanto, esta debe ser una forma de dispersión “más uniforme”, ya que sigue las leyes físicas.
Para una distribución aproximadamente uniforme de puntos en cualquier superficie con simetría cilíndrica, podemos usar el Ángulo Áureo, de la misma manera que lo usa el girasol en el plano.
Para colocar N puntos en la superficie de una esfera, defina un eje. Divida la superficie en N franjas de igual área perpendiculares al eje. Para k en 0 a N-1, en la k-ésima franja, coloque un punto en un ángulo de k * ga, en el centro de su ancho. ga es el ángulo dorado, 1 / (phi + 1) de un círculo, aproximadamente 137,5 grados / 2,34 rads.
Esta construcción se puede generalizar a la superficie de cualquier volumen de revolución, por ejemplo, un jarrón o una pata de mesa girada, manteniendo constante el área de cada tira.
Obviamente, lo que se está haciendo aquí es que, dado que cada franja tiene el mismo área, la construcción automáticamente hace que cada punto “sirva” la misma cantidad de espacio. El uso de la “fracción más irracional” hace un trabajo razonable al extender los puntos alrededor del eje sin que se desarrolle ninguna estructura de largo alcance.
Editar por JM
Como señalé en un comentario a esta respuesta, la disposición filotáctica de los puntos en una esfera se ha presentado anteriormente en el Blog de Wolfram. El código allí es más general de lo que se necesita aquí, así que me tomé la libertad de simplificar un poco el código para el caso esférico, y también usé el hecho de que GoldenAngle
ahora es una constante incorporada:
With[n = Floor[4 π 100],
Graphics3D[Sphere[Table[2 Sqrt[(1 - i/n) i/n] Cos[i GoldenAngle],
2 Sqrt[(1 - i/n) i/n] Sin[i GoldenAngle],
1 - 2 i/n, i, n], 100/n], Boxed -> False]]
los 100
en la expresión para n
controla la densidad de puntos; aumente o disminuya según le parezca.
Si para ti ha sido útil nuestro post, sería de mucha ayuda si lo compartes con más seniors así contrubuyes a difundir esta información.