15
$\begingroup$

There are some matrices such that the sum of columns, the sum of rows, and the sum of diagonals are the same value. Here is an example:

 8     1     6
 3     5     7
 4     9     2

The sum of rows is 15, and so is sum of columns and the sum of diagonals.

In MATLAB, refer to Cleve Moler's book "Experiments with MATLAB". I can generate this kind of matrix using the magicfunction, with an argument specifying the size of the matrix:

4-by-4:

>> magic(4)
ans =
    16     2     3    13
     5    11    10     8
     9     7     6    12
     4    14    15     1

5-by-5:

>> magic(5)
ans =
    17    24     1     8    15
    23     5     7    14    16
     4     6    13    20    22
    10    12    19    21     3
    11    18    25     2     9

Is there a similar function in Mathematica? Or, maybe there's some way to build this kind of matrix?

$\endgroup$
2
  • $\begingroup$ @Amzoti No, I haven't. Thank you for pointing it out, great source! $\endgroup$
    – Nick
    Feb 3, 2015 at 7:33
  • $\begingroup$ @Amzoti Unfortunately that Notebook relies on a package that is no longer available as far as I can tell. Here is an image of the download page in the Internet Archive, but the MagicSquares link does not work: web.archive.org/web/20110215143835/http://library.wolfram.com/… $\endgroup$
    – Mr.Wizard
    Feb 3, 2015 at 7:51

2 Answers 2

19
$\begingroup$

Translated Cleve Moler's magic() function from Matlab code to Mathematica.

Grid[Partition[MatrixForm@magic[#] & /@ {3, 4, 5, 6, 7, 8, 9, 10}, 4], 
    Frame -> All, FrameStyle -> LightGray]

Mathematica graphics

code:

magic[n_Integer /; (n > 0 && n != 2)] := Module[{m, j, k, p, i},
   (*Translation of Cleve Moler's magic magic() function to Mathematica*)
   Which[
    Mod[n, 2] == 1, m = oddOrderMagicSquare[n],
    Mod[n, 4] == 0,
    j = Floor  @ Abs [ Mod[Range[n], 4]/2];
    k = Outer[Equal, j, j] /. {True -> 1, False -> 0};
    m = Outer[Plus, Range[1, n*n, n], Range[0, n - 1]];
    p = Position[k, 1];
    (m[[Sequence @@ #]] = n*n + 1 - m[[Sequence @@ #]]) & /@ p,
    True,
    p = n/2;
    m = oddOrderMagicSquare[p];
    m = ArrayFlatten@{{m, m + 2*p^2}, {m + 3*p^2, m + p^2}};
    If[n != 2,
     i = Range[p];
     k = (n - 2)/4;
     j = {Range[k], Range[n - k + 2, n]};
     j = Flatten@DeleteCases[j, {}];
     m[[Join[i, i + p], j]] = m[[Join[i + p, i], j]]
     ]
    ];
   m
   ];
oddOrderMagicSquare[n_] := Module[{p},
   p = Range[n];
   Transpose[n*Mod[Map[p + # &, p - (n + 3)/2], n] + 
      Mod[Map[p + # &, 2*p - 2], n] + 1]
   ];
$\endgroup$
3
  • $\begingroup$ Put some conditions on n == 2. No magic square of order 2. $\endgroup$
    – Hans
    Feb 3, 2015 at 16:21
  • $\begingroup$ @Hans thanks. I changed the signature to check for n!=2 $\endgroup$
    – Nasser
    Feb 3, 2015 at 17:52
  • $\begingroup$ Thank you very much. The output is also beautiful. $\endgroup$
    – Nick
    Feb 6, 2015 at 12:41
22
$\begingroup$

@Nasser's answer is nice, but slowly when Mod[n,4]==0. Here is a faster code, efficiency is close to Matlab :

ClearAll[magic]
magic[n_?OddQ] := oddOrderMagicSquare[n];

magic[n_ /; n~Mod~4 == 0] :=
  Module[{J, K1, M},
    J = Floor[(Range[n]~Mod~4)/2.0];
    K1 = Abs@Outer[Plus, J, -J]~BitXor~1;
    M = Outer[Plus, Range[1, n^2, n], Range[0, n - 1]];
    M + K1 (n*n + 1 - 2 M)
    ] // Experimental`CompileEvaluate;

magic[n_?EvenQ] :=
  Module[{p, M, i, j, k},
   p = n/2;(*p is odd*)
   M = oddOrderMagicSquare[p];
   M = ArrayFlatten@{{M, M + 2 p^2}, {M + 3 p^2, M + p^2}};
   If[n == 2, Return[M]];
   i = Transpose@{Range@p};
   k = (n - 2)/4;
   j = Range[k]~Join~Range[n - k + 2, n];
   M[[Flatten@{i, i + p}, j]] = M[[Flatten@{i + p, i}, j]];
   i = k + 1;
   j = {1, i};
   M[[Flatten@{i, i + p}, j]] = M[[Flatten@{i + p, i}, j]];
   M
   ];

oddOrderMagicSquare[n_?OddQ] :=
  Module[{p},
   p = Range[n];
   Outer[Plus, p, p - (n + 3)/2]~Mod~n*n + 
    Outer[Plus, p, 2 p - 2]~Mod~n + 1
   ];

magic[3000]; // AbsoluteTiming
magic[3001]; // AbsoluteTiming
magic[3002]; // AbsoluteTiming
$\endgroup$
4
  • $\begingroup$ good you tried to speed it up. I translated Matlab code line by line, did not try to make any changes since I wanted first to get it working correctly. But speeding it up is interesting exercise on its own. $\endgroup$
    – Nasser
    Feb 3, 2015 at 11:11
  • $\begingroup$ Thank you very much. It's really hard for me as a beginner to decide whose answer is the right one. Since @Nasser is the original answer, I marked his right answer. I'm sorry, I can only vote up for yours. $\endgroup$
    – Nick
    Feb 6, 2015 at 12:45
  • 1
    $\begingroup$ @Nick Don't worry about that. $\endgroup$
    – chyanog
    Feb 7, 2015 at 1:34
  • $\begingroup$ @chyaong, Could you give some explanation(or your algorithm ) to help me to understand your high efficiency implementation when $n$ is doubly-even? thanks a lot:) $\endgroup$
    – xyz
    May 6, 2015 at 8:34

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.