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

-- 
To unsubscribe from this list, just send an email to
[EMAIL PROTECTED] with unsubscribe as the subject.

Reply via email to