OK ... I think this is complete enough
Rebol[
title: "Magic Square generator"
author: "Tom Conlin"
date: 12-Nov-2003
file: %magic-squares.r
version: 0.1.0
purpose: { Post from Joel Neely
The following 3-by-3 display is a simple magic square:
0 8 4
5 1 6
7 3 2
because each row and each column sums to 12.
Write a function which uses the integers 0 thru 8 (once each!)
to construct all possible 3-by-3 simple magic squares.
Make it run as quickly as possible.
}
]
magic-squares: func [
{ generate simple magic squares
and their symetrical reflections
for a particular ODD size
}
n[integer!] "odd natural number"
/verbose "pretty print the solutions as well as returning a block"
/local flip transpose pprint ms nn ur dn s t blank result
][
;; be sensible
if any[not integer? n not positive? n not odd? n][
print "argument needs to be positive odd integer"
return -1
]
nn: n * n
;; actualy quite neat
flip: func[b [series!] n[integer!]][
while[not tail? b][reverse/part b n b: skip b n]
head b
]
;; a bit tedious
transpose: func[b[block!] n[integer!] /local t u d ni][
for i 1 n 1[
ni: n * i - n
for j i + 1 n 1[
t: pick b u: ni + j
poke b u pick b d: n * j - n + i
poke b d t
]
]
b
]
;;
pprint: func[b [series!] n[integer!]][
loop n[print copy/part b n b: skip b n]
print ""
]
; for building upper-right LUT
wrap: func[ b[block!] n[integer!]][
join skip tail b negate n copy/part b subtract length? b n
]
;;make LUTs for next move, either up & right or down (with wrapping)
dn: make block! nn + n
repeat i nn[insert tail dn i]
ms: copy ur: copy dn ;; populate blocks
insert tail dn copy/part dn n ;; down LUT
remove/part dn n
ur: wrap ur n ;; up & right LUT
while[not tail? ur][
change/part ur wrap copy/part ur n n - 1 n
ur: skip ur n
]
ur: head ur
result: make block! 8 * nn ;; storage
;; starting from 0 isn't worth the hassle
for i 1 nn 1[
s: i
poke ms s 1
for j 2 nn 1[ ;; build one of the n simple magic squares
either equal? 1 j // n
[poke ms s: pick dn s j]
[poke ms s: pick ur s j]
]
;; store the simple magic square and its reflections
insert/only tail result copy ms ; normal
loop 3[
insert/only tail result copy flip ms n
insert/only tail result copy transpose ms n
] insert/only tail result copy flip ms n
]
if verbose [
while[not tail? result][
pprint pick result 1 n result: next result
]
]
head result
]
--
To unsubscribe from this list, just send an email to
[EMAIL PROTECTED] with unsubscribe as the subject.
