16
$\begingroup$

I'm trying to create a similar style of image like this one, which is the Cayley graph of $A_{5}$.

enter image description here

With Mathematica, I just can create the following

CayleyGraph[PermutationGroup[{Cycles[{{1, 2, 3}}], Cycles[{{1, 5}, {2, 4}}]}], VertexLabels -> Placed["", Center], VertexSize -> 1.5]

enter image description here

It lost some stereoscopic feeling compared to the above one. Since I'm new to Mathematica, I am not quite familiar with this language. Could anyone help me improve it? Thanks in advance.

$\endgroup$
  • $\begingroup$ You may try Graph3D to generate 3D-graphs. You can obtain a fog effect by overlaying the resulting graph with a semi-transparent Image3D. See also here. $\endgroup$ – Henrik Schumacher Mar 4 at 9:17
  • 1
    $\begingroup$ Something to start with Graph3D@CayleyGraph[ ..., VertexSize -> .5] $\endgroup$ – Kuba Mar 4 at 10:06
  • $\begingroup$ Thank you! @HenrikSchumacher $\endgroup$ – user450201 Mar 4 at 10:31
  • $\begingroup$ It works! Thanks!@Kuba $\endgroup$ – user450201 Mar 4 at 10:31
19
$\begingroup$

The simple way:

g = CayleyGraph[
  PermutationGroup[{Cycles[{{1, 2, 3}}], Cycles[{{1, 5}, {2, 4}}]}]]

enter image description here

Graph3D[g, VertexSize -> 0.4, VertexStyle -> Gray]

enter image description here

We can get something that looks more similar to your example by:

  • Flattening the colours and disabling 3D shading: use Glow with your preferred colours and set the normal colour to Black.

  • Thicken the edges. We need a new EdgeShapeFunction for this because edges are rendered as Tube by default, which does not respond to thickness directives.

  • Add "fog" with Raster3D to fade the background.

edges = EdgeList[g] //

     Map[Style[#, Black, 
        Glow@First@PropertyValue[{g, #}, EdgeStyle]] &] //

    ReplaceAll[
     e : DirectedEdge[args___] /; EdgeQ[g, Reverse[e]] :> 
      Sort@UndirectedEdge[args]
     ] //
   DeleteDuplicatesBy[First];

vertices = VertexList[g];

g3d = Graph3D[vertices, edges,
  VertexStyle -> Directive[Black, Glow@GrayLevel[2/3]],
  VertexSize -> 1/2,
  EdgeShapeFunction -> (Tube[Line[#1], 0.05] &)
  ]

Show[g3d,
 Graphics3D[
  Raster3D[
   ConstantArray[.05, {10, 10, 10}], {Scaled[{0, 0, 0}], 
    Scaled[{1, 1, 1}]}, ColorFunction -> Opacity]
  ]
 ]

enter image description here

Here's another one with higher resolution shading:

Show[g3d,
 Graphics3D[
  Raster3D[
   ConstantArray[.02, 50 {1, 1, 1}], {Scaled[{0, 0, 0}], 
    Scaled[{1, 1, 1}]}, ColorFunction -> Opacity]
  ]
 ]

enter image description here

Warning: For some reason, increasing the Raster3D size from 50 to 51 disables the fog shading on my machine (M11.3, macOS 10.14.3).


At first I tried to create the corresponding polyhedron and set it to transparent white to fade the rear objects equally. The problem is that parts of them are outside the polyhedron.

It could be done like this with IGraph/M:

Needs["IGraphM`"]

Show[
 g3d,
 Graphics3D[
  GraphicsComplex[
   GraphEmbedding[g3d], {Opacity[0.7], Black, Glow[White], 
    Polygon[IGFaces@UndirectedGraph[g3d]]}]
  ]
 ]

enter image description here

$\endgroup$
  • $\begingroup$ Nice work! Thanks a lot! $\endgroup$ – user450201 Mar 4 at 10:34
  • $\begingroup$ The missing piece is just the black silhouettes around the circles and the red arrows. $\endgroup$ – Natural Number Guy Mar 4 at 12:23
  • $\begingroup$ @NaturalNumberGuy I am not sure if that's possible with Graphics3D. Maybe with some image processing trickery. $\endgroup$ – Szabolcs Mar 4 at 12:45
  • $\begingroup$ @NaturalNumberGuy Maybe something like this i.stack.imgur.com/rCpBW.png Random-colour features, rasterize, edge-detect, dilate, overlay the edges on original image, downscale for smooth appearance. $\endgroup$ – Szabolcs Mar 4 at 12:53
  • $\begingroup$ We can attempt the same for just the nodes, but I don't like the result: i.stack.imgur.com/AZxRx.png $\endgroup$ – Szabolcs Mar 4 at 12:55

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.