## Magic Squares

Keith Vetter 2019-01-18 : for a recent programming challenge I needed to enumerate all 880 unique 4x4 magic squares. I thought I'd share the code. The biggest challenge is in catching rotations and reflections, and I solve this by controlling the position of the digits 1 and 2.

```##+##########################################################################
#
# magic_squares.tsh -- Finds all 4x4 magic square (880)
# by Keith Vetter 2019-01-18
#
# To avoid rotations and reflections, we normalize by putting 1 into either
# the first or second position in the top row or the second position in the
# second row, and 2 into the upper right quadrant.
#

proc FindMagic {} {
set nums {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16}
set all {}
foreach row1 [OneRow \$nums \$nums \$nums \$nums] {
lassign \$row1 a b c d
set nums2 [Minus \$nums \$row1]

foreach col1 [OneRow \$a \$nums2 \$nums2 \$nums2] {
lassign \$col1 . e i m
if {\$a == 1 && 2 in \$col1} continue ;# Symmetry

set nums3 [Minus \$nums2 \$col1]

foreach row2 [OneRow \$e \$nums3 \$nums3 \$nums3] {
lassign \$row2 . f g h
if {1 ni [list \$a \$b \$f]} continue
set nums4 [Minus \$nums3 \$row2]
set j [expr {34 - \$d - \$g - \$m}]
if {\$j ni \$nums4} continue

set nums5 [Minus \$nums4 \$j]

foreach row3 [OneRow \$i \$j \$nums4 \$nums4] {
lassign \$row3 . . k l

set nums6 [Minus \$nums5 \$row3]
set n [expr {34 - \$b - \$f - \$j}]
if {\$n ni \$nums6} continue
set o [expr {34 - \$c - \$g - \$k}]
if {\$o ni \$nums6 || \$o == \$n} continue

set p [expr {34 - \$a - \$f - \$k}]
if {\$p == \$n || \$p == \$o || \$p ni \$nums6} continue
if {\$b != 1 && 2 in [list \$e \$i \$j \$m \$n \$o]} continue

lappend all [list \$row1 \$row2 \$row3 [list \$m \$n \$o \$p]]
}
}
}
}
return \$all
}
proc OneRow {aValues bValues cValues dValues} {
# Returns list of all possible 4 values for a row summing to 34
# By symmetry, neither c nor d can be 1
set all {}
foreach a \$aValues {
foreach b \$bValues {
if {\$a == \$b} continue
foreach c \$cValues {
if {\$c == 1 || \$c == \$a || \$c == \$b} continue
set d [expr {34 - \$a - \$b - \$c}]
if {\$d == 1 || \$d ni \$dValues || \$d in [list \$a \$b \$c]} continue
lappend all [list \$a \$b \$c \$d]
}
}
}
return \$all
}
proc Minus {setA setB} {
# Computes setA - setB
set result {}
foreach item \$setA {
if {\$item ni \$setB} {
lappend result \$item
}
}
return \$result
}

################################################################
#
# Display result code below
#
proc ShowOne {sln} {
ShowMany [list \$sln]
}
proc ShowAll {slns} {
set stride 6
set stride1 [expr {\$stride - 1}]
for {set idx 0} {\$idx < [llength \$slns]} {incr idx \$stride} {
ShowMany [lrange \$slns \$idx \$idx+\$stride1]
}
}

proc ShowMany {slns} {
unset -nocomplain ROW
foreach sln \$slns {
lassign [ToString \$sln] row1 row2 row3 row4
lappend ROW(1) \$row1
lappend ROW(2) \$row2
lappend ROW(3) \$row3
lappend ROW(4) \$row4
}
set TL \u250c
set TR \u2510
set BL \u2514
set BR \u2518
set U \u2502
set M \u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500

puts [string repeat "\$TL\$M\$TR  " [llength \$slns]]
puts \$U[join \$ROW(1) "\$U  \$U"]\$U
puts \$U[join \$ROW(2) "\$U  \$U"]\$U
puts \$U[join \$ROW(3) "\$U  \$U"]\$U
puts \$U[join \$ROW(4) "\$U  \$U"]\$U
puts [string repeat "\$BL\$M\$BR  " [llength \$slns]]
}
proc ToString {sln} {
lassign [concat {*}\$sln] a b c d e f g h i j k l m n o p
set result {}
lappend result [format {%2s %2s %2s %2s} \$a \$b \$c \$d]
lappend result [format {%2s %2s %2s %2s} \$e \$f \$g \$h]
lappend result [format {%2s %2s %2s %2s} \$i \$j \$k \$l]
lappend result [format {%2s %2s %2s %2s} \$m \$n \$o \$p]
return \$result
}

proc Check {sln} {
lassign [concat {*}\$sln] a b c d e f g h i j k l m n o p

# if {1 ni [list \$a \$b \$e \$f]} { puts "not normalized" ; return }

if {\$a + \$b + \$c + \$d != 34} { error "first row"}
if {\$e + \$f + \$g + \$h != 34} { error "second row"}
if {\$i + \$j + \$k + \$l != 34} { error "third row"}
if {\$m + \$n + \$o + \$p != 34} { error "fourth row"}

if {\$a + \$e + \$i + \$m != 34} { error "first col"}
if {\$b + \$f + \$j + \$n != 34} { error "second col"}
if {\$c + \$g + \$k + \$o != 34} { error "third col"}
if {\$d + \$h + \$l + \$p != 34} { error "fourth col"}
if {\$a + \$f + \$k + \$p != 34} { error "1 diag"}
if {\$d + \$g + \$j + \$m != 34} { error "2 diag"}
}

puts stderr "computing..."
set all [FindMagic]
ShowAll \$all

return```