1
$\begingroup$

I want to generate an image in order to explain a construction. The construction is the following. Start from a finite-sized 2D square lattice, create 3 copies of the starting lattice and place them one on top of the others. I will call these copies "layers". In this way, for each edge on the original lattice, we will have 3 couples of vertices, connected two by two in the same layer. Then we take, uniformly at random, a permutation of the 3 vertices in such a way to create inter-layer connections. Repeating this random permutation for each edge we obtain a new lattice with three times the number of vertices of the original one. A simple image to explain this construction can be this one:enter image description here where the original square lattice is composed of four vertices. I wanted to generate, using mathematica the first step, that is 3 layers of the same 2D square lattice (with more than 4 edges) and then the graph which results from the random rewiring. I tried but I didn't understand how to display any of these images. I tried with GraphPlot3D but I wanted to place the vertices on a $\mathbb{Z}^D$ lattice, but I cannot figure out how. Can anyone help me?

Edit Thanks to azerbajdzan's answer I succeded in generating the leftmost image but with three copies of a square lattice in 2D with $n^2$ vertices. In my hand-drawn picture and in azerbajdzan's answer $n^2=4$. The code is the following:

n = 64;
M = 3;
Nv = Range[M*n];
dx = 1;
dy = 1;
dz = 1 + n^0.3;
Ncoo = Flatten[Table[Table[Table[{dx k, dy j, dz i}, {k, 0,Sqrt[n]-1}], {j, 0, Sqrt[n] - 1}], {i, 0, 2}], 2];
ad1 = AdjacencyMatrix@GridGraph[{Sqrt[n], Sqrt[n]}];
ad2 = ArrayFlatten[{{ad1, ConstantArray[0, {n, n}], ConstantArray[0, {n, n}]}, {ConstantArray[0, {n, n}], ad1, ConstantArray[0, {n, n}]}, {ConstantArray[0, {n, n}], ConstantArray[0, {n, n}], ad1}}];
Graph3D[AdjacencyGraph[ad2, VertexCoordinates -> Thread[Nv ->Ncoo]]]

which results in the following image:

enter image description here

Now I wanted to generate the permutations as azerbajdzan did for the simple case $n^2=4$. Does anyone have an idea?

$\endgroup$
7
  • $\begingroup$ Why does the new lattice have three times the number of vertices of the original one? I don't see how this manifests in your pictures. $\endgroup$
    – lericr
    Oct 16, 2023 at 17:27
  • $\begingroup$ I think you might be better off conceiving this as purmuting the vertices rather than the edges. That is, each of the vertices in your original shape gets expanded to a "column" of vertices once you've created your layers. For each of these columns, permute the vertices randomly while maintaining the edge relationships. $\endgroup$
    – lericr
    Oct 16, 2023 at 17:32
  • $\begingroup$ The "original lattice" in the picture is composed by 4 vertices connected in a square shape, the final graph is done with 12 vertices, that's why the number of vertices in the final graph is "three times the number of vertices of the original one". For the second comment: I can also see the permutation on the vertices, as you said, but I prefer to graphically fix the positions of the vertices and then move the edges. I think that in this way the resulting drawing is more understandable. $\endgroup$ Oct 17, 2023 at 8:16
  • $\begingroup$ In the end what I wanted are two images: 1) three copies of a 2D square lattice in perspective (as the hand-drawn picture), one on top of the other 2) fixing the position of the vertices, the graph resulting from the permutation as described in the question. 1) is basically the first graph on the left of the hand-drawn picture, the one with three squares one on top of the other, while 2) is the same image (the position of the vertices is the same) but with the edges moved according to the random permutations. $\endgroup$ Oct 17, 2023 at 8:22
  • $\begingroup$ I wanted to do it in Mathematica in order to draw these graphs but for a square lattice whit more than 4 vertices, maybe a 4x3 grid. In this way the permutation is exact and authomatic, otherwise I could use different drawing programs to realize it but it is long and not generalizable to bigger lattices. Thanks anyway for the help, your question also is useful! $\endgroup$ Oct 17, 2023 at 8:24

3 Answers 3

2
$\begingroup$
vl = Range[4];
svl = vl[[{1, -1}]];
el = UndirectedEdge @@@ Partition[vl, 2, 1, 1];
coo = {{0, 0}, {1, 0}, {1 + 1/Sqrt[2], 1/Sqrt[2]}, {1/Sqrt[2], 1/Sqrt[
    2]}};
n = 3;

nvl = Table[vl /. x_?NumericQ :> x + 4 (i - 1), {i, n}] // Flatten;
nsvl = Table[svl /. x_?NumericQ :> x + 4 (i - 1), {i, n}] // Flatten;
nel = Table[el /. x_?NumericQ :> x + 4 (i - 1), {i, n}] // Flatten;
ncoo = Flatten[Table[# + {0, Sqrt[2] (i - 1)} & /@ coo, {i, n}], 1];

g1 = Graph[nel, VertexCoordinates -> Thread[nvl -> ncoo], 
   VertexSize -> {Alternatives @@ nsvl -> 0}];

h1 = VertexDelete[g1, Alternatives @@ nsvl];

AnnotationValue[h1, VertexCoordinates] = 
  Flatten[{#[[1]], #[[1]] + {1, 0}} & /@ 
    Partition[AnnotationValue[h1, VertexCoordinates], 2], 1];

g2 = Graph[{1 \[UndirectedEdge] 2, 3 \[UndirectedEdge] 4, 
    3 \[UndirectedEdge] 6, 7 \[UndirectedEdge] 8, 
    7 \[UndirectedEdge] 10, 11 \[UndirectedEdge] 12, 
    9 \[UndirectedEdge] 12, 9 \[UndirectedEdge] 6, 
    1 \[UndirectedEdge] 8, 2 \[UndirectedEdge] 11, 
    10 \[UndirectedEdge] 5, 5 \[UndirectedEdge] 4}, 
   VertexCoordinates -> Thread[nvl -> ncoo], 
   VertexSize -> {Alternatives @@ nsvl -> 0}];

h2 = VertexDelete[g2, Alternatives @@ nsvl];

AnnotationValue[h2, VertexCoordinates] = 
  Flatten[{#[[1]], #[[1]] + {1, 0}} & /@ 
    Partition[AnnotationValue[h2, VertexCoordinates], 2], 1];

Grid[{{g1, h1}}]
Grid[{{g2, h2}}]

EdgeAdd[EdgeDelete[g1, EdgeList[g1]], 
 Join[Thread[
   UndirectedEdge @@ {{2, 6, 10}, RandomSample[{3, 7, 11}]}], 
  Thread[UndirectedEdge @@ {{1, 5, 9}, RandomSample[{4, 8, 12}]}]]]

enter image description here

Since it is not clear what connection are allowed and what are not for random permutations only randomness is applied on first two leftmost vertices and two rightmost vertices.

enter image description here

$\endgroup$
0
$\begingroup$

I suspect that I'm not understanding this completely, but I'll make a suggestion anyway in the hopes it gets you started. I'm going to start with symbolic coordinates to make it easier to understand what's going on.

original2D = {{a, a}, {b, a}, {a, b}}
(* So, our original shape is a triangle. *)

layersTransposed = Outer[Append, original2D, {X, Y, Z}, 1]
(* {{{a, a, X}, {a, a, Y}, {a, a, Z}}, 
    {{b, a, X}, {b, a, Y}, {b, a, Z}}, 
    {{a, b, X}, {a, b, Y}, {a, b, Z}}} *)

We want to embed the triangle in 3D space at three different layer positions, but this left the data transposed. That's actually going to make the next step more convenient, so we won't transpose until the next step.

randomlySwappedVertices = Transpose[RandomSample /@ layersTransposed]
(* {{{a, a, Y}, {b, a, Y}, {a, b, Y}}, 
    {{a, a, X}, {b, a, Z}, {a, b, X}}, 
    {{a, a, Z}, {b, a, X}, {a, b, Z}}} *)
(* The randomness will probably produce different specific results for you. *)

Let's use numeric coordinates and visualize the result.

a = 0; b = 1; X = 0; Y = 1; Z = 2;
Graphics3D[Polygon /@ randomlySwappedVertices]

enter image description here

Now, I get the impression from your hand-drawn picture that you don't expect the polygons to remain distinct, so this is probably not exactly what you wanted, but I didn't understand how you got the "back side" of your picture.

$\endgroup$
0
$\begingroup$

I will provide the code to do what I wanted. Part of the answer is thank to azerbajdzan's one.

n = 9;
M = 4;
Nv = Range[M*n];
dx = 1;
dy = 1;
dz = 1 + n^0.01;
Ncoo = Flatten[Table[Table[Table[{dx k, dy j, dz*i}, {k, 0, Sqrt[n] - 1}], {j, 0, Sqrt[n] - 1}], {i, 0, M - 1}], 2];
ad1 = AdjacencyMatrix@GridGraph[{Sqrt[n], Sqrt[n]}];
ad2 = ConstantArray[0, {n, n}];
data = Table[Flatten[Table[{ad2}, {m, 0, M - 1}], 1], {m, 0, M - 1}];
data // MatrixForm;
data[[1]][[1]] // MatrixForm;
For[kk = 1, kk <= M, kk++, data[[kk]][[kk]] = ad1]
data // MatrixForm;
ad = ArrayFlatten[data];
ad // MatrixForm;
g = Graph3D[AdjacencyGraph[ad, VertexCoordinates -> Thread[Nv -> Ncoo]]];
el = EdgeList[g];
Funz[a_] := Module[{i, j},
  i = el[[a]][[1]];
  j = el[[a]][[2]];
  For[ii = 0, ii < M, ii++, g = EdgeDelete[g, {i + ii n \[UndirectedEdge] j + ii n}];];
  g = EdgeAdd[g, Join[Thread[UndirectedEdge @@ {Flatten[Table[{i + jj*n}, {jj, 0, M - 1}], 2], RandomSample[Flatten[Table[{j + jj*n}, {jj, 0, M - 1}], 2]]}]]]]
g
For[a = 1, a <= 2 Sqrt[n] (Sqrt[n] - 1), a++, Funz[a]]
g

enter image description here enter image description here

First of all I generate the $M$ layers starting from a $2D$ square lattice with $n$ vertices. To plot this stuff I use Graph3D providing the set of vertices in a $\mathbb{Z}^D$ lattice, defined in Ncoo and then using Thread[Nv -> Ncoo]. Then I use the function RandomSample as azerbajdzan did to permute the vertices, as I tried to explain in the question. Finally I plot the result. In this way I can choose the number $M$ of layers and the number of vertices $n$, as I wanted.

$\endgroup$

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.