正多面体の方程式

数学の冊子の編集に携わっている．＞数学部会誌「α－ω」
正多面体方程式の投稿があって，先々月その査読中に式があっているかどうか Mathematica で図に出してみた．当然のことながらちゃんと出るなｗ
冊子も配布されWebにPDFも出したので，図も出せる．

Abs[] は絶対値関数．つまり平面を絶対値で切り刻んで連結しているイメージである．詳しくは投稿原稿を参照．＞第54号


正四面体

ContourPlot3D[
Abs[Sqrt[3] Abs[x] - y + 4 Sqrt[2] z +
Sqrt[3] Abs[Abs[x] + Sqrt[3] y]]
+ Sqrt[3] Abs[Abs[x] + Sqrt[3] y] + Sqrt[3] Abs[x] - y -
2 Sqrt[2] z == Sqrt[3],
{x, -0.6, 0.6}, {y, -0.6, 0.6}, {z, -0.6, 0.6}]

立方体

ContourPlot3D[
Abs[Abs[x] + Abs[y] - 2 Abs[z] + Abs[-Abs[x] + Abs[y]]] +
Abs[-Abs[x] + Abs[y]] + Abs[x] + Abs[y] + 2 Abs[z] == 2,
{x, -0.8, 0.8}, {y, -0.8, 0.8}, {z, -0.8, 0.8}]

正八面体

ContourPlot3D[
Abs[x] + Abs[y] + Abs[z] == 1/Sqrt[2],
{x, -0.8, 0.8}, {y, -0.8, 0.8}, {z, -0.8, 0.8}]

正十二面体

ContourPlot3D[
Abs[
Abs[
Abs[x] +
(Sqrt[5] + 3)/2 Abs[y]
- (Sqrt[5] + 1)/2 Abs[z]
]
- Abs[
(Sqrt[5] + 1)/2 Abs[x]
- Abs[y]
- (Sqrt[5] - 1)/2 Abs[z]
]
- (Sqrt[5] - 1)/2 Abs[x]
- (3 - Sqrt[5])/2 Abs[y]
- Abs[z]
] +
Abs[
-Abs[x]
- (Sqrt[5] + 3)/2 Abs[y] +
(Sqrt[5] + 1)/2 Abs[z]
] +
Abs[
(Sqrt[5] + 1)/2 Abs[x]
- Abs[y] +
-((Sqrt[5] - 1)/2) Abs[z]
] +
(Sqrt[5] + 3)/2 Abs[x] +
(Sqrt[5] + 1)/2 Abs[y] +
(Sqrt[5] + 2) Abs[z]
== 3 + 3 Sqrt[5]
, {x, -2, 2}, {y, -2, 2}, {z, -2, 2}]

正二十面体

ContourPlot3D[
Abs[
+Abs[
(Sqrt[5] + 1)/2 Abs[x] - (3 + Sqrt[5])/2 Abs[y] + Abs[z]]
+ Abs[
+Abs[x]
+ (3 - Sqrt[5])/2 Abs[y] - (Sqrt[5] - 1)/2 Abs[z]
]
- (Sqrt[5] - 1)/2 Abs[x]
- Abs[y]
- (Sqrt[5] + 1)/2 Abs[z]
]
+ Abs[
+Abs[
Abs[x]
- (Sqrt[5] + 1)/2 Abs[y]
+ (Sqrt[5] - 1)/2 Abs[z]]
- Abs[
(3 + Sqrt[5])/2 Abs[x]
+ Abs[y]
- (Sqrt[5] + 1)/2 Abs[z]]
- (3 - Sqrt[5])/2 Abs[x]
- (Sqrt[5] - 1)/2 Abs[y]
- Abs[z]]
+ Abs[
(3 + Sqrt[5])/2 Abs[x] - (2 + Sqrt[5]) Abs[y] + (Sqrt[5] + 1)/2
Abs[z]
]
+ Abs[
(Sqrt[5] + 1)/2 Abs[x] + (Sqrt[5] - 1)/2 Abs[y] - Abs[z]
]
+ Sqrt[5] Abs[x]
+ (5 + Sqrt[5])/2 Abs[y]
+ (5 + 3 Sqrt[5])/2 Abs[z]
== 5 + 3 Sqrt[5]
, {x, -1.5, 1.5}, {y, -1.5, 1.5}, {z, -1.5, 1.5}]