1
$\begingroup$

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).

$\endgroup$

1 Answer 1

2
$\begingroup$

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]]

single pattern

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]

finalized image

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]

fun stuff

$\endgroup$
3
  • $\begingroup$ 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!! $\endgroup$
    – Madlad
    Jun 21, 2021 at 17:32
  • 1
    $\begingroup$ 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. $\endgroup$ Jun 21, 2021 at 20:26
  • $\begingroup$ thank you for your help! $\endgroup$
    – Madlad
    Jun 22, 2021 at 14:19

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.