Mailing List Archive: 49091 messages
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

[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