# Improving my superimposed hexagonal lattice code

Pretty knew to Mathematica here. I have created a code stemming from a basic function that I found here in the stack exchange. I am basically making three different hexagonal lattices. Two of them are rotated with respect to the [un]-rotated one. There are two different angles of rotation, but what they are is not relevant. My code is the following:

\[Theta]tm = 5;
\[Theta]mb = -5;

unitcell[x_, y_] := {Black, Disk[{x, y}, 0.05], Black,
Disk[{x, y + 2/3 Sin[120 Degree]}, 0.05],
, Black, Line[{{x, y}, {x, y + 2/3 Sin[120 Degree]}}],
Line[{{x, y}, {x + Cos[30 Degree]/2, y - Sin[30 Degree]/2}}],
Line[{{x, y}, {x - Cos[30 Degree]/2, y - Sin[30 Degree]/2}}]}

Rtm[\[Theta]_] = {{Cos[\[Theta]*Pi/360.], -Sin[\[Theta]*Pi/360.]},
{Sin[\[Theta]*Pi/360.], Cos[\[Theta]*Pi/360.]}};

topmoire[x_, y_] := {Red, Disk[Rtm[\[Theta]tm] . {x, y}, 0.05], Red,
Disk[Rtm[\[Theta]tm] . {x, y + 2/3 Sin[120 Degree]}, 0.05],
, Red, Line[{Rtm[\[Theta]tm] . {x, y},
Rtm[\[Theta]tm] . {x, y + 2/3 Sin[120 Degree]}}],
Line[{Rtm[\[Theta]tm] . {x, y},
Rtm[\[Theta]tm] . {x + Cos[30 Degree]/2, y - Sin[30 Degree]/2}}],
Line[{Rtm[\[Theta]tm] . {x, y},
Rtm[\[Theta]tm] . {x - Cos[30 Degree]/2, y - Sin[30 Degree]/2}}]}

Rmb[\[Theta]_] = {{Cos[\[Theta]*Pi/360.], -Sin[\[Theta]*Pi/360.]},
{Sin[\[Theta]*Pi/360.], Cos[\[Theta]*Pi/360.]}};

bottommoire[x_, y_] := {Green, Disk[Rtm[\[Theta]mb] . {x, y}, 0.05],
Green, Disk[Rtm[\[Theta]mb] . {x, y + 2/3 Sin[120 Degree]}, 0.05],
, Green,
Line[{Rtm[\[Theta]mb] . {x, y},
Rtm[\[Theta]mb] . {x, y + 2/3 Sin[120 Degree]}}],
Line[{Rtm[\[Theta]mb] . {x, y},
Rtm[\[Theta]mb] . {x + Cos[30 Degree]/2, y - Sin[30 Degree]/2}}],
Line[{Rtm[\[Theta]mb] . {x, y},
Rtm[\[Theta]mb] . {x - Cos[30 Degree]/2, y - Sin[30 Degree]/2}}]}

middle = Graphics[
Block[{A = {Cos[120 Degree], Sin[120 Degree]}, B = {1, 0},
C = {-1, 0}},
Table[unitcell @@ (A j + B k + C l), {j, -20, 20}, {k,
Ceiling[j/2], 20 + Ceiling[j/2]}, {l, Ceiling[j/2],
20 + Ceiling[j/2]}]], ImageSize -> 500];

top = Graphics[
Block[{A = {Cos[120 Degree], Sin[120 Degree]}, B = {1, 0},
C = {-1, 0}},
Table[topmoire @@ (A j + B k + C l), {j, -20, 20}, {k,
Ceiling[j/2], 20 + Ceiling[j/2]}, {l, Ceiling[j/2],
20 + Ceiling[j/2]}]], ImageSize -> 500];

bottom = Graphics[
Block[{A = {Cos[120 Degree], Sin[120 Degree]}, B = {1, 0},
C = {-1, 0}},
Table[bottommoire @@ (A j + B k + C l), {j, -20, 20}, {k,
Ceiling[j/2], 20 + Ceiling[j/2]}, {l, Ceiling[j/2],
20 + Ceiling[j/2]}]], ImageSize -> 500];

Show[top, middle, bottom]


I was having trouble superimposing the three lattices on top of each other. For this I used

Show[top,middle,bottom]

However, in order to center the lattices at the origin, I had to introduce another vector within the function Table, the vector "C" multiplied by "l". I think this has made my code crash everytime I try to run it. Is there another efficient way to either center the lattices on the origin of rotation with only two vectors, or perhaps a replacement of the Table function?

Also, while this is not urgent, and not as important. I would like to know how to generalize this code in order to depend on a position argument, i.e. "r" where I can tweak how big (unit of length) I want the lattice to be (in x and y directions).

I'm gonna be honest here, I didn't even try to understand your code. It seems that it produces a lot of unnessecary duplicate data I think.

I implemented a Grid from scratch which can only generate a non-rotated grid:

TriAngle[{x_,y_},leftMost_,topMost_]:={
Line[{{x,y},{x,y}+{Sin[Pi],Cos[Pi]}}],
Line[{{x,y},{x,y}+{Sin[Pi+2/3Pi],Cos[Pi+2/3Pi]}}],
Line[{{x,y},{x,y}+{Sin[Pi+4/3Pi],Cos[Pi+4/3Pi]}}],
If[leftMost,Line[{{x,y}+{Sin[Pi+2/3Pi],Cos[Pi+2/3Pi]},{x,y}+{Sin[Pi+2/3Pi],Cos[Pi+2/3Pi]}-{Sin[Pi+4/3Pi],Cos[Pi+4/3*Pi]}}],Nothing],
If[topMost,Line[{{x,y}+{Sin[Pi+4/3Pi],Cos[Pi+4/3Pi]},{x,y}+{Sin[Pi+4/3Pi],Cos[Pi+4/3Pi]}+{0,1}}],Nothing]
}

LatticePattern[xN_,yN_]:=Flatten[Table[TriAngle[{Cos[Pi/6]*x*2.0-Cos[Pi/6]*y,y+Sin[Pi/6]*y},x==Floor[-xN/2]&&y!=Floor[yN/2],y==Floor[yN/2]&&x!=Floor[xN/2]],{x,Floor[-xN/2],Floor[xN/2]},{y,Floor[-yN/2],Floor[yN/2]}]]


This creates all the Line primitives for your grid. So for example:

Graphics[LatticePattern[10, 10]]


Equipped with that, I just made two copies and used GeometricTransformationto apply the rotations.

\[Theta]p=5;
\[Theta]m=-5;
p1=LatticePattern[30,30];
p2=GeometricTransformation [p1,RotationTransform[\[Theta]p*\[Degree],{0,0}]];
p3=GeometricTransformation [p1,RotationTransform[\[Theta]m*\[Degree],{0,0}]];
Graphics[{Black,p1,Red,p2,Green,p3}//Flatten,ImageSize->800]


I hope this helps.

EDIT: Oh this is fun:

p1=LatticePattern[20,20,0.0];
Graphics[Flatten[Table[{Hue[phi/Pi],GeometricTransformation[p1,RotationTransform[phi,{0,0}]]},{phi,0,Pi,Pi/20}]],ImageSize->800]


• I understand that when constructing the lines, you are adding 120 degrees from the prior. However I was wondering if it can be expressed in terms of predefined vectors instead? For example, the vector that takes me from the center of an hexagon to the next, and so on. P.s. what a wonderful piece of art you did!! Jun 21, 2021 at 17:32
• There are multiple questions like this on here. An answer assuming just a set of basis vectors is in here: mathematica.stackexchange.com/questions/61834/…. You can use the same GeometricTransformation technique afterwards. Jun 21, 2021 at 20:26
• thank you for your help! Jun 22, 2021 at 14:19