# How to visualize a Cayley graph in this style?

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

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]


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.

• 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. Commented Mar 4, 2019 at 9:17
• Something to start with Graph3D@CayleyGraph[ ..., VertexSize -> .5]
– Kuba
Commented Mar 4, 2019 at 10:06
• Thank you! @HenrikSchumacher Commented Mar 4, 2019 at 10:31
• It works! Thanks!@Kuba Commented Mar 4, 2019 at 10:31

The simple way:

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


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


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.

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


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


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


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