# Torus triangulation

I'd like to plot something similar to this but with a triangle instead of a pentagon.

Also, I'd like to triangulate the faces, that is, to insert the diagonals for each face of the 3 prisms used.

In fact, I'd like to plot the minimal simplicial complex for the torus.

I tried to compute the vertices to use some polygon plot3d function but no progress. Sorry. Edit:

Here is the code I have. I'm trying to see the 3 cycles to determine the faces. The problem is that they are not equilateral triangle.

pic3 = Graphics3D[{Green,
Polygon[{{0, -1, Sqrt - 1}, {1, -1 - Sqrt,
Sqrt - 2}, {-1, -1 - Sqrt, Sqrt - 2}}]}];
pic2 = Graphics3D[{Pink,
Polygon[{{0, 0, 1}, {1, 0, Sqrt}, {-1, 0, Sqrt}}]}];
pic1 = Graphics3D[{Blue,
Polygon[{{0, 1, Sqrt - 1}, {1, 1 + Sqrt, Sqrt - 2},
{-1, 1 + Sqrt, Sqrt - 2}}]}]; Edit 2:

Using some rotation transformation, I defined some points and rotated them to produce another triangles. The code below produces a better result.

Now I'd like to make it fancier, maybe with transparent or glass style.

triang1 = {{0, 0, 1}, {1, 0, 1 + Sqrt}, {-1, 0, 1 + Sqrt}};
triang2 = RotationTransform[2 Pi/3, {1, 0, 0}, {0, 0, 0}][triang1];
triang3 = RotationTransform[4 Pi/3, {1, 0, 0}, {0, 0, 0}][triang1];

pic1 = Graphics3D[{Blue, Polygon[triang1]}];
pic2 = Graphics3D[{Red, Polygon[triang2]}];
pic3 = Graphics3D[{Green, Polygon[triang3]}];

trapez1 = {triang1[], triang2[], triang2[], triang1[]};
Gtrapez1 = Graphics3D[{Yellow, Polygon[trapez1]}];
trapez2 = {triang1[], triang3[], triang3[], triang1[]};
Gtrapez2 = Graphics3D[{Yellow, Polygon[trapez2]}];
trapez3 = {triang3[], triang2[], triang2[], triang3[]};
Gtrapez3 = Graphics3D[{Yellow, Polygon[trapez3]}];
trapez4 = {triang1[], triang2[], triang2[], triang1[]};
Gtrapez4 = Graphics3D[{Yellow, Polygon[trapez4]}];
trapez5 = {triang1[], triang3[], triang3[], triang1[]};
Gtrapez5 = Graphics3D[{Yellow, Polygon[trapez5]}];
trapez6 = {triang3[], triang2[], triang2[], triang3[]};
Gtrapez6 = Graphics3D[{Yellow, Polygon[trapez6]}];

Show[Gtrapez6, Gtrapez5, Gtrapez4, Gtrapez3, Gtrapez2, Gtrapez1,
pic1, pic2, pic3, Boxed -> False, AspectRatio -> Automatic] Update 2: A function to generate tori:

 toroidalF[n_, h_: (1/4), w_: (1/2), opts : OptionsPattern[]] :=
Module[{top, bottom, verts,
outer = {Cos[#], Sin[#], 0} & /@ Range[0, 2 Pi, 2 Pi/n],
faceverts = Flatten[#[[{1, 2, 4, 3}]] & /@ # & /@
(Join @@@ Subsets[#, {2}] & /@
Thread[{#, # + n + 1, # + 2 n + 2} &@
Partition[Range[n + 1], 2, 1]]), 1]},
top = # + {0, 0, h} & /@ (w outer);
bottom = # + {0, 0, -h} & /@ (w  outer);
verts = Join[outer, top, bottom];
Graphics3D[{Opacity[.5], EdgeForm[],
GraphicsComplex[verts, Polygon /@ faceverts]}, opts]]


Examples:

 Row[toroidalF[#, Boxed -> False, ImageSize -> 250] & /@ {3, 4, 5, 6}] Row[toroidalF[#, 1/5, 3/4, Boxed -> False, ImageSize -> 250] & /@ {3, 6, 9, 12}] Stealing @Junho Lee's lighting l:

 Row[toroidalF[#, Boxed -> False, ImageSize -> 250, Lighting -> l] & /@ {3, 4, 5, 6}] A brute-force approach to get the torus

 outer = {Cos[#], Sin[#], 0} & /@ Range[0, 2 Pi, 2 Pi/3];
top = # + {0, 0, 1/4} & /@ (.5 outer);
bottom = # + {0, 0, -1/4} & /@ (.5 outer);
verts = Join[outer, top, bottom];
faceverts = Flatten[#[[{1, 2, 4, 3}]] & /@ # & /@
(Join @@@ Subsets[#, {2}] & /@
Thread[{#, # + 4, # + 8} &@Partition[Range, 2, 1]]), 1];
polygons = Polygon /@ faceverts;
Graphics3D[{Opacity[.5], EdgeForm[], GraphicsComplex[verts, polygons]},
Boxed -> False, ImageSize -> 600] Update: Triangulation of rectangular faces:

faceverts2 = Join @@ (Join @@@ Subsets[#, {2}] & /@
Thread[{#, # + 4, # + 8} &@Partition[Range, 2, 1]]);
triverts = Flatten[{#, RotateLeft@#} & /@ faceverts2, 1][[All, ;; 3]];
polygons2 = Polygon /@ triverts;
Graphics3D[{Opacity[.5], GraphicsComplex[verts, polygons2]},
Boxed -> False, ImageSize -> 600] Triangulation of faces using V10 on Wolfram Programming Cloud:

rR = BoundaryMeshRegion[verts, polygons];
HighlightMesh[rR,
{Style[2, Directive[Opacity[.5],LightBlue]] ,Style[1,Directive[Thick,Blue]]}] tm= TriangulateMesh[rR, MaxCellMeasure -> \[Infinity], MeshQualityGoal->"Minimal"];
HighlightMesh[tm,
{Style[2, Directive[Opacity[.5],LightBlue]],Style[1, Directive[Thick,Blue]]}] • Ow, very nice! Thanks. I have no idea about the code but it is pretty. – Sigur Aug 21 '14 at 3:32
• What a marvelous update! – Sigur Aug 21 '14 at 18:14
• Does your first block of code work on V9? I'm getting Coordinate {ImageSize -> 250, 0, Boxed -> False} should be a triple of numbers, or a Scaled form. – Sigur Aug 22 '14 at 23:55

This can also be done with the built-in plotting functions, e.g.

RevolutionPlot3D[
{2 + Cos[t], Sin[t]},
{t, 0, 2 Pi},
PlotPoints -> {4, 4}, MaxRecursion -> 0,
Mesh -> All,
PlotStyle -> Opacity[.2]
] Note the PlotPoints and the MaxRecursion options.

• amazing!!! +++1 – kglr Sep 22 '14 at 21:25
• @kguler Have been always using this trick to generating meshes :) – Silvia Sep 22 '14 at 21:56

Step 1 I deleted color of polygon in your code like this.

triang1 = {{0, 0, 1}, {1, 0, 1 + Sqrt}, {-1, 0, 1 + Sqrt}};
triang2 = RotationTransform[2 Pi/3, {1, 0, 0}, {0, 0, 0}][triang1];
triang3 = RotationTransform[4 Pi/3, {1, 0, 0}, {0, 0, 0}][triang1];

pic1 = Graphics3D[{Polygon[triang1]}];
pic2 = Graphics3D[{Polygon[triang2]}];
pic3 = Graphics3D[{Polygon[triang3]}];

trapez1 = {triang1[], triang2[], triang2[], triang1[]};
Gtrapez1 = Graphics3D[{Polygon[trapez1]}];
trapez2 = {triang1[], triang3[], triang3[], triang1[]};
Gtrapez2 = Graphics3D[{Polygon[trapez2]}];
trapez3 = {triang3[], triang2[], triang2[], triang3[]};
Gtrapez3 = Graphics3D[{Polygon[trapez3]}];
trapez4 = {triang1[], triang2[], triang2[], triang1[]};
Gtrapez4 = Graphics3D[{Polygon[trapez4]}];
trapez5 = {triang1[], triang3[], triang3[], triang1[]};
Gtrapez5 = Graphics3D[{Polygon[trapez5]}];
trapez6 = {triang3[], triang2[], triang2[], triang3[]};
Gtrapez6 = Graphics3D[{Polygon[trapez6]}];


Step 2 And I combined Graphics3D-s like following

graphics = {Gtrapez6, Gtrapez5, Gtrapez4, Gtrapez3, Gtrapez2,
Gtrapez1, pic1, pic2, pic3} /. Graphics3D -> Identity;

Graphics3D[graphics] Step 3 I add lighting by using Lighting in the Graphics3D

A = RotationTransform[2 \[Pi]/3, {0, 0, 1}];
lp = {2, 1, 2};
l = {{"Point", Blue, lp},
{"Point", Red, A@lp},
{"Point", Green, A@A@lp}};

Graphics3D[{Opacity[0.4], graphics},
Boxed -> False, Lighting -> l] # ---------------------------------------------------------------------

Last: General Code

Step1

I have made Torus like this

A = RotationTransform[2 \[Pi]/3, {0, 0, 1}];
vertex =
Flatten[
NestList[A, #, 2] & /@ {{1, 0, 1/2}, {5/2, 0, 0}, {1, 0, -1/2}}, 1];
poly =
Flatten /@ (Flatten[
Transpose /@ Partition[
Partition[#, 2, 1, 1] & /@ Partition[Range, 3], 2, 1, 1]
, 1] /. {a_, b_} :> {a, Reverse@b});


Step2

Use Lighting options in the Graphics3D.

lp = {3, 0, 0};
l = {{"Point", Red, lp},
{"Point", Green, A@lp},
{"Point", Blue, A@A@lp}};
Graphics3D[GraphicsComplex[vertex,
{Opacity[0.3], Specularity[Orange, 50], Polygon /@ poly}],
Boxed -> False, Lighting -> l] An other light position

lp = {3, 2, 2};
l = {{"Point", Blue, lp},
{"Point", Red, A@lp},
{"Point", Green, A@A@lp}};
Graphics3D[GraphicsComplex[vertex,
{Opacity[0.3], Specularity[Orange, 50],
EdgeForm[Thin], Polygon /@ poly}],
Boxed -> False, Lighting -> l] • Very beautiful view. Nice light also. Thanks so much. Unfortunately I'm not able to follow the code. As you see, my updated code is made by very intuitive pieces. – Sigur Aug 21 '14 at 18:15
• @Sigur I modified the code for understanding of you from your intuitive pieces. I hope this is helpful for you. – Junho Lee Aug 22 '14 at 0:09