8
$\begingroup$

I am trying to produce a figure of a 3d lattice path.

Currently, I am using

getedges[f_] := 
  Table[Style[UndirectedEdge[f[[i]], f[[i + 1]]], Thick, Black], {i, 
    1, Length@f - 1}];
getverts[f_] := 
 Table[Style[f[[i]], Black, FaceForm[White], 
   EdgeForm[{Thickness[0.008], Black}]], {i, 1, Length@f}]; With[{n = 
   3}, g = GridGraph[{n, n, n}];
 HighlightGraph[g, {PathGraph[#], getedges[#], getverts[#]}, 
    PlotTheme -> "Monochrome"] & /@ FindPath[g, 1, n n n , {6}, All]]

which gives

enter image description here

However, I need something which

1) has edges aligned (so facing in one of three directions). 2) is not on a slightly rotated/skewed lattice. 3) potentially, has a labelled axes.

Is there an GraphLayout available for this, i.e. a standard 3D lattice?

Something like a 3D version of:

enter image description here

$\endgroup$

1 Answer 1

8
$\begingroup$

Update: It turns out Graph3D with "HighDimensionalEmbedding" layout does give the desired result:

Graph3D[GridGraph[{3,3,3}],  GraphLayout -> "HighDimensionalEmbedding"]

enter image description here

Alternatively, you can create a 2D graph with the option GraphLayout -> "HighDimensionalEmbedding" and wrap the output with Graph3D to get a 3D layout:

g1 = GridGraph[{3, 3, 3}, GraphLayout -> "HighDimensionalEmbedding"]

enter image description here

Graph3D @ g1

enter image description here

The same approach works with some GraphLayout settings:

SeedRandom[1]
g1 = GridGraph[{3, 3, 3}, GraphLayout -> "HighDimensionalEmbedding"];
g2 = RandomGraph[{10, 20}, GraphLayout -> "HighDimensionalEmbedding"];
g3 = RandomGraph[{10, 20}, GraphLayout -> "RadialEmbedding"];
g4 = RandomGraph[{10, 20}, GraphLayout -> "StarEmbedding"];
g5 = RandomGraph[{10, 20}, GraphLayout -> "LayeredDigraphEmbedding"];

Grid[Transpose[{#, Graph3D@#} & /@ {g1, g2, g3, g4, g5}],  Dividers -> All]

enter image description here

Note that 3D layout in the last example puts all vertices on a single plane.

Original answer:

You can use Graph3D with custom vertex coordinates:

g3d = With[{n = 3}, 
 Graph3D[GridGraph[{n, n, n}], 
  VertexCoordinates -> Tuples[Range[n], n]]]

enter image description here

Row[
 HighlightGraph[g3d, Subgraph[g3d, #],
    PlotTheme -> "Monochrome", 
    ImageSize -> Small] & /@ 
 FindPath[g3d, 1, 27, {6}, 5]]

enter image description here

To style vertices and edges on the selected paths:

Row[ 
  HighlightGraph[
    g3d, 
    {Style[#, Red], Style[EdgeList@Subgraph[g3d, #], Green]}, 
    PlotTheme -> "Monochrome", 
    ImageSize -> Small] & /@ 
  FindPath[g3d, 1, 27, {6}, 5]]

enter image description here

$\endgroup$
3
  • $\begingroup$ Nice, thank you. I imagine its possible to edit the edge/vertex styles with HighlightGraph? $\endgroup$
    – apg
    Jan 2, 2020 at 18:48
  • 1
    $\begingroup$ @AlexanderKartun-Giles, pls see the update. $\endgroup$
    – kglr
    Jan 2, 2020 at 19:02
  • $\begingroup$ Ok that is ideal. Thank you. $\endgroup$
    – apg
    Jan 2, 2020 at 19:04

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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