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

[REBOL] Re: Another coffee break problem?

From: tomc:darkwing:uoregon at: 16-Nov-2003 14:01

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 ]