首页
学习
活动
专区
工具
TVP
发布
社区首页 >专栏 >用 Mathematica 生成正多面体链环

用 Mathematica 生成正多面体链环

作者头像
WolframChina
发布2018-05-31 10:48:52
1.7K0
发布2018-05-31 10:48:52
举报
文章被收录于专栏:WOLFRAMWOLFRAM

早在两千多年前,柏拉图就在他的著作 Timaeus 里提到了五种正多面体:正四面体、立方体、正八面体、正十二面体、正二十面体。因此,这五种正多面体也被称为柏拉图立体。两千多年以来,这些正多面体因为其对称性,吸引了无数数学家、艺术家。

而在这篇文章里,我将介绍如何用多边形环,根据正多面体的对称性,组成各种各样美丽的空间图形。在纽结理论(Knot Theory)里,这样由有限多个互不相交的纽结(多边形环也是一种纽结,平凡纽结)构成的空间图形,叫做链环(Link)。组成链环的每一个纽结称为该链环的一个分支。由于这里构造的链环都和正多面体有关,所以我称之为多面体链环。

基本原理

这些多面体链环看似复杂,但其实每个链环都是由若干全等的分支组成的。下图把链环旋转一定角度,使其中用红色标出的分支看起来更清楚:

可以看到,构成链环的每个分支都是一个环,且按照对应的正多面体各面的形状,弯折成了三角形、正方形、五边形,不妨把这种形状称之为多边形环。对每个多面体链环来说,多边形环的个数等于正多面体的面数,朝向也一致。

下图展示了初始的状态:所有的环都贴在正多面体表面,红色箭头表示的是各个面的法向量。对每一个正多面体,把各个多边形环缩放相同比例,绕各自所在面的法向量旋转一个相同的角度,并沿着各个法向量方向适当外拉或内推相同的距离,就能得到之前的多面体链环。

那么问题就来了,该如何知道缩放比例,旋转角度还有到中心的距离,来得到那些链环呢?答案是不需要知道。只要有一个能根据这些参数(比例、角度、朝向等)生成多边形环的一般性的函数,就可以用 MathematicaManipulate 函数自动创建一个程序界面,动态操控参数,通过实时观察结果来得到具体可用的参数值。之前图中的多面体链环都是用这种方法生成的。

由多边形环组成的链环

于是可以分两步来构造由多边形环组成的链环:先写一个一般性的生成函数,再用 Manipulate 函数寻找适合的参数。

生成多边形环

为了简化讨论,先不考虑多边形环的粗细,那我们要生成的仅仅是一条空间曲线,可以是任意位置、任意朝向和任意大小。考虑这么多情况的空间曲线仍然有些复杂,所以再次简化一下,只考虑把这条曲线放在平面上,也即平面多边形曲线的情形。这样的曲线基本上可以看成一个圆经过一些相对圆心的“伸缩”变换生成。

圆的参数方程是 {x = r Cos[t], y = r Sin[t]}, t 表示角度,我们可以考虑随着 t 的进展,r 周期性的变大变小,从而得到多边形环。三角函数非常适合用在这里,振幅表示了起伏的程度,频率则代表了由几个波峰,三个就是三角形,四个就是正方形,五个就是五边形了。

下图展示了把 r 设定为三角函数 r + a Cos[f t] 时,参数方程生成的图像。r 是圆的半径,a Cos[f t] 则是相对于圆伸缩的大小,a 是最大振幅,f 是频率。三幅图中作为基准的圆的半径都是 1;振幅分别是 0.3、0.2、0.15;频率分别是 3、4、5。

GraphicsRow[
 MapThread[ParametricPlot[With[{r = 1, atd = #1, frq = #2},
     (r + atd Cos[frq t]) {Cos[t], Sin[t]}], {t, 0, 2 \[Pi]}, 
    PlotStyle -> {RGBColor[0.4, 0.7, 1], Thickness[0.015]}] &, 
 {{0.3, 0.2, 0.15}, {3, 4, 5}}], Spacings -> Scaled[0.3], 
 ImageSize -> Full]

现在我们已经求得了在平面上,中心位于原点这种简化情形下的多边形曲线的参数方程。那么一般的空间曲线也就好办了:把平面曲线所在平面看作空间中的 XY 平面,那么平面曲线的参数方程不过是一种特殊情形:由经过原点的,基底向量为 (1, 0, 0) 和 (0, 1, 0) 的平面上的曲线。

那么在经过中心 C,由 xN 和 yN 两个基底向量决定的平面上的曲线方程就是 C + (r + a Cos[f t]) (Cos[t] xN + Sin[t] yN)。其中 xN 的方向就是多边形曲线其中一个波峰的朝向,在上图里,它们都指向 x 轴正方向。

此外,我们并不直接给出 yN,因为生成空间多边形曲线时,我们知道的是曲线所在平面的朝向,也即法向量 zN。yN 可以由 zN 和 xN 叉积得到。综上,最终得到的空间多边形曲线的参数式的生成函数如下:

trigCircleC[center_, zN_, xN_, r_, frq_, atd_] := With[{yN = Cross[zN, xN]}, 
Function[t, center + (r + atd Cos[frq t]) (Cos[t] xN + Sin[t] yN)]]

上面这个函数有 6 个参数。center 表示中心位置,zN 是环所在平面的法向量,xN 表示其中其中一个波峰的方向向量,r 是圆的半径,frq 是频率,也即有几个波峰,atd 是振幅,决定了肌肤的大小。

下面就可以试一下这个函数定义是否成功。这里画两个多边形环,它们有不同的中心位置、朝向、大小、频率、振幅。只要在绘图样式 PlotStyle 里加上 Tube[0.1],就可以用粗细为 0.1 的圆管来绘制曲线。

With[{
    f1 = trigCircleC[{0, 0, 0}, {0, 0, 1}, {Cos[\[Pi]/4], Sin[\[Pi]/4], 0}, 1, 4, 0.2], 
    f2 = trigCircleC[{1, 0, 0}, {0, 1, 0}, {1, 0, 0}, 0.8, 5, 0.1]}, 
    ParametricPlot3D[{f1[t], f2[t]}, {t, 0, 2 \[Pi]}, 
PlotStyle -> Directive[RGBColor[0.4, 0.7, 1], Tube[0.1]], 
PlotRange -> All, Lighting -> "Neutral", 
ViewPoint -> {0, -2, 1}, Mesh -> None]]

用多边形环组成链环

有了生成多边形环的函数,下面就要根据正多面体的对称性,生成链环。具体来说,给一个正多面体,我们需要知道它各个面的法向量作为多边形环的 zN 参数;对于各个正多边形面,我们还需要知道从面心指向其中一个角的方向向量,作为最开始的 xN 参数;此外我们还需要知道面心,作为各个多边形环的中心点。

不过按这样的设置,我们只能得到贴在多面体表面,且波峰指向和多面体各个面一致的图形。我们希望再多两个参数:绕各个面法向量旋转的角度、距离中心点的距离。多了这两个参数,链环就能有更多的变化。而根据这两个参数还有多面体,我们可以算出各个多边形环的 center 和 xN。

Mathematica 有一个内置函数 PolyhedronData,只要给出多面体的名称,就可以很方便的得到顶点坐标,还有各顶点形成面的组合信息。比如以立方体为例,只要执行下列命令:

PolyhedronData ["Cube", "Vertices"]  
{{-(1/2), -(1/2), -(1/2)}, {-(1/2), -(1/2), 1/2},{-(1/2), 1/2, -(1/2)}, 
{-(1/2), 1/2, 1/2},{1/2, -(1/2), -(1/2)}, {1/2, -(1/2), 1/2},
{1/2, 1/2, -(1/2)}, {1/2, 1/2, 1/2}}

就可以得到 8 个顶点的坐标信息。要知道各个面,就执行:

PolyhedronData ["Cube", "Faces"]
{{8, 4, 2, 6}, {8, 6, 5, 7}, {8, 7, 3, 4}, {4, 3, 1, 2}, 
{1, 3, 7, 5}, {2, 1, 5, 6}}

这就给出了六个面分别有哪些顶点组成的信息,顶点序号从 1 到 8,和之前给的坐标一一对应。这样,我们就可以写一个有多面体名称,旋转角度,离中心距离三个参数的函数 polylinkInfo,返回多边形环的频率、各个多边形环的中心坐标、法向量、xN 指向。除了频率是一个值,其他三个都是一组值。

polylinkInfo[polyhedron_String, rot_, faceDis_] := Module[{
   vertices = N[PolyhedronData[polyhedron, "Vertices"]], 
   faces = PolyhedronData[polyhedron, "Faces"],
   faceVCoords, frq, faceNormals, faceCenters, xNs},
  faceVCoords = Map[Part[vertices, #] &, faces, {2}];
  frq = Length[faces[[1]]];
  faceCenters = Mean /@ faceVCoords;
  faceNormals = Normalize /@ faceCenters;
  xNs =MapThread[Normalize[RotationTransform[rot, #3][#1] - #2] &, 
            {First /@ faceVCoords, faceCenters, faceNormals}];
      faceCenters = faceDis faceNormals;
      {frq, faceCenters, faceNormals, xNs}]

有了这个函数,把多边形环组合的函数就很容易了,这个定义里,参数 inradius 表示的是圆管的粗细,points 表示绘制时初始时的点数,opt 是表示其它绘图设置。

trigPolylinkTube[polyhedron_String, rot_, faceDis_, r_, atd_, inradius_, points_: 30, opt___] := 
 Module[{info = polylinkInfo[polyhedron, rot, faceDis], fs},
  fs = MapThread[trigCircleC[#1, #2, #3, r, First[info], atd] &, Rest[info]];
  ParametricPlot3D[Table[f[t], {f, fs}], {t, 0, 2.01 \[Pi]}, 
       PlotStyle -> Directive[RGBColor[0.4, 0.7, 1], Tube[inradius]], 
       PlotRange -> All, Lighting -> "Neutral", PlotPoints -> points, opt]]

最后,只要把 trigPolylinkTube 函数的参数设置成 Manipulate 函数里可动态改变的值,就能创建如下界面,动态调整即可找到满意的链环参数。

Manipulate[
 trigPolylinkTube[polyhedron, rot, faceDis, r, atd, inradius, 
  ControlActive[5, 50], ViewPoint -> {0, -2, 1}, Mesh -> None, 
  Boxed -> False, Axes -> False, SphericalRegion -> True],
 {{polyhedron, "Cube", "Polyhedron"}, {"Tetrahedron", "Cube", 
   "Octahedron", "Dodecahedron", "Icosahedron"}, PopupMenu},
 {{rot, 0}, 0, 2 \[Pi]},
 {{faceDis, 1}, 0, 1},
 {{r, 0.8}, 0, 1},
 {{atd, 0.2}, 0, 1},
 {{inradius, 0.1}, 0, 0.5},
 ControlPlacement -> Right,
 Initialization :> (
   trigCircleC[center_, zN_, xN_, r_, frq_, atd_] := 
    With[{yN = Cross[zN, xN]},
     Function[t, 
      center + (r + atd Cos[frq t]) (Cos[t] xN + Sin[t] yN)]];
   polylinkInfo[polyhedron_String, rot_, faceDis_] := Module[{
      vertices = N[PolyhedronData[polyhedron, "Vertices"]], 
      faces = PolyhedronData[polyhedron, "Faces"],
      faceVCoords, frq, faceNormals, faceCenters, xNs},
     faceVCoords = Map[Part[vertices, #] &, faces, {2}];
     frq = Length[faces[[1]]];
     faceCenters = Mean /@ faceVCoords;
     faceNormals = Normalize /@ faceCenters;
     xNs = 
      MapThread[
       Normalize[RotationTransform[rot, #3][#1] - #2] &, {First /@ 
         faceVCoords, faceCenters, faceNormals}];
     faceCenters = faceDis faceNormals;
     {frq, faceCenters, faceNormals, xNs}];
   trigPolylinkTube[polyhedron_String, rot_, faceDis_, r_, atd_, 
     inradius_, points_: 30, opt___] := 
    Module[{info = polylinkInfo[polyhedron, rot, faceDis], fs}, 
     fs = MapThread[trigCircleC[#1, #2, #3, r, First[info], atd] &, 
       Rest[info]];
     ParametricPlot3D[Table[f[t], {f, fs}], {t, 0, 2.01 \[Pi]}, 
      PlotStyle -> Directive[RGBColor[0.4, 0.7, 1], Tube[inradius]], 
      PlotRange -> All, Lighting -> "Neutral", PlotPoints -> points, 
      opt]]
   )]
视频内容

举例

基于正十二面体的链环:

trigPolylinkTube["Dodecahedron", 0.282743, 0.88, 1, 0.18, 0.12, 500, 
Boxed -> False, Axes -> False, Method -> {"ShrinkWrap" -> True}]

基于正二十面体的链环:

trigPolylinkTube["Icosahedron", 1.82841, 1., 0.89, 0.39, 0.09, 500,
 Boxed -> False, Axes -> False, Method -> {"ShrinkWrap" -> True}]

另一种基于正二十面体的链环:

trigPolylinkTube["Icosahedron", 0.678584, 0.757, 0.362, 0.14, 0.05, 500,
 Boxed -> False, Axes -> False, Method -> {"ShrinkWrap" -> True}]
本文参与 腾讯云自媒体分享计划,分享自微信公众号。
原始发表:2017-07-08,如有侵权请联系 cloudcommunity@tencent.com 删除

本文分享自 WOLFRAM 微信公众号,前往查看

如有侵权,请联系 cloudcommunity@tencent.com 删除。

本文参与 腾讯云自媒体分享计划  ,欢迎热爱写作的你一起参与!

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
相关产品与服务
对象存储
对象存储(Cloud Object Storage,COS)是由腾讯云推出的无目录层次结构、无数据格式限制,可容纳海量数据且支持 HTTP/HTTPS 协议访问的分布式存储服务。腾讯云 COS 的存储桶空间无容量上限,无需分区管理,适用于 CDN 数据分发、数据万象处理或大数据计算与分析的数据湖等多种场景。
领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档