TransWikia.com

How can I make such drawings

Mathematica Asked by Ragab Zidan on March 10, 2021

This Fig. represents LQU, where LQU is a function of $c_1,c_3$, and $c_3$, $c_i in[-1,1]$.

How can I make such drawings?

enter image description here

One Answer

tet = Tetrahedron[{{-1, -1, -1}, {1, 1, -1}, {-1, 1, 1}, {1, -1, 1}}];

Graphics3D[{tet}, Axes -> True]

enter image description here

We can use RegionPlot3D with the options Mesh and MeshShading to subdivide tet into 8 tetrahedra and style the faces differently:

SeedRandom[12]

RegionPlot3D[tet,  
 PlotPoints -> 90, BaseStyle -> Opacity[.9], 
 Mesh -> 1, 
 MeshShading -> RandomColor[{2, 2, 2}] , 
 Lighting -> "Neutral", Axes -> True]

enter image description here

We can also use the function SymmetricSubdivision from Tetrahedron >> Applications to subdivide tet into 8 tetrahedra:

SymmetricSubdivision[Tetrahedron[pl_], k_] /; 0 <= k < 2^Length[pl] := 
  Module[{n = Length[pl] - 1, i0, bl, pos},
   i0 = DigitCount[k, 2, 1]; bl = IntegerDigits[k, 2, n];
   pos = FoldList[If[#2 == 0, #1 + {0, 1}, #1 + {1, 0}] &, {0, i0},  Reverse[bl]];
   Tetrahedron @ Map[Mean, Extract[pl, #] & /@ Map[{#} &, pos + 1, {2}]]]

colors = {Yellow, Yellow, Blue, Yellow, Blue, Blue, Blue, Yellow};

Graphics3D[{colors[[# + 1]], SymmetricSubdivision[tet, #]} & /@ 
  Range[0, 7], BaseStyle -> Opacity[0.5], Axes -> True]

enter image description here

Correct answer by kglr on March 10, 2021

Add your own answers!

Ask a Question

Get help from others!

© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP