[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 ======