Magic Squares
December 12, 2014
Our function is tedious but not difficult:
(define (magic n start up/down left/right dir)
(define (incr x) (modulo (+ x 1) n))
(define (decr x) (modulo (- x 1) n))
(let ((square (make-matrix n n 0))
(row (cond ((eq? start 'top) 0)
((eq? start 'bottom) (- n 1))
(else (quotient n 2))))
(col (cond ((eq? start 'left) 0)
((eq? start 'right) (- n 1))
(else (quotient n 2)))))
(let loop ((i 1) (row row) (col col))
(if (< (* n n) i) square
(let ((next-row (if (eq? up/down 'up) (decr row) (incr row)))
(next-col (if (eq? left/right 'left) (decr col) (incr col))))
(when (positive? (matrix-ref square next-row next-col))
(cond ((eq? dir 'up)
(set! next-row (decr row)) (set! next-col col))
((eq? dir 'down)
(set! next-row (incr row)) (set! next-col col))
((eq? dir 'left)
(set! next-row row) (set! next-col (decr col)))
((eq? dir 'right)
(set! next-row row) (set! next-col (incr col)))))
(matrix-set! square row col i)
(loop (+ i 1) next-row next-col))))))
There are eight rules that work, two starting from each side; from whichever side you start, the first parameter moves outside the square, the second parameter moves in either perpendicular direction, and the third parameter is opposite the first. Here are the eight rules applied to order-3 magic squares:
> (magic 3 'top 'up 'left 'down) #(#(6 1 8) #(7 5 3) #(2 9 4)) > (magic 3 'top 'up 'right 'down) #(#(8 1 6) #(3 5 7) #(4 9 2)) > (magic 3 'left 'left 'up 'right) #(#(4 8 3) #(1 5 9) #(7 2 6)) > (magic 3 'left 'left 'down 'right) #(#(4 8 3) #(1 5 9) #(7 2 6)) > (magic 3 'right 'right 'up 'left) #(#(4 3 8) #(9 5 1) #(2 7 6)) > (magic 3 'right 'right 'down 'left) #(#(4 3 8) #(9 5 1) #(2 7 6)) > (magic 3 'bottom 'down 'left 'up) #(#(2 9 4) #(7 5 3) #(6 1 8)) > (magic 3 'bottom 'down 'right 'up) #(#(4 9 2) #(3 5 7) #(8 1 6))
We used matrices from the Standard Prelude. You can run the program at http://programmingpraxis.codepad.org/fW3wzmKI, where you will also see a function that neatly displays a magic square, like this:
> (display-square (magic 13 'top 'up 'left 'down)) 91 76 61 46 31 16 1 168 153 138 123 108 93 92 90 75 60 45 30 15 13 167 152 137 122 107 106 104 89 74 59 44 29 14 12 166 151 136 121 120 105 103 88 73 58 43 28 26 11 165 150 135 134 119 117 102 87 72 57 42 27 25 10 164 149 148 133 118 116 101 86 71 56 41 39 24 9 163 162 147 132 130 115 100 85 70 55 40 38 23 8 7 161 146 131 129 114 99 84 69 54 52 37 22 21 6 160 145 143 128 113 98 83 68 53 51 36 35 20 5 159 144 142 127 112 97 82 67 65 50 49 34 19 4 158 156 141 126 111 96 81 66 64 63 48 33 18 3 157 155 140 125 110 95 80 78 77 62 47 32 17 2 169 154 139 124 109 94 79
Programming Praxis 
Haskell: http://codepad.org/TgUfspuQ
Python version. Accepts rule like “start top, move up and left, else down”. Leave out the non-direction words: “top up left down”, or abbreviate it to a string of the initial letters: ‘tuld’.
import math, re def print_magic(sq): w = math.ceil(math.log10(len(sq)*len(sq))) fmt = "{{:{}}}".format(w).format for row in sq: print(*(fmt(col) for col in row)) def magic(size=3, rule="start top, move up and right, else down"): if len(rule) > 5: pattern = r't(?=op)|b(?=ottom)|u(?=p)|d(?=own)|l(?=eft)|r(?=ight)' rule = re.findall(pattern, rule) r = 0 if rule[0] == 't' else size - 1 if rule[0] == 'b' else size // 2 c = 0 if rule[0] == 'l' else size - 1 if rule[0] == 'r' else size // 2 dr = -1 if 'u' in rule[1:3] else 1 if 'd' in rule[1:3] else 0 dc = -1 if 'l' in rule[1:3] else 1 if 'r' in rule[1:3] else 0 er = -1 if 'u' in rule[3:] else 1 if 'd' in rule[3:] else 0 ec = -1 if 'l' in rule[3:] else 1 if 'r' in rule[3:] else 0 square = [[None for c in range(size)] for r in range(size)] for n in range(1, size * size + 1): square[r][c] = n r = (r + dr) % size c = (c + dc) % size if square[r][c] is not None: r = (r - dr + er) % size c = (c - dc + ec) % size return square