Magic squares of doubly even order: Difference between revisions
→{{header|Haskell}}: Made the test more direct |
→{{header|Haskell}}: Updated primitives and output |
||
Line 636: | Line 636: | ||
=={{header|Haskell}}== |
=={{header|Haskell}}== |
||
<lang Haskell>import Data.List (transpose, unfoldr, intercalate) |
|||
import Data.List.Split (chunksOf) |
|||
import |
import Control.Monad (forM_) |
||
magicSquare :: Int -> [[Int]] |
magicSquare :: Int -> [[Int]] |
||
Line 668: | Line 668: | ||
isPowerOf k n = until ((0 /=) . flip rem k) (`quot` k) n == 1 |
isPowerOf k n = until ((0 /=) . flip rem k) (`quot` k) n == 1 |
||
diagonals :: [[Int]] -> [[Int]] |
|||
-- TEST AND DISPLAY FUNCTIONS -------------------------------------------------- |
|||
⚫ | |||
checked :: [[Int]] -> (Int, Bool) |
checked :: [[Int]] -> (Int, Bool) |
||
checked square = |
checked square = |
||
let diagonals = |
|||
where |
|||
⚫ | |||
h:t = |
|||
h:t = |
|||
sum <$> |
|||
square ++ -- rows |
|||
transpose square ++ -- cols |
|||
diagonals square -- diagonals |
|||
in (h, all (h ==) t) |
|||
table :: String -> [[String]] -> [String] |
|||
table delim rows = |
|||
let justifyRight c n s = drop (length s) (replicate n c ++ s) |
|||
in intercalate delim <$> |
|||
transpose |
|||
((fmap =<< justifyRight ' ' . maximum . fmap length) <$> transpose rows) |
|||
main :: IO () |
main :: IO () |
||
main = |
main = |
||
forM_ [4, 8, 16] $ |
|||
⚫ | |||
\n -> do |
|||
mapM_ print square |
|||
⚫ | |||
⚫ | |||
putStrLn $ unlines (table " " (fmap show <$> test)) |
|||
print $ checked |
print $ checked test |
||
⚫ | |||
{{Out}} |
{{Out}} |
||
<pre>main |
|||
⚫ | |||
1 15 14 4 |
|||
⚫ | |||
12 6 7 9 |
|||
⚫ | |||
8 10 11 5 |
|||
⚫ | |||
13 3 2 16 |
|||
⚫ | |||
⚫ | |||
(34,True) |
|||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
⚫ | |||
(260,True) |
|||
1 255 254 4 252 6 7 249 248 10 11 245 13 243 242 16 |
|||
240 18 19 237 21 235 234 24 25 231 230 28 228 30 31 225 |
|||
224 34 35 221 37 219 218 40 41 215 214 44 212 46 47 209 |
|||
49 207 206 52 204 54 55 201 200 58 59 197 61 195 194 64 |
|||
192 66 67 189 69 187 186 72 73 183 182 76 180 78 79 177 |
|||
81 175 174 84 172 86 87 169 168 90 91 165 93 163 162 96 |
|||
97 159 158 100 156 102 103 153 152 106 107 149 109 147 146 112 |
|||
144 114 115 141 117 139 138 120 121 135 134 124 132 126 127 129 |
|||
128 130 131 125 133 123 122 136 137 119 118 140 116 142 143 113 |
|||
145 111 110 148 108 150 151 105 104 154 155 101 157 99 98 160 |
|||
161 95 94 164 92 166 167 89 88 170 171 85 173 83 82 176 |
|||
80 178 179 77 181 75 74 184 185 71 70 188 68 190 191 65 |
|||
193 63 62 196 60 198 199 57 56 202 203 53 205 51 50 208 |
|||
48 210 211 45 213 43 42 216 217 39 38 220 36 222 223 33 |
|||
32 226 227 29 229 27 26 232 233 23 22 236 20 238 239 17 |
|||
241 15 14 244 12 246 247 9 8 250 251 5 253 3 2 256 |
|||
( |
(2056,True)</pre> |
||
=={{header|Java}}== |
=={{header|Java}}== |
Revision as of 09:14, 2 June 2017
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
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
<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
<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>
- include <sstream>
- 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, intercalate) import Data.List.Split (chunksOf) import Control.Monad (forM_)
magicSquare :: Int -> Int magicSquare n
| rem n 4 > 0 = [] | otherwise = chunksOf n $ zipWith (\x i -> if x then i else limit - i) series [1 .. sqr] where sqr = n * n limit = sqr + 1 series | isPowerOf 2 n = magicSeries $ floor (logBase 2 (fromIntegral sqr)) | otherwise = concat . concat . concat . scale $ scale <$> chunksOf 4 (magicSeries 4) where scale = replicate $ quot n 4
magicSeries :: Int -> [Bool] magicSeries = (iterate ((++) <*> fmap not) [True] !!)
isPowerOf :: Int -> Int -> Bool isPowerOf k n = until ((0 /=) . flip rem k) (`quot` k) n == 1
-- TEST AND DISPLAY FUNCTIONS --------------------------------------------------
checked :: Int -> (Int, Bool) checked square =
let diagonals = fmap (flip (zipWith (!!)) [0 ..]) . ((:) <*> (return . reverse)) h:t = sum <$> square ++ -- rows transpose square ++ -- cols diagonals square -- diagonals in (h, all (h ==) t)
table :: String -> String -> [String] table delim rows =
let justifyRight c n s = drop (length s) (replicate n c ++ s) in intercalate delim <$> transpose ((fmap =<< justifyRight ' ' . maximum . fmap length) <$> transpose rows)
main :: IO () main =
forM_ [4, 8, 16] $ \n -> do let test = magicSquare n putStrLn $ unlines (table " " (fmap show <$> test)) print $ checked test putStrLn ""</lang>
- Output:
main 1 15 14 4 12 6 7 9 8 10 11 5 13 3 2 16 (34,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 (260,True) 1 255 254 4 252 6 7 249 248 10 11 245 13 243 242 16 240 18 19 237 21 235 234 24 25 231 230 28 228 30 31 225 224 34 35 221 37 219 218 40 41 215 214 44 212 46 47 209 49 207 206 52 204 54 55 201 200 58 59 197 61 195 194 64 192 66 67 189 69 187 186 72 73 183 182 76 180 78 79 177 81 175 174 84 172 86 87 169 168 90 91 165 93 163 162 96 97 159 158 100 156 102 103 153 152 106 107 149 109 147 146 112 144 114 115 141 117 139 138 120 121 135 134 124 132 126 127 129 128 130 131 125 133 123 122 136 137 119 118 140 116 142 143 113 145 111 110 148 108 150 151 105 104 154 155 101 157 99 98 160 161 95 94 164 92 166 167 89 88 170 171 85 173 83 82 176 80 178 179 77 181 75 74 184 185 71 70 188 68 190 191 65 193 63 62 196 60 198 199 57 56 202 203 53 205 51 50 208 48 210 211 45 213 43 42 216 217 39 38 220 36 222 223 33 32 226 227 29 229 27 26 232 233 23 22 236 20 238 239 17 241 15 14 244 12 246 247 9 8 250 251 5 253 3 2 256 (2056,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
<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
<lang scala>// version 1.1.0
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 = 0b1001_0110_0110_1001 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
Lua
For all three kinds of Magic Squares(Odd, singly and doubly even)
See Magic_squares/Lua.
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
<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 64Input [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
<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 l="" 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 l=l & Right(Space(w) & t, w) & " " i=i+1 Next 'c wscript.echo l 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
<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