2
$\begingroup$

I have

hexpoints = 
  Table[{Cos[n Pi/3] + 1, Sin[n Pi/3] + \[Sqrt]3/2}, {n, 6}];

Which gives the fundamental cell to be applied in

ptss[x_, y_] := 
 Flatten[Table[{{3 m, \[Sqrt]3 n}, {3 m + 
      3/2, \[Sqrt]3 n + \[Sqrt]3/2}}, {m, 0, x}, {n, 0, y}], 2]

by a transformation

hexlattice = 
  TranslationTransform[# - hexpoints[[1]]][hexpoints] & /@ ptss[1, 1];

In this case is a set of points

{{{0, 0}, {-1, 0}, {-(3/2), -(Sqrt[3]/2)}, {-1, -Sqrt[3]}, {0, -Sqrt[3]}, ... 

ListPlot of them

enter image description here

How could I rotate these points, by an arbitrary axis and angle?

$\endgroup$
  • $\begingroup$ Have you had a chance to check out RotationTransform? $\endgroup$ – MassDefect Sep 27 '19 at 4:12
  • $\begingroup$ Yes, I've tried to use that, but with no success (in hexpointss = Table[{Cos[n Pi/3] + 1, Sin[n Pi/3] + [Sqrt]3/2}, {n, 6}]) $\endgroup$ – Lucas Lopes Sep 27 '19 at 4:20
7
$\begingroup$
hexlattice = Join @@ (TranslationTransform[# - hexpoints[[1]]][hexpoints] & /@ ptss[1, 1]);

Manipulate[Graphics[{Gray, PointSize[Medium], Point[hexlattice],
    Red, Rotate[Point @ #, θ, x] & /@ hexlattice}, 
   PlotRange -> {{-10, 10}, {-10, 10}}, GridLines -> (List /@ x)], 
 {θ, 0, 2 Pi, Experimental`AngularSlider[##] &}, 
 {{x, {0, 0}}, Locator}]

enter image description here

Using Graph to connect points to their translations:

ClearAll[colors]
colors[t_, x_][p_] := p /. Thread[Range[2 Length @ hexlattice] -> 
 Join[#, #] & @(ColorData["Rainbow"] /@ Rescale[Range[Length @ hexlattice]])];

Manipulate[Graph[DirectedEdge[#, # + Length @ hexlattice] & /@ Range[Length @ hexlattice], 
    VertexSize -> {_ -> Scaled[.02], 
     (Alternatives @@ Range[Length @ hexlattice]) -> Scaled[.015]}, 
    EdgeStyle -> {DirectedEdge[a_, b_] :> 
      Directive[Arrowheads[Small], Lighter[colors[θ, x][a]], Thin]}, 
    VertexStyle -> {v_ :> colors[θ, x][v]}, 
    VertexCoordinates -> Join[Thread[Range[Length@hexlattice] -> hexlattice], 
     Thread[Length[hexlattice] + Range[Length@hexlattice] -> 
        (RotationTransform[θ, x] /@ hexlattice)]], 
    PlotRange -> {{-10, 10}, {-10, 10}}, 
    GridLines -> (List /@ x)], 
  {{θ, Pi/2}, 0, 2 Pi, Experimental`AngularSlider[##] &}, 
  {{x, {-2, -3}}, Locator}] 

enter image description here

|improve this answer|||||
$\endgroup$
  • $\begingroup$ That angular slider is awesome. I'm going to get some use out of that! $\endgroup$ – MassDefect Sep 27 '19 at 15:44
  • 2
    $\begingroup$ @MassDefect, you might find NotebookTools`AngularSliderTest[] useful. $\endgroup$ – kglr Sep 27 '19 at 15:46
2
$\begingroup$

My take.

rotate = RotationTransform[Pi/12, {2.5, 1}];

Show[
ListPlot[hexlattice], 
ListPlot[rotate /@ hexlattice], 
 Epilog -> ({Dashed, Blue, Opacity[0.6], Arrowheads[Small], 
      Arrow[#]} & /@ 
    Transpose[{Flatten[hexlattice, 1], 
      Flatten[rotate /@ hexlattice, 1]}]), 
PlotRange -> All]

|improve this answer|||||
$\endgroup$
1
$\begingroup$

First, define the axis and the angle, then translate all points so that the origin is now your axis. After that rotate using the rotation matrix and put the origin back as it was. This can be summed up as

$$ \vec{x}_{new} = R(\theta) \cdot (\vec{x}_{old} - \vec{x}_{axis}) + \vec{x}_{axis} $$

axis = {1, 1};
angle = π/20;
rotatedhexlattice = 
 Table[RotationMatrix[angle].(point - axis) + axis, {point,Flatten[hexlattice, 1]}]

Note, that I used Flatten because of the structure of hexlattice.

This produces the following listplot:

rotated-hex

Gray points are the old ones, orange "x" is the center and red points are the rotated ones.

|improve this answer|||||
$\endgroup$
  • $\begingroup$ If I use pts[a,b] with a>b or b>a. The lattice become deformated, you know why? $\endgroup$ – Lucas Lopes Sep 28 '19 at 7:14

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.