A remarkable magic square

Ideas
,
1

Consider the following order-7 magic square.

Row[Text@Style[Grid[#, Frame -> All], 30] & /@ 
  With[{seq = Table[
      RotateLeft[Mod[Range[0, 6] + 1, 7], Mod[2 n, 7]], {n, 0, 6}]}, {50 - (Transpose[seq] + 
       7 RotateRight[Reverse[Mod[seq + 5, 7]]] + 1), Partition[Range[49], 7]}], Spacer[20]]

Rx7uc.gif
Rx7uc.gif768×286 17.3 KB

The rows, columns, and diagonals all add up to the same sum: 175. Also, all the broken diagonals add up to the same sum, making this a pandiagonal magic square. The square is like a torus – by shifting rows or columns to the other edge, any square can be put at the center.

Pick a number from the magic square, then shift about both squares so that your chosen number is at the center. Place a queen at the center of each square. Each queen will then cover one number, the same number, and attack 24 other numbers. Neither queen will attack the same number, and every number gets attacked on exactly one of the two squares! The magic square is pandiagonal

In combinatorics, this is known as the 2-(49,7,1) design. With 49 elements, in blocks of 7, any 2 items can be found in exactly 1 of the blocks. Each of the two squares represents 7 rows, 7 columns, 7 left diagonals, 7 right diagonals, or 28 blocks in each square. So 56 blocks in total. This is also known as the Paley-49 graph. A similar trick can be done with 4x4 magic squares.

6 Likes
Create Magic Cubes, moon level ( 9x9) ?
2

Ed Pegg:

One can use a modified De LaLoubere (Siam) algorithm to reach a similar pandiagonal magic square. Where the matrix size is 7, and place first number in a normal sequence at cell 2,3. Then apply the following rules to fill the matrix using ordinary step 1 over to the right with ordinary step 4 down. If landing cell is not empty, then make a break step 5 over to right with break step 4 up place next number in a normal sequence.

The following code is old and never really modified it to flow better in WL, it is a translation from a Pascal version I wrote >25 years ago. So does not represent efficient WL code.

magicSquare[n_, ordx_, ordy_, breakx_, breaky_, i_, j_] := 
  Module[{magicMatrix = Table[0, {n}, {n}], x = i, y = j, counter = 1,
     nextox, nextoy, nextbx, nextby}, magicMatrix[[x, y]] = 1;
   While[counter < n^2,(*while body*)counter++;
    nextox = x + ordy;
    If[nextox < 1, nextox = n + nextox,];
    If[nextox > n, nextox = Mod[nextox, n],];
    nextoy = y + ordx;
    If[nextoy < 1, nextoy = n + nextoy,];
    If[nextoy > n, nextoy = Mod[nextoy, n],];
    If[magicMatrix[[nextox, nextoy]] == 0,(*if body*)
     x = nextox; y = nextoy;
     magicMatrix[[x, y]] = counter,
     (*else*)nextbx = x + breaky;
     If[nextbx < 1, nextbx = n + nextbx,];
     If[nextbx > n, nextbx = Mod[nextbx, n],];
     nextby = y + breakx;
     If[nextby < 1, nextby = n + nextby,];
     If[nextby > n, nextby = Mod[nextby, n],];
     If[magicMatrix[[nextbx, nextby]] == 0, x = nextbx;
      y = nextby;
      magicMatrix[[x, y]] = counter],];(*end if*)];(*end while*)
   Return[MatrixForm[magicMatrix]];];

So applying the function

z = magicSquare[7, 1, 4, 5, -4, 2, 3]

We get

(6	46	37	35	26	17	8
19	10	1	48	39	30	28
32	23	21	12	3	43	41
45	36	34	25	16	14	5
9	7	47	38	29	27	18
22	20	11	2	49	40	31
42	33	24	15	13	4	44 )

Which seems equivalent to the matrix in your example. If you Mod[ z[[[1]],7] +1, then you get a Latin Square.