10
$\begingroup$

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.

enter image description here

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[3] - 1}, {1, -1 - Sqrt[3], 
      Sqrt[3] - 2}, {-1, -1 - Sqrt[3], Sqrt[3] - 2}}]}]; 
pic2 = Graphics3D[{Pink, 
   Polygon[{{0, 0, 1}, {1, 0, Sqrt[3]}, {-1, 0, Sqrt[3]}}]}];
pic1 = Graphics3D[{Blue, 
    Polygon[{{0, 1, Sqrt[3] - 1}, {1, 1 + Sqrt[3], Sqrt[3] - 2}, 
             {-1, 1 + Sqrt[3], Sqrt[3] - 2}}]}];

enter image description here

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[3]}, {-1, 0, 1 + Sqrt[3]}};
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[[1]], triang2[[1]], triang2[[2]], triang1[[2]]};
Gtrapez1 = Graphics3D[{Yellow, Polygon[trapez1]}];
trapez2 = {triang1[[1]], triang3[[1]], triang3[[2]], triang1[[2]]};
Gtrapez2 = Graphics3D[{Yellow, Polygon[trapez2]}];
trapez3 = {triang3[[1]], triang2[[1]], triang2[[2]], triang3[[2]]};
Gtrapez3 = Graphics3D[{Yellow, Polygon[trapez3]}];
trapez4 = {triang1[[1]], triang2[[1]], triang2[[3]], triang1[[3]]};
Gtrapez4 = Graphics3D[{Yellow, Polygon[trapez4]}];
trapez5 = {triang1[[1]], triang3[[1]], triang3[[3]], triang1[[3]]};
Gtrapez5 = Graphics3D[{Yellow, Polygon[trapez5]}];
trapez6 = {triang3[[1]], triang2[[1]], triang2[[3]], triang3[[3]]};
Gtrapez6 = Graphics3D[{Yellow, Polygon[trapez6]}];

Show[Gtrapez6, Gtrapez5, Gtrapez4, Gtrapez3, Gtrapez2, Gtrapez1,
     pic1, pic2, pic3, Boxed -> False, AspectRatio -> Automatic]

enter image description here

$\endgroup$
11
$\begingroup$

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}]

enter image description here

 Row[toroidalF[#, 1/5, 3/4, Boxed -> False, ImageSize -> 250] & /@ {3, 6, 9, 12}]

enter image description here

Stealing @Junho Lee's lighting l:

 Row[toroidalF[#, Boxed -> False, ImageSize -> 250, Lighting -> l] & /@ {3, 4, 5, 6}]

enter image description here


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[4], 2, 1]]), 1];
 polygons = Polygon /@ faceverts;
 Graphics3D[{Opacity[.5], EdgeForm[], GraphicsComplex[verts, polygons]}, 
            Boxed -> False, ImageSize -> 600]

enter image description here

Update: Triangulation of rectangular faces:

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

enter image description here


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]]}]

enter image description here

tm= TriangulateMesh[rR, MaxCellMeasure -> \[Infinity], MeshQualityGoal->"Minimal"];
HighlightMesh[tm, 
        {Style[2, Directive[Opacity[.5],LightBlue]],Style[1, Directive[Thick,Blue]]}]

enter image description here

$\endgroup$
  • $\begingroup$ Ow, very nice! Thanks. I have no idea about the code but it is pretty. $\endgroup$ – Sigur Aug 21 '14 at 3:32
  • $\begingroup$ What a marvelous update! $\endgroup$ – Sigur Aug 21 '14 at 18:14
  • $\begingroup$ 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. $\endgroup$ – Sigur Aug 22 '14 at 23:55
9
$\begingroup$

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]
                ]

triangular torus

Note the PlotPoints and the MaxRecursion options.

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

Update: From your intuitive code

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

triang1 = {{0, 0, 1}, {1, 0, 1 + Sqrt[3]}, {-1, 0, 1 + Sqrt[3]}};
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[[1]], triang2[[1]], triang2[[2]], triang1[[2]]};
Gtrapez1 = Graphics3D[{Polygon[trapez1]}];
trapez2 = {triang1[[1]], triang3[[1]], triang3[[2]], triang1[[2]]};
Gtrapez2 = Graphics3D[{Polygon[trapez2]}];
trapez3 = {triang3[[1]], triang2[[1]], triang2[[2]], triang3[[2]]};
Gtrapez3 = Graphics3D[{Polygon[trapez3]}];
trapez4 = {triang1[[1]], triang2[[1]], triang2[[3]], triang1[[3]]};
Gtrapez4 = Graphics3D[{Polygon[trapez4]}];
trapez5 = {triang1[[1]], triang3[[1]], triang3[[3]], triang1[[3]]};
Gtrapez5 = Graphics3D[{Polygon[trapez5]}];
trapez6 = {triang3[[1]], triang2[[1]], triang2[[3]], triang3[[3]]};
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]

Blockquote

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]

Blockquote

---------------------------------------------------------------------

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[9], 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]

Blockquote

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]

Blockquote

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – Sigur Aug 21 '14 at 18:15
  • 1
    $\begingroup$ @Sigur I modified the code for understanding of you from your intuitive pieces. I hope this is helpful for you. $\endgroup$ – Junho Lee Aug 22 '14 at 0:09

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.