Magic squares of doubly even order

From Rosetta Code
Revision as of 23:02, 1 March 2017 by PatGarrett (talk | contribs) (→‎{{header|VBScript}}: Section added)
Task
Magic squares of doubly even order
You are encouraged to solve this task according to the task description, using any language you may know.

A magic square is an NxN square matrix whose numbers consist of consecutive numbers arranged so that the sum of each row and column, and both diagonals are equal to the same sum (which is called the magic number or magic constant).

A magic square of doubly even order has a size that is a multiple of four (e.g. 4, 8, 12). This means that the subsquares also have an even size, which plays a role in the construction.

1 2 62 61 60 59 7 8
9 10 54 53 52 51 15 16
48 47 19 20 21 22 42 41
40 39 27 28 29 30 34 33
32 31 35 36 37 38 26 25
24 23 43 44 45 46 18 17
49 50 14 13 12 11 55 56
57 58 6 5 4 3 63 64


Task

Create a magic square of 8 x 8.

Related tasks
See also



360 Assembly

Translation of: Java

<lang 360asm>* Magic squares of doubly even order 01/03/2017 MAGICSDB CSECT

        USING  MAGICSDB,R13
        B      72(R15)            skip save area
        DC     17F'0'             save area
        STM    R14,R12,12(R13)
        ST     R13,4(R15)
        ST     R15,8(R13)
        LR     R13,R15            end of prolog
        SR     R8,R8              k=0
        LA     R6,0               i=0
      DO WHILE=(C,R6,LE,=A(N-1))  do i=0 to n-1
        MVC    PG,=CL80' '          clear buffer
        LA     R9,PG                pgi=0
        LA     R7,0                 j=0
      DO WHILE=(C,R7,LE,=A(N-1))    do j=0 to n-1
        LR     R4,R7                  j
        SRDA   R4,32                  >>r5
        D      R4,MULT                /mult
        LR     R2,R5                  r2=j/mult
        LR     R4,R6                  i
        SRDA   R4,32                  >>r5
        D      R4,MULT                /mult
        SLA    R5,2                   r5=(i/mult)*4
        AR     R2,R5                  bitpos=j/mult+(i/mult)*4
        STC    R2,XSLL+3              number_of_shift=bitpos
        L      R5,=F'1'               1
        EX     0,XSLL                 r5=1<<bitpos  (SLL R5,bitpos)
        L      R4,BITS                bits
        NR     R4,R5                  bits and (1<<bitpos)
      IF LTR,R4,NZ,R4 THEN            if (bits and (1<<bitpos))<>0
        LA     R10,1(R8)                x=k+1
      ELSE     ,                      else
        L      R10,SIZE                 size
        SR     R10,R8                   x=size-k
      ENDIF    ,                      endif
        XDECO  R10,XDEC               edit x
        MVC    0(4,R9),XDEC+8         output x
        LA     R9,4(R9)               pgi+=4
        LA     R8,1(R8)               k++
        LA     R7,1(R7)               j++
      ENDDO    ,                    enddo j
        XPRNT  PG,L'PG              print buffer
        LA     R6,1(R6)             i++
      ENDDO    ,                  enddo i
        MVC    PG,=CL80'magic constant='
        L      R1,=A((N*N+1)*N/2) magicnum=(n*n+1)*n/2
        XDECO  R1,XDEC            edit magicnum
        MVC    PG+15(4),XDEC+8    output magicnum
        XPRNT  PG,L'PG            print buffer
        L      R13,4(0,R13)       epilog
        LM     R14,R12,12(R13)
        XR     R15,R15            rc=0
        BR     R14                exit

XSLL SLL R5,0 shift left logical N EQU 8 <= input value n SIZE DC A(N*N) size=n*n MULT DC A(N/4) mult=n/4 (multiple of 4) BITS DC XL2'0000',BL2'1001011001101001' pattern PG DS CL80 buffer XDEC DS CL12 temp for xdeco

        YREGS
        END    MAGICSDB</lang>
Output:
   1   2  62  61  60  59   7   8
   9  10  54  53  52  51  15  16
  48  47  19  20  21  22  42  41
  40  39  27  28  29  30  34  33
  32  31  35  36  37  38  26  25
  24  23  43  44  45  46  18  17
  49  50  14  13  12  11  55  56
  57  58   6   5   4   3  63  64
magic constant= 260

AppleScript

Translation of: JavaScript

<lang AppleScript>-- magicSquare :: Int -> Int on magicSquare(n)

   if n mod 4 > 0 then
       {}
   else
       set sqr to n * n
       
       set maybePowerOfTwo to asPowerOfTwo(sqr)
       if maybePowerOfTwo is not missing value then
           
           -- For powers of 2, the (append not) 'magic' series directly
           -- yields the truth table that we need
           set truthSeries to magicSeries(maybePowerOfTwo)
       else
           -- where n is not a power of 2, we can replicate a
           -- minimum truth table, horizontally and vertically
           
           script scale
               on lambda(x)
                   replicate(n / 4, x)
               end lambda
           end script
           
           set truthSeries to ¬
               flatten(scale's lambda(map(scale, splitEvery(4, magicSeries(4)))))
       end if
       
       set limit to sqr + 1
       script inOrderOrReversed
           on lambda(x, i)
               cond(x, i, limit - i)
           end lambda
       end script
       
       -- Taken directly from an integer series  [1..sqr] where True
       -- and from the reverse of that series where False
       splitEvery(n, map(inOrderOrReversed, truthSeries))
   end if

end magicSquare


-- magicSeries :: Int -> [Bool] on magicSeries(n)

   script boolToggle
       on lambda(x)
           not x
       end lambda
   end script
   
   if n ≤ 0 then
       {true}
   else
       set xs to magicSeries(n - 1)
       xs & map(boolToggle, xs)
   end if

end magicSeries


-- TEST --------------------------------------------------------------------------- on run

   formattedTable(magicSquare(8))
   

end run

-- formattedTable :: Int -> String on formattedTable(lstTable)

   set n to length of lstTable
   set w to 2.5 * n
   "magic(" & n & ")" & linefeed & wikiTable(lstTable, ¬
       false, "text-align:center;width:" & ¬
       w & "em;height:" & w & "em;table-layout:fixed;")

end formattedTable

-- wikiTable :: [Text] -> Bool -> Text -> Text on wikiTable(lstRows, blnHdr, strStyle)

   script fWikiRows
       on lambda(lstRow, iRow)
           set strDelim to cond(blnHdr and (iRow = 0), "!", "|")
           set strDbl to strDelim & strDelim
           linefeed & "|-" & linefeed & strDelim & space & ¬
               intercalate(space & strDbl & space, lstRow)
       end lambda
   end script
   
   linefeed & "{| class=\"wikitable\" " & ¬
       cond(strStyle ≠ "", "style=\"" & strStyle & "\"", "") & ¬
       intercalate("", ¬
           map(fWikiRows, lstRows)) & linefeed & "|}" & linefeed

end wikiTable


-- GENERIC FUNCTIONS ---------------------------------------------------------------------------

-- splitEvery :: Int -> [a] -> a on splitEvery(n, xs)

   if length of xs ≤ n then
       {xs}
   else
       set {gp, t} to splitAt(n, xs)
       {gp} & splitEvery(n, t)
   end if

end splitEvery

-- isPowerOf :: Int -> Int -> Bool on isPowerOf(k, n)

   set v to k
   script remLeft
       on lambda(x)
           x mod v is not 0
       end lambda
   end script
   
   script integerDiv
       on lambda(x)
           x div v
       end lambda
   end script
   
   |until|(remLeft, integerDiv, n) = 1

end isPowerOf

-- asPowerOfTwo :: Int -> maybe Int on asPowerOfTwo(n)

   if not isPowerOf(2, n) then
       missing value
   else
       set strCMD to ("echo 'l(" & n as string) & ")/l(2)' | bc -l"
       (do shell script strCMD) as integer
   end if

end asPowerOfTwo

-- map :: (a -> b) -> [a] -> [b] on map(f, xs)

   tell mReturn(f)
       set lng to length of xs
       set lst to {}
       repeat with i from 1 to lng
           set end of lst to lambda(item i of xs, i, xs)
       end repeat
       return lst
   end tell

end map

-- cond :: Bool -> a -> a -> a on cond(bool, f, g)

   if bool then
       f
   else
       g
   end if

end cond

-- flatten :: Tree a -> [a] on flatten(t)

   if class of t is list then
       concatMap(my flatten, t)
   else
       t
   end if

end flatten

-- concatMap :: (a -> [b]) -> [a] -> [b] on concatMap(f, xs)

   script append
       on lambda(a, b)
           a & b
       end lambda
   end script
   
   foldl(append, {}, map(f, xs))

end concatMap

-- foldl :: (a -> b -> a) -> a -> [b] -> a on foldl(f, startValue, xs)

   tell mReturn(f)
       set v to startValue
       set lng to length of xs
       repeat with i from 1 to lng
           set v to lambda(v, item i of xs, i, xs)
       end repeat
       return v
   end tell

end foldl

-- until :: (a -> Bool) -> (a -> a) -> a -> a on |until|(p, f, x)

   set mp to mReturn(p)
   set v to x
   
   tell mReturn(f)
       repeat until mp's lambda(v)
           set v to lambda(v)
       end repeat
   end tell
   return v

end |until|

-- Lift 2nd class handler function into 1st class script wrapper -- mReturn :: Handler -> Script on mReturn(f)

   if class of f is script then
       f
   else
       script
           property lambda : f
       end script
   end if

end mReturn

-- Egyptian multiplication - progressively doubling a list, appending -- stages of doubling to an accumulator where needed for binary -- assembly of a target length

-- replicate :: Int -> a -> [a] on replicate(n, a)

   set out to {}
   if n < 1 then return out
   set dbl to {a}
   
   repeat while (n > 1)
       if (n mod 2) > 0 then set out to out & dbl
       set n to (n div 2)
       set dbl to (dbl & dbl)
   end repeat
   return out & dbl

end replicate

-- splitAt :: Int -> [a] -> ([a],[a]) on splitAt(n, xs)

   if n > 0 and n < length of xs then
       if class of xs is text then
           {items 1 thru n of xs as text, items (n + 1) thru -1 of xs as text}
       else
           {items 1 thru n of xs, items (n + 1) thru -1 of xs}
       end if
   else
       if n < 1 then
           {{}, xs}
       else
           {xs, {}}
       end if
   end if

end splitAt

-- intercalate :: Text -> [Text] -> Text on intercalate(strText, lstText)

   set {dlm, my text item delimiters} to {my text item delimiters, strText}
   set strJoined to lstText as text
   set my text item delimiters to dlm
   return strJoined

end intercalate</lang>

Output:

magic(8)

1 63 62 4 60 6 7 57
56 10 11 53 13 51 50 16
48 18 19 45 21 43 42 24
25 39 38 28 36 30 31 33
32 34 35 29 37 27 26 40
41 23 22 44 20 46 47 17
49 15 14 52 12 54 55 9
8 58 59 5 61 3 2 64

C++

<lang cpp>#include <iostream>

  1. include <sstream>
  2. include <iomanip>

using namespace std;

class magicSqr { public:

   magicSqr( int d ) {
       while( d % 4 > 0 ) { d++; }
       sz = d;
       sqr = new int[sz * sz];
       fillSqr();
   }
   ~magicSqr() { delete [] sqr; }
   void display() const {
       cout << "Doubly Even Magic Square: " << sz << " x " << sz << "\n";
       cout << "It's Magic Sum is: " << magicNumber() << "\n\n";
       ostringstream cvr; cvr << sz * sz;
       int l = cvr.str().size();

       for( int y = 0; y < sz; y++ ) {
           int yy = y * sz;
           for( int x = 0; x < sz; x++ ) {
               cout << setw( l + 2 ) << sqr[yy + x];
           }
           cout << "\n";
       }
       cout << "\n\n";
   }

private:

   void fillSqr() {
       static const bool tempAll[4][4] = {{ 1, 0, 0, 1 }, { 0, 1, 1, 0 }, { 0, 1, 1, 0 }, { 1, 0, 0, 1 } };
       int i = 0;
       for( int curRow = 0; curRow < sz; curRow++ ) {
           for( int curCol = 0; curCol < sz; curCol++ ) {
               sqr[curCol + sz * curRow] = tempAll[curRow % 4][curCol % 4] ? i + 1 : sz * sz - i;
               i++;
           }
       }
   }
   int magicNumber() const { return sz * ( ( sz * sz ) + 1 ) / 2; }

   int* sqr;
   int sz;

};

int main( int argc, char* argv[] ) {

   magicSqr s( 8 );
   s.display();
   return 0;

}</lang>

Output:
Doubly Even Magic Square: 8 x 8
It's Magic Sum is: 260

   1  63  62   4   5  59  58   8
  56  10  11  53  52  14  15  49
  48  18  19  45  44  22  23  41
  25  39  38  28  29  35  34  32
  33  31  30  36  37  27  26  40
  24  42  43  21  20  46  47  17
  16  50  51  13  12  54  55   9
  57   7   6  60  61   3   2  64

Elixir

<lang elixir>defmodule Magic_square do

 def doubly_even(n) when rem(n,4)!=0, do: raise ArgumentError, "must be even, but not divisible by 4."
 def doubly_even(n) do
   n2 = n * n
   Enum.zip(1..n2, make_pattern(n))
   |> Enum.map(fn {i,p} -> if p, do: i, else: n2 - i + 1 end)
   |> Enum.chunk(n)
   |> to_string(n)
   |> IO.puts
 end
 
 defp make_pattern(n) do
   pattern = Enum.reduce(1..4, [true], fn _,acc ->
               acc ++ Enum.map(acc, &(!&1))
             end) |> Enum.chunk(4)
   for i <- 0..n-1, j <- 0..n-1, do: Enum.at(pattern, rem(i,4)) |> Enum.at(rem(j,4))
 end

 defp to_string(square, n) do
   format = String.duplicate("~#{length(to_char_list(n*n))}w ", n) <> "\n"
   Enum.map_join(square, fn row ->
     :io_lib.format(format, row)
   end)
 end

end

Magic_square.doubly_even(8)</lang>

Output:
 1 63 62  4  5 59 58  8
56 10 11 53 52 14 15 49
48 18 19 45 44 22 23 41
25 39 38 28 29 35 34 32
33 31 30 36 37 27 26 40
24 42 43 21 20 46 47 17
16 50 51 13 12 54 55  9
57  7  6 60 61  3  2 64

FreeBASIC

<lang freebasic>' version 18-03-2016 ' compile with: fbc -s console ' doubly even magic square 4, 8, 12, 16...

Sub Err_msg(msg As String)

   Print msg
   Beep : Sleep 5000, 1 : Exit Sub

End Sub

Sub de_magicsq(n As UInteger, filename As String = "")

   ' filename <> "" then save square in a file
   ' filename can contain directory name
   ' if filename exist it will be overwriten, no error checking
   If n < 4 Then
       Err_msg( "Error: n is to small")
       Exit Sub
   End If
   If (n Mod 4) <> 0 Then
       Err_msg "Error: not possible to make doubly" + _
       " even magic square size " + Str(n)
       Exit Sub
   End If
   Dim As UInteger sq(1 To n, 1 To n)
   Dim As UInteger magic_sum = n * (n ^ 2 +1) \ 2
   Dim As UInteger q = n \ 4
   Dim As UInteger x, y, nr = 1
   Dim As String frmt = String(Len(Str(n * n)) +1, "#")
   ' set up the square
   For y = 1 To n
       For x = q +1 To n - q
           sq(x,y) = 1
       Next
   Next
   For x = 1 To n
       For y = q +1 To n - q
           sq(x, y) Xor= 1
       Next
   Next
   ' fill the square
   q = n * n +1
   For y = 1 To n
       For x = 1 To n
           If sq(x,y) = 0 Then
               sq(x,y) = q - nr
           Else
               sq(x,y) = nr
           End If
           nr += 1
       Next
   Next
   ' check columms and rows
   For y = 1 To n
       nr = 0 : q = 0
       For x = 1 To n
           nr += sq(x,y)
           q += sq(y,x)
       Next
       If nr <> magic_sum Or q <> magic_sum Then
           Err_msg "Error: value <> magic_sum"
           Exit Sub
       End If
   Next
   ' check diagonals
   nr = 0 : q = 0
   For x = 1 To n
       nr += sq(x, x)
       q += sq(n - x +1, n - x +1)
   Next
   If nr <> magic_sum Or q <> magic_sum Then
       Err_msg "Error: value <> magic_sum"
       Exit Sub
   End If
   ' printing square's on screen bigger when
   ' n > 19 results in a wrapping of the line
   Print "Single even magic square size: "; n; "*"; n
   Print "The magic sum = "; magic_sum
   Print
   For y = 1 To n
       For x = 1 To n
           Print Using frmt; sq(x, y);
       Next
       Print
   Next
   ' output magic square to a file with the name provided
   If filename <> "" Then
       nr = FreeFile
       Open filename For Output As #nr
       Print #nr, "Single even magic square size: "; n; "*"; n
       Print #nr, "The magic sum = "; magic_sum
       Print #nr,
       For y = 1 To n
           For x = 1 To n
               Print #nr, Using frmt; sq(x,y);
           Next
           Print #nr,
       Next
       Close #nr
   End If

End Sub

' ------=< MAIN >=------

de_magicsq(8, "magic8de.txt") : Print

' empty keyboard buffer While Inkey <> "" : Wend Print : Print "hit any key to end program" Sleep End</lang>

Output:
Single even magic square size: 8*8
The magic sum = 260

 64 63  3  4  5  6 58 57
 56 55 11 12 13 14 50 49
 17 18 46 45 44 43 23 24
 25 26 38 37 36 35 31 32
 33 34 30 29 28 27 39 40
 41 42 22 21 20 19 47 48
 16 15 51 52 53 54 10  9
  8  7 59 60 61 62  2  1

Haskell

<lang Haskell>import Data.List (transpose, unfoldr)

magicSquare :: Int -> Int magicSquare n

 | rem n 4 > 0 = []
 | otherwise =
   splitEvery n $
   -- Taken directly from the integer series where True
   -- and from the reverse of that series where False
   zipWith
     (\x i ->
         if x
           then i
           else limit - i)
     series
     [1 .. sqr]
 where
   sqr = n * n
   limit = sqr + 1
   series
   -- For integer powers of 2, the (append not) 'magic' series directly
   -- yields the truth table that we need
     | isPowerOf 2 n = magicSeries $ floor (logBase 2 (fromIntegral sqr))
     -- where n is not an integer power of 2, we can replicate a
     -- minimum truth table, horizontally and vertically
     | otherwise =
       concat . concat . concat . scale $
       scale <$> splitEvery 4 (magicSeries 4)
     where
       scale = replicate $ quot n 4

magicSeries :: Int -> [Bool] magicSeries = (iterate (\xs -> xs ++ (not <$> xs)) [True] !!)

splitEvery :: Int -> [a] -> a splitEvery n = takeWhile (not . null) . unfoldr (Just . splitAt n)

isPowerOf :: Int -> Int -> Bool isPowerOf k n = until (\x -> rem x k /= 0) (`quot` k) n == 1

main :: IO () main = mapM_ print $ magicSquare 8

-- Summed and checked--------------------------------------------------- checked :: Int -> (Int, Bool) checked n = (h, all (h ==) t)

 where
   square = magicSquare n
   h:t =
     sum <$>
     square ++ -- rows
     transpose square ++ -- cols
     diagonals square -- diagonals

diagonals :: Int -> Int diagonals xs = flip (zipWith (!!)) [0 ..] <$> [xs, reverse xs]

main2 :: IO () main2 = print $ checked 8</lang>

Output:
main
[1,63,62,4,5,59,58,8]
[56,10,11,53,52,14,15,49]
[48,18,19,45,44,22,23,41]
[25,39,38,28,29,35,34,32]
[33,31,30,36,37,27,26,40]
[24,42,43,21,20,46,47,17]
[16,50,51,13,12,54,55,9]
[57,7,6,60,61,3,2,64]

main2
(260,True)

Java

<lang java>public class MagicSquareDoublyEven {

   public static void main(String[] args) {
       int n = 8;
       for (int[] row : magicSquareDoublyEven(n)) {
           for (int x : row)
               System.out.printf("%2s ", x);
           System.out.println();
       }
       System.out.printf("\nMagic constant: %d ", (n * n + 1) * n / 2);
   }
   static int[][] magicSquareDoublyEven(final int n) {
       if (n < 4 || n % 4 != 0)
           throw new IllegalArgumentException("base must be a positive "
                   + "multiple of 4");
       // pattern of count-up vs count-down zones
       int bits = 0b1001_0110_0110_1001;
       int size = n * n;
       int mult = n / 4;  // how many multiples of 4
       int[][] result = new int[n][n];
       for (int r = 0, i = 0; r < n; r++) {
           for (int c = 0; c < n; c++, i++) {
               int bitPos = c / mult + (r / mult) * 4;
               result[r][c] = (bits & (1 << bitPos)) != 0 ? i + 1 : size - i;
           }
       }
       return result;
   }

}</lang>

 1  2 62 61 60 59  7  8 
 9 10 54 53 52 51 15 16 
48 47 19 20 21 22 42 41 
40 39 27 28 29 30 34 33 
32 31 35 36 37 38 26 25 
24 23 43 44 45 46 18 17 
49 50 14 13 12 11 55 56 
57 58  6  5  4  3 63 64 

Magic constant: 260


JavaScript

ES6

Translation of: Haskell

<lang JavaScript>(() => {

   'use strict';
   // doubleEvenMagicSquare :: Int -> Int
   const doubleEvenMagicSquare = n => {
       if (n % 4 > 0) return undefined;
       // truthSeries :: Int -> [Int]
       const truthSeries = n => {
           if (n <= 0) return [true];
           const xs = truthSeries(n - 1);
           return xs.concat(xs.map(x => !x));
       };
       const sqr = n * n,
           scale = curry(replicate)(n / 4),
           power = Math.log2(sqr),
           sequence = isInt(power) ? truthSeries(power) : (
               flatten(
                   scale(
                       splitEvery(4, truthSeries(4))
                       .map(scale)
                   )
               )
           );
       return splitEvery(n, sequence
           .map((x, i) => x ? i + 1 : sqr - i));
   };


   // GENERIC FUNCTIONS ----------------------------------------------------
   // flatten :: Tree a -> [a]
   const flatten = t => (t instanceof Array ? concatMap(flatten, t) : [t]);
   // concatMap :: (a -> [b]) -> [a] -> [b]
   const concatMap = (f, xs) => [].concat.apply([], xs.map(f));
   // splitEvery :: Int -> [a] -> [][a]]
   const splitEvery = (n, xs) => {
       if (xs.length <= n) return [xs];
       const [h, t] = [xs.slice(0, n), xs.slice(n)];
       return [h].concat(splitEvery(n, t));
   }
   // curry :: ((a, b) -> c) -> a -> b -> c
   const curry = f => a => b => f(a, b);
   // replicate :: Int -> a -> [a]
   const replicate = (n, a) => {
       let v = [a],
           o = [];
       if (n < 1) return o;
       while (n > 1) {
           if (n & 1) o = o.concat(v);
           n >>= 1;
           v = v.concat(v);
       }
       return o.concat(v);
   };
   // isInt :: Int -> Bool
   const isInt = x => x === Math.floor(x);


   // TEST AND DISPLAY FUNCTIONS -------------------------------------------
   // transpose :: a -> a
   const transpose = xs =>
       xs[0].map((_, iCol) => xs.map((row) => row[iCol]));
   // diagonals :: a -> ([a], [a])
   const diagonals = xs => {
       const nRows = xs.length,
           nCols = (nRows > 0 ? xs[0].length : 0);
       const cell = (x, y) => xs[y][x];
       if (nRows === nCols) {
           const ns = range(0, nCols - 1);
           return [zipWith(cell, ns, ns), zipWith(cell, ns, reverse(ns))];
       } else return [
           [],
           []
       ];
   };
   // zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
   const zipWith = (f, xs, ys) => {
       const ny = ys.length;
       return (xs.length <= ny ? xs : xs.slice(0, ny))
           .map((x, i) => f(x, ys[i]));
   }
   // reverse :: [a] -> [a]
   const reverse = (xs) => xs.slice(0)
       .reverse()
   // range :: Int -> Int -> [Int]
   const range = (m, n) =>
       Array.from({
           length: Math.floor(n - m) + 1
       }, (_, i) => m + i);
   // all :: (a -> Bool) -> [a] -> Bool
   const all = (f, xs) => xs.every(f);
   // show :: a -> String
   const show = x => JSON.stringify(x);
   // justifyRight :: Int -> Char -> Text -> Text
   const justifyRight = (n, cFiller, strText) =>
       n > strText.length ? (
           (cFiller.repeat(n) + strText)
           .slice(-n)
       ) : strText;
   // TEST -----------------------------------------------------------------
   //return doubleEvenMagicSquare(8)
   return [4, 8, 12]
       .map(n => {
           const lines = doubleEvenMagicSquare(n);
           const sums = lines.concat(
                   transpose(lines)
                   .concat(diagonals(lines))
               )
               .map(xs => xs.reduce((a, b) => a + b, 0));
           const sum = sums[0];
           return [
               "Order: " + n.toString(),
               "Summing to: " + sum.toString(),
               "Row, column and diagonal sums checked: " +
               all(x => x === sum, sums)
               .toString() + '\n',
               lines.map(
                   xs => xs.map(
                       x => justifyRight(3, ' ', x.toString())
                   )
                   .join('  '))
               .join('\n')
           ].join('\n')
       })
       .join('\n\n');

})();</lang>

Output:
Order: 4
Summing to: 34
Row, column and diagonal sums checked: true

  1   15   14    4
 12    6    7    9
  8   10   11    5
 13    3    2   16

Order: 8
Summing to: 260
Row, column and diagonal sums checked: true

  1   63   62    4   60    6    7   57
 56   10   11   53   13   51   50   16
 48   18   19   45   21   43   42   24
 25   39   38   28   36   30   31   33
 32   34   35   29   37   27   26   40
 41   23   22   44   20   46   47   17
 49   15   14   52   12   54   55    9
  8   58   59    5   61    3    2   64

Order: 12
Summing to: 870
Row, column and diagonal sums checked: true

  1  143  142    4    5  139  138    8    9  135  134   12
132   14   15  129  128   18   19  125  124   22   23  121
120   26   27  117  116   30   31  113  112   34   35  109
 37  107  106   40   41  103  102   44   45   99   98   48
 49   95   94   52   53   91   90   56   57   87   86   60
 84   62   63   81   80   66   67   77   76   70   71   73
 72   74   75   69   68   78   79   65   64   82   83   61
 85   59   58   88   89   55   54   92   93   51   50   96
 97   47   46  100  101   43   42  104  105   39   38  108
 36  110  111   33   32  114  115   29   28  118  119   25
 24  122  123   21   20  126  127   17   16  130  131   13
133   11   10  136  137    7    6  140  141    3    2  144

Kotlin

Translation of: Java

<lang scala>// version 1.0.6

fun magicSquareDoublyEven(n: Int): Array<IntArray> {

   if ( n < 4 || n % 4 != 0) 
       throw IllegalArgumentException("Base must be a positive multiple of 4")
   // pattern of count-up vs count-down zones
   val bits = 0b1001011001101001
   val size = n * n
   val mult = n / 4  // how many multiples of 4 
   val result = Array(n) { IntArray(n) }
   var i = 0
   for (r in 0 until n)
       for (c in 0 until n) {
           val bitPos = c / mult + r / mult * 4
           result[r][c] =  if (bits and (1 shl bitPos) != 0) i + 1 else size - i
           i++
       }
   return result

}

fun main(args: Array<String>) {

   val n = 8
   for (ia in magicSquareDoublyEven(n)) { 
       for (i in ia) print("%2d  ".format(i))
       println()
   }
   println("\nMagic constant ${(n * n + 1) * n / 2}")

}</lang>

Output:
 1   2  62  61  60  59   7   8
 9  10  54  53  52  51  15  16
48  47  19  20  21  22  42  41
40  39  27  28  29  30  34  33
32  31  35  36  37  38  26  25
24  23  43  44  45  46  18  17
49  50  14  13  12  11  55  56
57  58   6   5   4   3  63  64

Magic constant 260

PARI/GP

A magic one-liner: <lang parigp>magicsquare(n)=matrix(n,n,i,j,k=i+j*n-n;if(bitand(38505,2^((j-1)%4*4+(i-1)%4)),k,n*n+1-k))</lang>

Output:

magicsquare(8)

[ 1 56 48 25 33 24 16 57]

[63 10 18 39 31 42 50  7]

[62 11 19 38 30 43 51  6]

[ 4 53 45 28 36 21 13 60]

[ 5 52 44 29 37 20 12 61]

[59 14 22 35 27 46 54  3]

[58 15 23 34 26 47 55  2]

[ 8 49 41 32 40 17  9 64]

BTW: The bit field number 38505 = 9669h seems to come from hell to do the magic...

Perl 6

See Magic squares/Perl 6 for a general magic square generator.

Output:

With a parameter of 8:

 1  2 62 61 60 59  7  8
 9 10 54 53 52 51 15 16
48 47 19 20 21 22 42 41
40 39 27 28 29 30 34 33
32 31 35 36 37 38 26 25
24 23 43 44 45 46 18 17
49 50 14 13 12 11 55 56
57 58  6  5  4  3 63 64

The magic number is 260

With a parameter of 12:

  1   2   3 141 140 139 138 137 136  10  11  12
 13  14  15 129 128 127 126 125 124  22  23  24
 25  26  27 117 116 115 114 113 112  34  35  36
108 107 106  40  41  42  43  44  45  99  98  97
 96  95  94  52  53  54  55  56  57  87  86  85
 84  83  82  64  65  66  67  68  69  75  74  73
 72  71  70  76  77  78  79  80  81  63  62  61
 60  59  58  88  89  90  91  92  93  51  50  49
 48  47  46 100 101 102 103 104 105  39  38  37
109 110 111  33  32  31  30  29  28 118 119 120
121 122 123  21  20  19  18  17  16 130 131 132
133 134 135   9   8   7   6   5   4 142 143 144

The magic number is 870

PureBasic

Translation of: FreeBasic

<lang PureBasic>Procedure.i MagicN(n.i)

 ProcedureReturn n*(n*n+1)/2

EndProcedure

Procedure.i MaxN(mx.i,n.i)

 If mx>n : ProcedureReturn mx : Else : ProcedureReturn n : EndIf

EndProcedure

Procedure.i MaxL(mx.i)

 Define.i i
 While mx
   mx/10 : i+1
 Wend
 ProcedureReturn i

EndProcedure

Procedure.b DblEvenMagicSquare(n.i)

 Define.i q=n/4, nr=1, x, y, max, spc
 Dim sq.i(n,n)
 
 For y=1 To n
   For x=q+1 To n-q
     sq(x,y)=1
   Next
 Next
 
 For x=1 To n
   For y=q+1 To n-q
     sq(x,y) ! 1
   Next
 Next
 
 q=n*n+1
 For y=1 To n
   For x=1 To n
     If sq(x,y)=0
       sq(x,y)=q-nr
     Else
       sq(x,y)=nr
     EndIf
     nr+1
     max=MaxN(max,sq(x,y))
   Next
 Next
 
 spc=MaxL(max)+1
 For y=n To 1 Step -1
   For x=n To 1 Step -1
     Print(RSet(Str(sq(x,y)),spc," "))
   Next
   PrintN("")
 Next
   

EndProcedure

OpenConsole("Magic-Square-Doubly-Even") Define.i n

Repeat

 PrintN("Input [4,8,12..n] (0=Exit)")
 While (n<4) Or (n%4)
   Print(">") : n=Val(Input())
   If n=0 : End : EndIf
 Wend  
 PrintN("The magic sum = "+Str(MagicN(n)))
 DblEvenMagicSquare(n)  
 n=0

ForEver</lang>

Output:
Input [4,8,12..n] (0=Exit)

>8 The magic sum = 260

 1  2 62 61 60 59  7  8
 9 10 54 53 52 51 15 16
48 47 19 20 21 22 42 41
40 39 27 28 29 30 34 33
32 31 35 36 37 38 26 25
24 23 43 44 45 46 18 17
49 50 14 13 12 11 55 56
57 58  6  5  4  3 63 64

Input [4,8,12..n] (0=Exit)

>

REXX

"Marked" numbers   (via the   diag   subroutine)   indicate that those (sequentially generated) numbers don't get
swapped   (and thusly, stay in place in the magic square). <lang rexx>/*REXX program constructs a magic square of doubly even sides (a size divisible by 4).*/ n=8; s=n%4; L=n%2-s+1; w=length(n**2) /*size; small sq; low middle; # width*/ @.=0; H=n%2+s /*array default; high middle. */ call gen /*generate a grid in numerical order. */ call diag /*mark numbers on both diagonals. */ call corn /* " " in small corner boxen. */ call midd /* " " in the middle " */ call swap /*swap positive numbers with highest #.*/ call show /*display the doubly even magic square.*/ call sum /* " " magic number for square. */ exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ o: parse arg ?; return n-?+1 /*calculate the "other" (right) column.*/ @: parse arg x,y; return abs(@.x.y) diag: do r=1 for n; @.r.r=-@(r,r); o=o(r); @.r.o=-@(r,o); end; return midd: do r=L to H; do c=L to H; @.r.c=-@(r,c); end; end; return gen: #=0; do r=1 for n; do c=1 for n; #=#+1; @.r.c=#; end; end; return show: #=0; do r=1 for n; $=; do c=1 for n; $=$ right(@(r,c),w); end; say $; end; return sum: #=0; do r=1 for n; #=#+@(r,1); end; say; say 'The magic number is: ' #; return max#: do a=n for n by -1; do b=n for n by -1; if @.a.b>0 then return; end; end /*──────────────────────────────────────────────────────────────────────────────────────*/ swap: do r=1 for n

               do c=1  for n;  if @.r.c<0  then iterate;  call max#  /*find max number.*/
               parse value  -@.a.b  (-@.r.c)    with    @.r.c  @.a.b /*swap two values.*/
               end  /*c*/
             end    /*r*/
     return

/*──────────────────────────────────────────────────────────────────────────────────────*/ corn: do r=1 for n; if r>s & r<=n-s then iterate /*"corner boxen", size≡S*/

               do c=1  for n;  if c>s & c<=n-s  then iterate;  @.r.c=-@(r,c);  end  /*c*/
             end   /*r*/
     return</lang>

output   when using the default input:

  1  2 62 61 60 59  7  8
  9 10 54 53 52 51 15 16
 48 47 19 20 21 22 42 41
 40 39 27 28 29 30 34 33
 32 31 35 36 37 38 26 25
 24 23 43 44 45 46 18 17
 49 50 14 13 12 11 55 56
 57 58  6  5  4  3 63 64

The magic number is:  260

Ruby

<lang ruby>def double_even_magic_square(n)

 raise ArgumentError, "Need multiple of four" if n%4 > 0
 block_size, max = n/4, n*n
 pre_pat = [true, false, false, true,
            false, true, true, false]
 pre_pat += pre_pat.reverse
 pattern = pre_pat.flat_map{|b| [b] * block_size} * block_size
 flat_ar = pattern.each_with_index.map{|yes, num| yes ? num+1 : max-num}
 flat_ar.each_slice(n).to_a

end

def to_string(square)

 n = square.size
 fmt = "%#{(n*n).to_s.size + 1}d" * n
 square.inject(""){|str,row| str << fmt % row << "\n"}

end

puts to_string(double_even_magic_square(8))</lang>

Output:
  1  2 62 61 60 59  7  8
 56 55 11 12 13 14 50 49
 48 47 19 20 21 22 42 41
 25 26 38 37 36 35 31 32
 33 34 30 29 28 27 39 40
 24 23 43 44 45 46 18 17
 16 15 51 52 53 54 10  9
 57 58  6  5  4  3 63 64

VBScript

Translation of: Java

<lang vb> ' Magic squares of doubly even order n=8 'multiple of 4 pattern="1001011001101001" size=n*n: w=len(size) mult=n\4 'how many multiples of 4 wscript.echo "Magic square : " & n & " x " & n i=0 For r=0 To n-1 line="" For c=0 To n-1 bit=Mid(pattern, c\mult+(r\mult)*4+1, 1) If bit="1" Then t=i+1 Else t=size-i line=line & Right(Space(w) & t, w) & " " i=i+1 Next 'c wscript.echo line Next 'r wscript.echo "Magic constant=" & (n*n+1)*n/2 </lang>

Output:
Magic square : 8 x 8
 1  2 62 61 60 59  7  8 
 9 10 54 53 52 51 15 16 
48 47 19 20 21 22 42 41 
40 39 27 28 29 30 34 33 
32 31 35 36 37 38 26 25 
24 23 43 44 45 46 18 17 
49 50 14 13 12 11 55 56 
57 58  6  5  4  3 63 64 
Magic constant=260


zkl

Translation of: Java

<lang zkl>class MagicSquareDoublyEven{

  fcn init(n){ var result=magicSquareDoublyEven(n) }
  fcn toString{
     sink,n:=Sink(String),result.len();  // num collumns
     fmt:="%2s ";
     foreach row in (result)
        { sink.write(row.apply('wrap(n){ fmt.fmt(n) }).concat(),"\n") }
     sink.write("\nMagic constant: %d".fmt((n*n + 1)*n/2));
     sink.close();
  }
  fcn magicSquareDoublyEven(n){
     if (n<4 or n%4!=0 or n>16)

throw(Exception.ValueError("base must be a positive multiple of 4"));

     bits,size,mult:=0b1001011001101001, n*n, n/4;
     result:=n.pump(List(),n.pump(List(),0).copy);  // array[n,n] of zero
     foreach i in (size){

bitsPos:=(i%n)/mult + (i/(n*mult)*4); value:=(bits.bitAnd((2).pow(bitsPos))) and i+1 or size-i; result[i/n][i%n]=value;

     }
     result;
  }

} MagicSquareDoublyEven(8).println();</lang>

Output:
 1  2 62 61 60 59  7  8 
 9 10 54 53 52 51 15 16 
48 47 19 20 21 22 42 41 
40 39 27 28 29 30 34 33 
32 31 35 36 37 38 26 25 
24 23 43 44 45 46 18 17 
49 50 14 13 12 11 55 56 
57 58  6  5  4  3 63 64 

Magic constant: 260