本文编译自六年前Simon Woods在Wolfram社区发表的一篇短文及其评论。
我发现使用昂贵的数学软件进行无聊娱乐的最新方式是这样的（这是一种描述它的方法）：
- 1000名舞者在舞池上扮演随机位置。
- 每个人随机选择一个“朋友”和一个“敌人”。
- 每一步中每个舞者
- 移动0.5％靠近地板中心
- 然后向他们的朋友迈出一大步
- 离他们的敌人一小步
- 每隔一段时间，一个舞者重新选择他们的朋友和敌人
故意注入随机性， 这是舞蹈......
代码语言：javascript复制n = 1000;
r := RandomInteger[{1, n}];
f := (#/(.01 Sqrt[#.#])) & /@ (x[[#]] - x) &;
s := With[{r1 = r}, p[[r1]] = r; q[[r1]] = r];
x = RandomReal[{-1, 1}, {n, 2}];
{p, q} = RandomInteger[{1, n}, {2, n}];
Graphics[{PointSize[0.007], Dynamic[If[r < 100, s];
Point[x = 0.995 x 0.02 f[p] - 0.01 f[q]]]}, PlotRange -> 2]
背景知识：
Boids是一种最初由Craig Reynolds于1986年开发的人工生命模拟程序。模拟的目的是复制鸟群的行为。然而，Boids模拟不是控制整个鸟群的相互作用，而是仅指定每只鸟的行为。只有一些简单的规则，程序设法生成一个复杂和现实的结果，足以用作计算机图形应用程序的框架，如电影胶片中的计算机生成的行为动画。
Boids只是众所周知的“群体智能”(Swarm intelligence)领域中的众多实验之一。群体智能系统的一个关键方面是缺乏集中控制代理 - 而群体中的每个单独的单元都遵循其自己定义的规则，有时会导致整个群体的整体行为出人意料。
动物群的宏观行为（想想成群的椋鸟或鲱鱼群）是由每个个体按照他们附近的当地非常简单的规则来解释的，主要是
1）尽量保持
和
2）尝试不要碰撞。
我开始尝试在Mathematica中使用这个想法，但是识别每个粒子的最近邻居相当慢。所以我想知道如果每个粒子根据两个其他粒子的位置而不管它们的接近程度如何，会发生什么。规则只是从一个方向移向另一个方向。
添加收缩（x = 0.995 x）以防止粒子云向无限远或向远离原点漂移。我调整了“朝向”和“离开”步长，以便在聚集和分开的趋势之间取得平衡（如果你使步长相等，你会得到更像是一群苍蝇的东西）。随着每个粒子的吸引子和排斥器被固定，系统找到一种动态平衡，因此为了保持变化，我增加了一个规则来定期改变其中一个粒子的吸引子和排斥器。最后的调整是使非常近距离的粒子的“力”下降到零。这有助于阻止形成非常紧密的团块，并且当粒子选择自身作为其吸引子或排斥器时，还可以防止零除误差。
将系统描述为舞蹈是试图在不使用数学语言的情况下解释屏幕上的旋转模式。我很想看看其他简单的规则可以创造出什么样的“舞蹈”。
加入彩色和标签的二维和三维图
TabView[{
"2D" -> Manipulate[n = 1000;
r := RandomInteger[{1, n}];
f := (#/(.01 Sqrt[#.#])) & /@ (x[[#]] - x) &;
s := With[{r1 = r}, p[[r1]] = r; q[[r1]] = r];
x = RandomReal[{-1, 1}, {n, 2}];
{p, q} = RandomInteger[{1, n}, {2, n}];
Graphics[{Opacity[opacity], PointSize[size],
Dynamic[If[r < 200, s];
Point[y = x; x = c*x ps*f[p] - qs*f[q],
VertexColors -> (ColorData[col][color*Norm[#]] & /@ (x - y))]]}, PlotRange -> Range, ImageSize -> {700, 600},
Background -> Black], Delimiter, Style[" 2D Dancing with
friends and enemies", Bold, Large], Delimiter, Style["Equation
x = c x ps f[p] - qs f[q]
where
!(*FormBox[((\ \ \ \ \ \ \ \ \ \ \
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \
\ )(f[a] = *FractionBox[((a - x)), (0.01 *SqrtBox[(((a -
x)) . ((a - x)))])])),
TraditionalForm])
", Bold, Medium], Delimiter,
Dynamic[Graphics[{Style[
Text@TraditionalForm@
Style[Row[{"x = ", c "x ", ps " f[p] -", qs "f[q]"}]],
15]}, ImageSize -> {240, 50}]], Delimiter,
Style["Step towards their friend", Bold,
Medium], {{ps, 0.02, "Step Size ps"}, 0, 1,Appearance -> "Open"}, Delimiter,
Style["Step away from their enemy", Bold,
Medium], {{qs, 0.01, "Step Size qs"}, 0, 1, Appearance -> "Open"},
Delimiter, {{c, 0.995, "Contraction c"}, 0.5, 1.1, Appearance -> "Open"},
Delimiter, {{size, 0.015, "Point Size"}, 0.001, 0.05}, {{Range, 1, "Plot Range"}, 0.1, 5}, {{opacity, 1, "Opacity"}, 0.1, 1}, {{color, 62, "Color Scale"}, 0, 100},
Control[{{col, "SolarColors", "Color Style"},
(# -> Row[{Show[ColorData[#, "Image"], ImageSize -> 100], Spacer[10], #}]) & /@ ColorData["Gradients"], PopupMenu}],
ControlPlacement -> Left],
"3D" -> Manipulate[n = 1000;
r := RandomInteger[{1, n}];
f3d := (#/(.01 Sqrt[#.#])) & /@ (x3d[[#]] - x3d) &;
s := With[{r1 = r}, p[[r1]] = r; q[[r1]] = r];
x3d = RandomReal[{-1, 1}, {n, 3}];
{p, q} = RandomInteger[{1, n}, {2, n}];
Graphics3D[{Opacity[opacity], PointSize[size],
Dynamic[If[r < 200, s];
Point[y = x3d; x3d = c*x3d ps*f3d[p] - qs*f3d[q],
VertexColors -> (ColorData[col][color*Norm[#]] & /@ (x3d - y))]]}, PlotRange -> Range, ImageSize -> {700, 600},
Background -> Black, Boxed -> boxed], Delimiter,
Style[" 3D Dancing with
friends and enemies", Bold, Large], Delimiter, Style["Equation
x = c x ps f[p] - qs f[q]
where
!(*FormBox[((\ \ \ \ \ \ \ \ \ \ \
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \
\ )(f[a] = *FractionBox[((a - x)), (0.01 *SqrtBox[(((a -
x)) . ((a - x)))])])),
TraditionalForm])
", Bold, Medium], Delimiter,
Dynamic[Graphics[{Style[
Text@TraditionalForm@
Style[Row[{"x = ", c "x ", ps " f[p] -", qs "f[q]"}]],
15]}, ImageSize -> {240, 50}]], Delimiter,
Style["Step towards their friend", Bold,
Medium], {{ps, 0.02, "Step Size ps"}, 0, 1, Appearance -> "Open"}, Delimiter,
Style["Step away from their enemy", Bold,
Medium], {{qs, 0.01, "Step Size qs"}, 0, 1, Appearance -> "Open"},
Delimiter, {{c, 0.995, "Contraction c"}, 0.5, 1.1, Appearance -> "Open"},
Delimiter, {{size, 0.015, "Point Size"}, 0.001, 0.05}, {{Range, 1, "Plot Range"}, 0.1, 5}, {{opacity, 1, "Opacity"}, 0.1, 1}, {{color, 62, "Color Scale"}, 0, 100},
Control[{{col, "SolarColors", "Color Style"},
(# ->Row[{Show[ColorData[#, "Image"], ImageSize -> 100], Spacer[10], #}]) & /@ ColorData["Gradients"],
PopupMenu}], {boxed, {True, False}}, ControlPlacement -> Left]},
ControlPlacement -> Left]
