5
$\begingroup$

I'm interested in creating a Cayley's table of square using Mathematica. I'm not a programmer but occasionally resort to using Mathematica to simplify my work insofar as the programming doesn't take too long to create. I am after all a student and with a tight schedule as an undergrad in phys and math.

The idea behind the Cayley's table is this:

Imagine a square with with it's side labelled A,B,C,D. The possible permutations are all degrees of rotations (but which we will only restrict ourself to 0,90,180,270 and 360.Then, comes horizontal imaging, vertical imaging and diagonal imagine. (reflection)

enter image description here

The columns denotes some initial starting position and the rows denotes the machinery or function(or degrees of freedom) in which the initial position is subject to. What I want to achieve is be able to input an initial position and function such that mathematica will generate the output visually. Imagine holding a 2D square with the sides labelled A, B, C and D in clockwise motion and if a command was given to rotate the square by 90 degrees, there would be a corresponding change in the positions of the label. Extend this to reflection along the horizontal, vertical and diagonal axis.

An example is as below. Could anyone point to me the direction to get this started? Note: As it stands, I have no idea which tag should this topic go under.

$\endgroup$

2 Answers 2

5
$\begingroup$

You have defined the elements of group and could approach as follows:

r[a_] = RotationMatrix[a Degree];
rot = {r90, r180, r270} = r /@ Range[90, 270, 90]
ref = {rh, rv, d1, d2} = 
   ReflectionMatrix[#] & /@ {{1, 0}, {0, 1}, {1, 1}, {-1, 1}};
tab = {IdentityMatrix[2]}~Join~rot~Join~ref;
rules = {IdentityMatrix[2] -> "\!\(\*SubscriptBox[\(R\), \(0\)]\)", 
   r90 -> "\!\(\*SubscriptBox[\(R\), \(90\)]\)", 
   r180 -> "\!\(\*SubscriptBox[\(R\), \(180\)]\)", 
   r270 -> "\!\(\*SubscriptBox[\(R\), \(270\)]\)", rh -> "H", 
   rv -> "V", d1 -> "\!\(\*SubscriptBox[\(D\), \(1\)]\)", 
   d2 -> "\!\(\*SubscriptBox[\(D\), \(2\)]\)"};
TableForm[(Outer[#1.#2 &, w @@@ tab, w @@@ tab] /. w -> List) /. 
  rules, TableHeadings -> {rules[[;; , 2]], rules[[;; , 2]]}]

enter image description here

Note I have not carefully checked my labels match your intentions.

$\endgroup$
3
  • $\begingroup$ #1.#2 & can be replaced with Dot. An alternative way to generate the table would be to use the *Transform functions along with Identity[]; Composition[] then takes the place of Dot[]. $\endgroup$ May 11, 2015 at 9:50
  • $\begingroup$ @Guesswhoitis. thank you for the feedback...agree character halving with Dot and alternative approaches...I guess just wanted to illustrate could be done with all elements listed in q. , accept variety of better approaches:) $\endgroup$
    – ubpdqn
    May 11, 2015 at 10:00
  • 3
    $\begingroup$ GroupMultiplicationTable[DihedralGroup[4]] // TableForm also does the trick, although Mathematica uses a different ordering of the group elements. $\endgroup$ May 11, 2015 at 13:47
4
$\begingroup$

Given that you just want to relabel the square each time, it's probably easiest just to view this as a set of permutations. Imagine numbering the corners of the square clockwise from the upper left. When we do an operation on the square, we could then write down a list of the corner that's in each position. For example, {1,2,3,4} would correspond to the square in its original position; {2,3,4,1} would correspond to the square rotated by 90° counterclockwise; {3,2,1,4} would correspond to a diagonal reflection; and so on.

Mathematica has some built-in functionality to deal with group operations. In your case, you have the dihedral group on 4 elements, and so you can get a list of all the possible permutations via

permlist = Thread[PermutationList[GroupElements[DihedralGroup[4]], 4]]

{{1, 2, 3, 4}, {1, 4, 3, 2}, {2, 1, 4, 3}, {2, 3, 4, 1}, 
 {3, 2, 1, 4}, {3, 4, 1, 2}, {4, 1, 2, 3}, {4, 3, 2, 1}}

These can by identified as the eight permutations listed above:

{r0, d1, v, r90, d2, r180, r270, h} = permlist;

Once you have this list, then the PermutationProduct command will give you the composition of multiple permutations. Note, though, that successive permutations act from the left, i.e., if you want to find out what the square does under a rotation by 90° and then a vertical reflection, you need to enter

PermutationProduct[v, r90]
% == d2

{3, 2, 1, 4}
True

As far as creating a graphic of the new, transformed square, here's my attempt; it shamelessly exploits the PlotMarker option of ListPlot.

newsquare[foo_] := 
 ListPlot[{{{0, 1}}, {{1, 1}}, {{1, 0}}, {{0, 0}}}, 
  PlotMarkers -> 
   Permute[{{"a", Large}, {"b", Large}, {"c", Large}, {"d", Large}}, 
    InversePermutation[foo]], AspectRatio -> 1, Axes -> False, 
  PlotRangePadding -> .1, 
  Epilog -> Rectangle[{0.05, 0.05}, {0.95, 0.95}]]

The InversePermutation is required because Mathematica's Permute function does the permutations in the opposite way I described above (effectively permuting what's in each slot rather than the objects themselves.) So we get, for example, a square rotated by 270° counterclockwise:

newsquare[r270]

enter image description here

Or a square flipped horizontally, rotated by 270°, flipped vertically, rotated by 90°, and then flipped vertically again:

newsquare[PermutationProduct[v, r90, v, r270, h]]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.