# 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 triangles.

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. Aug 21, 2014 at 3:32
• What a marvelous update! Aug 21, 2014 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. Aug 22, 2014 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, 2014 at 21:25
• @kguler Have been always using this trick to generating meshes :) Sep 22, 2014 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. Aug 21, 2014 at 18:15
• @Sigur I modified the code for understanding of you from your intuitive pieces. I hope this is helpful for you. Aug 22, 2014 at 0:09

Here is my own variation, which uses a modernized version of Roman Maeder's MakePolygons[]:

MakePolygons[vl_] /; ArrayQ[vl, 3] := Module[{dims = Most[Dimensions[vl]]},
GraphicsComplex[Apply[Join, vl], Polygon[Flatten[Apply[Join[#1, Reverse[#2]] &,
Partition[Partition[Range[Times @@ dims], Last[dims]], {2, 2}, {1, 1}],
{2}], 1]]]]

With[{n = 6, m = 3, c = 3, r = 1}, 