Clayton Shonkwiler
是 Colorado State University 的数学系教授，他称自己是数学家和艺术家。他对物理系统的几何模型感兴趣； 目前，他主要致力于研究具有拓扑约束的随机游走的几何方法，这些方法用于对聚合物进行建模。
他的艺术常常受到他研究和教学中出现的数学的启发，但更普遍的是，他喜欢将有趣且平凡的数学转变为艺术。
他在Wolfram 社区给大家共享了使用 Wolfram 语言编写的很多养眼、催眠、治愈的艺术品：https://community.wolfram.com/web/claytonshonkwiler
下面分享的是他的部分作品。
Ennea
这个是以单位圆上的点为中心的20个正则9边形的旋转。它的灵感来自于托马斯·戴维斯（Thomas Davis）的一些作品。
ninegons = Module[{n, m, cols},
n = 9;
m = 20;
cols = Insert[#, First[#], 4] &[RGBColor /@ {"#E45171", "#F8A79B", "#F8D99B", "#002C6A"}];
ParallelTable[Module[{imglist},
imglist = Table[Graphics[Table[{FaceForm[Directive[Blend[cols[[;; 4]], Mod[[Theta]/(2 [Pi]), 1]], Opacity[.1]]],
EdgeForm[Directive[Blend[cols[[;; 4]], Mod[[Theta]/(2 [Pi]), 1]], Thickness[.004]]],
Polygon[Table[{Cos[[Theta] [Pi]/2] Cos[[Phi] [Theta] 2 [Pi]/n (1/2 - Cos[t]/2 Mod[n/4, 1])],
Sin[[Theta] [Pi]/2] Sin[[Phi] [Theta] 2 [Pi]/n (1/2 - Cos[t]/2 Mod[n/4, 1])]},
{[Phi], 0, 2 [Pi] - 2 [Pi]/n, 2 [Pi]/n}]]},
{[Theta], 2 [Pi] i/m, 2 [Pi] (m i - 2)/m, 2 [Pi]/m}],
PlotRange -> 3, ImageSize -> 540, Background -> None],
{i,1, m}];
ImageCompose[Graphics[Background -> cols[[5]], ImageSize -> 540], Blend[imglist]]
], {t, 0, [Pi] - #, #}] &[[Pi]/40]];
Export[NotebookDirectory[] <> "ninegons.gif", ninegons, "DisplayDurations" -> {1/24}]排列（变形平纹）
编织模式总是一个挑战，因为大脑的思考总是与 Mathematica 的实现不匹配，因为没有一致的方法来布线和分层。Marina 说这是秩序与混乱之间的一种动态过渡 ，一波无序的滚动与消逝。颜色的变化强调了对比度。
DynamicModule[{f, cols, angle},
f = ? Piecewise[{{0, # < 0}, {1/2 - 1/2 Cos[#], 0 <= # < ?}, {1, # >= ?}}] &;
cols = RGBColor /@ {"#EEEEEE", "#00ADB5", "#303841"};
Manipulate[
Graphics[
{Thickness[.02],
Table[{angle = f[(? - ? (i j 10)/20)];
Blend[cols[[{1, 2, 1}]], angle/?],
Line[({i, j} RotationMatrix[angle].#) & /@ {{-.7, 0}, {.7, 0}}],
Line[({i 1, j} RotationMatrix[angle].#) & /@ {{0, -.7}, {0, .7}}]},
{i, -4, 4, 2}, {j, -4, 4, 2}],
Table[{angle = f[(? - ? (i j 10)/20)];
Blend[cols[[{1, 2, 1}]], angle/?],
Line[({i, j} RotationMatrix[-angle].#) & /@ {{-.7, 0}, {.7, 0}}],
Line[({i 1, j} RotationMatrix[-angle].#) & /@ {{0, -.7}, {0, .7}}]},
{i, -5, 5, 2}, {j, -5, 5, 2}]},
PlotRange -> 4.75, ImageSize -> 540, Background -> cols[[3]]],
{?, 0, 2 ?}]
]Sweep Out
这是旋转的3体内的一个2体，首先通过立体投影法投影到3维空间，然后正交投影到yz平面。我喜欢这些类型的投影，在这些投影中旋转看起来已经不像旋转。
Sam 说这有点像电荷的电场线。
Stereo3D[{x1_, y1_, x2_, y2_}] := {x1/(1 - y2), y1/(1 - y2), x2/(1 - y2)};
Manipulate[
ParametricPlot[
Table[Stereo3D[{{Cos[t], 0, 0, -Sin[t]}, {0, 1, 0, 0}, {0, 0, 1, 0}, {Sin[t], 0, 0, Cos[t]}}.
{Cos[[Theta]] Sin[[Phi]], Sin[[Theta]] Sin[[Phi]], Cos[[Phi]], 0}][[2 ;;]],
{[Theta], 0, 2 [Pi], 2 [Pi]/20}], {[Phi], 0, [Pi]}, PlotRange -> 2.5,
Background -> RGBColor["#172940"],
PlotStyle -> Directive[Thickness[.004], RGBColor["#acf0f2"]],
ImageSize -> 540, Axes -> False], {t, 0, [Pi]}]同样的东西，但是没有投影到 yz 平面：
Manipulate[
ParametricPlot3D[
Table[Stereo3D[{{Cos[[Theta]], 0, 0, -Sin[[Theta]]}, {0, 1, 0, 0}, {0, 0, 1, 0}, {Sin[[Theta]], 0, 0, Cos[[Theta]]}}.
{Cos[t] Sin[[Phi]], Sin[t] Sin[[Phi]], Cos[[Phi]], 0}], {t, 0, 2 [Pi], 2 [Pi]/20}], {[Phi], 0, [Pi]}, PlotRange -> 10,
Background -> RGBColor["#172940"],
PlotStyle -> Directive[Thickness[.004], RGBColor["#acf0f2"]],
ImageSize -> 540, Boxed -> False, Axes -> False,
ViewAngle -> [Pi]/40, ViewPoint -> {1.3, -2.4, 2.}], {[Theta], 0, [Pi]}]Come Back
没有深入的数学知识，但是仍然很有趣。
DynamicModule[{n = 8, k = 6, r, cols, verts},
cols = RGBColor /@ {"#00ADB5", "#EEEEEE", "#FF5722", "#303841"};
Manipulate[
r = Cos[s];
verts =
Table[(1 - r (-1)^(i 1)) {Cos[2 ? i/n - ? (r 1)/8],
Sin[2 ? i/n - ? (r 1)/8]}, {i, 0, n - 1}];
Graphics[{Thickness[.0075], CapForm["Round"], Opacity[.8],
Table[{Blend[cols[[;; 3]], 1 - Abs[11/5 t - 11/10]],
Line[{t verts[[i]] (1 - t) RotateRight[verts, 3][[i]],
t RotateLeft[verts, k][[i]] (1 - t) RotateLeft[verts,
k 1][[i]]}]}, {i, 1, n - 1, 2}, {t, 1/12, 11/12,
1/12}]}, PlotRange -> 3, ImageSize -> 540,
Background -> cols[[4]]], {s, 0, ?}]]其他爱好者的一点小小演变：
DynamicModule[{n = 10, k = 6, r, verts,
cols = RGBColor /@ {"#00adb5", "#eeeeee", "#ff5722", "#303841"}},
Manipulate[r = Cos[s];
verts = Table[(1 - r (-1)^i)
AngleVector[2 ? (i - 1)/n - ? (r 1)/8],
{i, n}];
Graphics[{Directive[Thickness[.0075], CapForm["Round"],
Opacity[.8]],
Table[{Blend[cols[[; ;-2]],
1 - Abs[11/5 t - 11/10]],
Line[{{t, 1 - t} .
verts[[{i, Mod[i - 5, n, 1]}]],
{t, 1 - t} .
verts[[Mod[i k {0, 1}, n, 1]]]}]},
{i, 1, n - 1, 2}, {t, 1/12, 11/12, 1/12}]},
PlotRange -> 3, ImageSize -> 540,
Background -> cols[[-1]]], {s, 0, 2 ?}]]
