Magic squares of doubly even order: Difference between revisions

Content added Content deleted
Line 35: Line 35:
* [http://www.1728.org/magicsq2.htm Doubly Even Magic Squares (1728.org)]
* [http://www.1728.org/magicsq2.htm Doubly Even Magic Squares (1728.org)]
<br><br>
<br><br>

=={{header|AppleScript}}==

<lang AppleScript>-- magicSquare :: Int -> [[Int]]
on magicSquare(n)
if n mod 4 > 0 then
{}
else
script scale
on lambda(x)
replicate(n / 4, x)
end lambda
end script
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
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
property divisor : k
on lambda(x)
x mod (remLeft's divisor) is not 0
end lambda
end script
script integerDiv
property divisor : k
on lambda(x)
x div (integerDiv's divisor)
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

-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f, xs, ys)
set nx to length of xs
set ny to length of ys
if nx < 1 or ny < 1 then
{}
else
set lng to cond(nx < ny, nx, ny)
set lst to {}
tell mReturn(f)
repeat with i from 1 to lng
set end of lst to lambda(item i of xs, item i of ys)
end repeat
return lst
end tell
end if
end zipWith

-- 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 mf to mReturn(f)
script iterate
property p : mp's lambda
property f : mf's lambda
on lambda(v)
repeat until p(v)
set v to f(v)
end repeat
return v
end lambda
end script
iterate's lambda(x)
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>

{{Out}}
magic(8)

{| class="wikitable" style="text-align:center;width:20.0em;height:20.0em;table-layout:fixed;"
|-
| 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
|}



=={{header|C++}}==
=={{header|C++}}==
Retrieved from "https://rosettacode.org/wiki/Magic_squares_of_doubly_even_order"