Maybe this can help get you started. I haven't attempted to deal with expanding the lattice size yet.
Taking just the basic lattice image:
LatticeData["TetrahedralPacking", "Image"]
We just want the connectivity of the vertices, which is described by the Line
s:
lines = Cases[LatticeData["TetrahedralPacking", "Image"], Line[_], \[Infinity]]
And just convert them into UndirectedEdge
s:
g = Graph[UndirectedEdge @@@ lines[[1, 1]]]
For a repeating Lattice:
The approach is to duplicate the lattice points, labelling them new vertex number as we go. Then find use Merge
to find where we have multiple points at the same coordinate, keep only the lowest index and replace the other indices appropriately.
First get the Lattice data and the coordinates of the vertices from the GraphicsComplex
:
ld = LatticeData["TetrahedralPacking", "Image"]
gc = First@Cases[ld, GraphicsComplex[___], \[Infinity]]
vertexCoords = gc[[1]]
{{-1, -1, -1}, {-1, -1, 1}, {-1, 1, -1}, {-1, 1,
1}, {1, -1, -1}, {1, -1, 1}, {1, 1, -1}, {1, 1, 1}, {0, 0, 1}, {1,
0, 0}, {0, 1, 0}, {-1, 0, 0}, {0, 0, -1}, {0, -1, 0}, {1/2, 1/2, 1/
2}, {-(1/2), -(1/2), 1/2}, {1/2, -(1/2), -(1/2)}, {-(1/2), 1/
2, -(1/2)}}
nVertices = Length[vertxCoords]
18
vertexConnections = Cases[gc, Line[___], \[Infinity]][[1, 1]]
{{15, 8}, {15, 9}, {15, 11}, {15, 10}, {16, 9}, {16, 2}, {16,
12}, {16, 14}, {17, 10}, {17, 14}, {17, 13}, {17, 5}, {18, 11}, {18,
12}, {18, 13}, {18, 3}}
Setup our list of shifts:
shifts = 2 Tuples[Range[0, 2], 3];
{{0, 0, 0}, {0, 0, 2}, {0, 0, 4}, {0, 2, 0}, {0, 2, 2}, {0, 2, 4}, {0,
4, 0}, {0, 4, 2}, {0, 4, 4}, {2, 0, 0}, {2, 0, 2}, {2, 0, 4}, {2,
2, 0}, {2, 2, 2}, {2, 2, 4}, {2, 4, 0}, {2, 4, 2}, {2, 4, 4}, {4, 0,
0}, {4, 0, 2}, {4, 0, 4}, {4, 2, 0}, {4, 2, 2}, {4, 2, 4}, {4, 4,
0}, {4, 4, 2}, {4, 4, 4}}
Then create a table of Association
s with vertexCoord->vertexLabel for all the shifts sets:
tab = Table[
Association@Thread[
(TranslationTransform[shifts[[i]]] /@ vertexCoords) ->
Range[(i - 1) nVertices + 1, i nVertices]
]
, {i, Length[shifts]}
];
Group the vertexLables by the vertexCoords:
m = Merge[tab, List];
and create a list of replacement rules for all the duplicated vertices:
repRule[list_] := Rule[#, First[list]] & /@ Rest[list]
rules = Flatten[repRule /@ Flatten[Values[m], 1]]
Finally to get the connectivity of the vertices, just shift the labels of the original connectivity and apply our replacement rules:
vexPairs = Flatten[
Table[vertexConnections + nVertices i , {i, 0, Length[shifts] - 1}],
1] /. rules;
g = Graph[UndirectedEdge @@@ vexPairs]
Then obviously we can use the graph g
to simulate Markov processes etc:
dmp = DiscreteMarkovProcess[UnitVector[VertexCount[g], RandomInteger[{1, VertexCount[g]}]], g];
MarkovProcessProperties[dmp]
We can check that it looks correct in 3D space:
Graphics3D[
GraphicsComplex[
Keys[m],
{
Sphere[#, 0.06] & /@ Range[Length[Keys[m]]],
{GrayLevel[0.7],
Line[vexPairs /.
Thread[(First /@ Flatten[Values[m], 1]) ->
Range[Length[Keys[m]]]]]}
}
],
Boxed -> False
]
cell = LatticeData["TetrahedralPacking", "Image"]
$\endgroup$