1
$\begingroup$

I have a unit cell, and I would like to generate a lattice but in iterative order.
For instance, consider the following example--

The unit cell is (zero iteration) enter image description here

This figure is generated by a matrix $M$. And the above figure is just the matrix's adjacency graph, where nodes are the crossing and the endpoints (4 + 8 = 12).
On iterating the above unit cell, we generate the first iteration: enter image description here

The purple part is the result of the first iteration.
Following this procedure, we can then have the second iteration: enter image description here

Similarly, the red part is the result of the second iteration. And this can continue where we decide the $N^{th}$ iteration.
Is there a way to generate this adjacency graph for any $N^{th}$ iteration from a particular unit cell given by $M$, efficiently?
My MNWE that only generate the zeroth iteration ($M$):

ClearAll[i, j, M];
nIteration = 1;
{p, q} = {8, 3};
M = Table[0, {i, 1, p q}, {j, 1, p q}];
For[i = 1, i <= q p, i++,
 
 For[j = 1, j <= q p, j++,
  M[[i, j]] = 
   If[(Abs[i - j] == p - 1 \[Or] 
       Abs[i - j] == 1) \[And] (j <= p \[And] i <= p), 1, 0];
  
  M[[i, j]] = 
   M[[i, j]] + 
    If[(i > p \[Or] 
        j > p) \[And] ((Abs[i - j] == p + i - 1 \[Or] 
          Abs[i - j] == p + i) \[Or] (Abs[i - j] == p + j - 1 \[Or] 
          Abs[i - j] == p + j)), 1, 0];
  
  ]
 
 ]
AdjacencyGraph[M, VertexLabels -> Automatic]

The above code creates the zeroth iteration, i.e., the unit cell. The whole idea is to generate the basic $M$ (zeroth iteration), which is a unit cell for a particular p (i.e., side p with p lines protruding). Then $N^{th}$ iteration can be applied to this particular unit cell to give rise to desired $M$.

EDIT:
After seeing the beautiful solution, I thought to make my question a little more clear.

  1. I am very interested in the adjacency matrix M. Then the above figure is obtained just like a line graph for the matrix M.
  1. Thus, the problem is of the line graph, not precisely a lattice, apologies for this misnomer. The M is generated for a particular value of p (i.e. p=4, leads to a square inside, as shown in above examples; p=3, leads to triangle; p=5, leads to pentagon,... so on, so forth.)
  1. The idea is to generate M recursively for an $N^{th}$ iteration. Not exactly to generate this coloured iterative above lattice, that was just for illustration to so the addition in the $N^{th}$ iteration.
$\endgroup$
3
$\begingroup$

Consider the cells as a grid. Then the 0 generations has the coordinates: {0,0}. The first generation has coordinates: {-1,0},{1,0},{0,-1},{0,1}. The second generation: {-2,0},{-1,1},.. Note that the sum of the absolute values of x/y is equal to the generation. Exploiting this fact, we can generate the coordinates of the cells and store them in an association together with the generation:

generations = 2;
assoc = <||>;
Do[
 AssociateTo[
   assoc, {({x, gen - x}) -> gen, {-x, gen - x} -> gen, {x, -(gen - x)} -> gen, {-x, -(gen - x)} -> gen }];
 , {gen, 0, generations}, {x, 0, gen}]

We may now define a picture (any picture will do) and place multiple copies at all the coordinates. In addition we also add different colors for different generations:

pic[p : {_, _}] := 
  Line[Map[(p + #) &, {{{-a, -b}, {-a, b}}, {{a, -b}, {a, 
        b}}, {{-b, -a}, {b, -a}}, {{-b, a}, {b, a}}} /. {a -> 1/4, 
      b -> 1/2}, {2}]];

MapThread[{Hue[#2/(1 + generations)], pic[#1]} &, {Keys[assoc], 
   Values[assoc]}] // Graphics

enter image description here

enter image description here

$\endgroup$
3
  • $\begingroup$ Almost a a great answer! However, I'm actually interested in the line graph of the matrix M, instead of some kind of 2D lattice. My idea is to recursively generate M for a particular value of p and $N^{th}$ generation. I also edited my question for your review along with new heading. Many thanks! My apologies for being not clear. $\endgroup$
    – L.K.
    Jan 26 at 10:13
  • $\begingroup$ Unfortunately your code does not work. Please give an example for what you want and specify the expected output. $\endgroup$ Jan 26 at 10:46
  • $\begingroup$ There was a mistake, thanks for pointing it out! Finally, the code works. I hope this time it makes the point more clear. $\endgroup$
    – L.K.
    Jan 26 at 12:05
2
$\begingroup$

Can't seem to get your code to work (please make sure it runs from a fresh kernel).

The following is not a recursive approach as the OP requested, but rather generates the adjacency matrix at iteration n for this particular example. At the very least, hopefully someone else can use the adjacency matrices to come up with a recursive solution.

We'll generate the undirected edges for one unit cell at each iteration scale, and then translate them appropriately. Some helper functions:

vertexCount[n_] = (2 (-1 + 3 n))^2;

graph[n_] := Graph[
  Range[vertexCount[n]],
  edges[n],
  VertexCoordinates -> 
   Tuples[Range[-(3 (-1 + 2 n)), (3 (-1 + 2 n)), 2], 2],
  VertexShapeFunction -> Nothing,
  EdgeStyle -> ColorData["BrightBands"][n/10]]

adjacencyMatrix[n_] := AdjacencyMatrix[graph[n]]

Single unit cell at scale n:

singleUnit[n_] := Join[
  (*Horizontal*)
  
  UndirectedEdge @@@ 
   Partition[
    Range[2, 2 + Sqrt[vertexCount[n]] 3, Sqrt[vertexCount[n]]], 2, 
    1],
  UndirectedEdge @@@ 
   Partition[
    Range[3, 3 + Sqrt[vertexCount[n]] 3, Sqrt[vertexCount[n]]], 2, 
    1],
  (*Vertical*)
  
  UndirectedEdge @@@ 
   Partition[Range[2 + (3 (-1 + 2 n)), 5 + (3 (-1 + 2 n)), 1], 2, 1],
  UndirectedEdge @@@ 
   Partition[
    Range[2 + (3 (-1 + 2 n)) + Sqrt[vertexCount[n]], 
     5 + (3 (-1 + 2 n)) + Sqrt[vertexCount[n]], 1], 2, 1]
  ]

The translations for each iteration n. We first generate the outermost 4 cells, and then subdivide the difference along the edges connecting those 4 cells:

Clear[translations]
translations[1] = {0};
outerRingTranslations[n_] := {3 (-1 + n), 
  6 (2 (-1 + n) + 3 (-1 + n)^2), 18 (-1 + (-1 + n)^2 + n), 
  9 (3 (-1 + n) + 4 (-1 + n)^2)}

translations[n_] := 
 Block[{outer = outerRingTranslations[n], pairs, divisions, inner},
  pairs = Extract[outer, List /@ {{1, 2}, {1, 3}, {2, 4}, {3, 4}}];
  divisions = 
   Select[Tuples[Delete[Subdivide[n - 1], {{1}, {-1}}], 2], 
    Total[#] == 1 &];
  inner = 
   Flatten[Table[weights . pair, {weights, divisions}, {pair, pairs}]];
  Join[outer, inner]
  ]

edges[n_] := 
 Join @@ Table[
   singleUnit[n] /. 
    a_ \[UndirectedEdge] b_ :> 
     a + shift \[UndirectedEdge] b + shift, {shift, translations[n]}]

This creates:

Multicolumn[graph /@ Range[8], 4, Appearance -> "Horizontal"]

enter image description here

and as promised, the adjacency matrices are given by:

Multicolumn[ArrayPlot@*adjacencyMatrix /@ Range[8], 4]

enter image description here

Hopefully this gets people started, I'll also think about a recursive solution - perhaps something with MatrixPower?

$\endgroup$
1
  • 1
    $\begingroup$ Many thanks for this nice answer. In the meanwhile, I corrected my code. Now it seems to work. $\endgroup$
    – L.K.
    Jan 26 at 14:00

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.