##+##########################################################################
#
# 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