[REBOL] Re: Another coffee break problem?
From: Patrick:Philipot:laposte at: 11-Nov-2003 22:03
Hello Joel,
Tuesday, November 11, 2003, 1:01:52 AM, you wrote:
JN> If Sunanda will allow me to steal his subject line... ;-)
JN> The following 3-by-3 display is a simple magic square:
JN> 0 8 4
JN> 5 1 6
JN> 7 3 2
JN> because each row and each column sums to 12. Write a function which
JN> uses the integers 0 thru 8 (once each!) to construct all possible
JN> 3-by-3 simple magic squares. Make it run as quickly as possible.
JN> --
As you have got no solution yet, this is mine just to start the
engine. It is not very clever and I don't know if it's right.
I am looking forward to see other results though.
Rebol [
date: 11-10-2003
author: "pat665"
purpose: {
Post from Joël 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.
}
]
nums: [0 1 2 3 4 5 6 7 8]
; all the triplets that sum to 12
triplets: copy []
for i 1 9 1 [
for j (i + 1) 9 1 [
for k (j + 1) 9 1 [
if 12 = (nums/:i + nums/:j + nums/:k) [
append/only triplets reduce [nums/:i nums/:j nums/:k]
]
]
]
]
triplets: sort unique triplets
; == [[0 4 8] [0 5 7] [1 3 8] [1 4 7] [1 5 6] [2 3 7] [2 4 6] [3 4 5]]
; Grouping the triplets that use exactly the 9 available numbers
groups: copy []
temp: copy []
nb-group: length? triplets
for i 1 nb-group 1 [
for j (i + 1) nb-group 1 [
for k (j + 1) nb-group 1 [
append clear temp triplets/:i
append temp triplets/:j
append temp triplets/:k
temp: sort temp
if equal? nums temp [
append/only groups compose/deep [
[(triplets/:i)]
[(triplets/:j)]
[(triplets/:k)]
]
]
]
]
]
; groups: [[[0 4 8] [1 5 6] [2 3 7]] [[0 5 7] [1 3 8] [2 4 6]]]
; Help function for permutation
n: [1 2 3]
permutations: copy []
for i 1 3 1 [
for j 1 3 1 [
for k 1 3 1 [
if all [ i <> j i <> k j <> k ][
append/only permutations reduce [n/:i n/:j n/:k]
]
]
]
]
permutations: unique permutations
; permutations: [[1 2 3] [1 3 2] [2 1 3] [2 3 1] [3 1 2] [3 2 1]]
; Help function
magic?: func [
"test for magicallness"
b [block!]
][
; rows are already magical
; just testing the columns here
all [
b/1/1 + b/2/1 + b/3/1 = 12
b/1/2 + b/2/2 + b/3/2 = 12
b/1/3 + b/2/3 + b/3/3 = 12
]
]
; The solutions
nb-solution: 0
foreach group groups [
; triplet permutations
for p 1 6 1 [
gp: compose/deep [
[(pick group permutations/:p/1)]
[(pick group permutations/:p/2)]
[(pick group permutations/:p/3)]
]
; number permutation inside each triplet
for i 1 6 1 [
t1: reduce [
pick gp/1 permutations/:i/1
pick gp/1 permutations/:i/2
pick gp/1 permutations/:i/3
]
for j 1 6 1 [
t2: reduce [
pick gp/2 permutations/:j/1
pick gp/2 permutations/:j/2
pick gp/2 permutations/:j/3
]
for k 1 6 1 [
t3: reduce [
pick gp/3 permutations/:k/1
pick gp/3 permutations/:k/2
pick gp/3 permutations/:k/3
]
if magic? solution: compose/deep [[(t1)][(t2)][(t3)]] [
print mold solution/1
print mold solution/2
print mold solution/3
print newline
nb-solution: nb-solution + 1
]
]
]
]
]
]
?? nb-solution
--
Best regards,
Patrick
