#!/usr/local/bin/wish
#Blet, a mathematical puzzle. Clicking in the middle of
#a pattern 010 changes it to 101 and vice-versa. The objective
#is to maximize the number of 1's.
#Copyright 2000, F. Rodriguez Villegas, L. Sadun and J. F. Voloch

set n 28
entry .count -textvariable counter -width 3
set counter 0
grid .count -column 6 -row 2
label .lcount -text "moves:"
grid .lcount -column 4 -row 2 -columnspan 2
entry .sum -textvariable sum -width 3
set sum 14
grid .sum -column 6 -row 3
label .lsum -text "score:"
grid .lsum -column 4 -row 3 -columnspan 2

for {set i 0} {$i < $n} {incr i} {
button .b{$i} -textvariable v($i) -activebackground yellow -command "Do $i"
set v($i) [expr $i%2]
if {$i < 5} {
grid .b{$i} -row [expr 7 -$i] -column 0
} elseif {$i > 4 && $i < 7} {
grid .b{$i} -row [expr 7 -$i] -column [expr $i -4]
} elseif {$i > 6 && $i < 12} {
grid .b{$i} -row 0 -column [expr $i -4]
} elseif {$i > 11 && $i < 14} {
grid .b{$i} -row [expr $i - 11] -column [expr $i -4]
} elseif {$i > 13 && $i < 19} {
grid .b{$i} -row [expr $i - 11] -column 10
} elseif {$i > 18 && $i < 21} {
grid .b{$i} -row [expr $i - 11] -column [expr 28 -$i]
} elseif {$i > 20 && $i < 26} {
grid .b{$i} -row 10 -column [expr 28 -$i]
} else {
grid .b{$i} -row [expr 35 -$i] -column [expr 28 -$i]
}
}
button .reset -text "reset" -command "Reset"
grid .reset -column 4 -row 4 -columnspan 3
button .anneal -text "anneal" -command "Sim"
grid .anneal -column 4 -row 5 -columnspan 3
entry .eps -textvariable eps -width 3
set eps 0.2
grid .eps -column 7 -row 5
button .dismiss -text "dismiss" -command "destroy ."
grid .dismiss -column 4 -row 6 -columnspan 3
button .about -text "about" -command "Create"
grid .about -column 4 -row 7 -columnspan 3

proc Create {} {
if {![winfo exists .mes]} {
message .mes -aspect 400 -justify left -text \
"Blet, a mathematical puzzle. Clicking in the middle of
a pattern 010 changes it to 101 and vice-versa. 
The objective is to maximize the number of 1's.
The anneal button will try to solve the puzzle by simulated
annealing, using the probability specified in the entry next to it.
Copyright 2000, F. Rodriguez Villegas, L. Sadun and J. F. Voloch"
grid .mes -column 0 -row 11 -columnspan 10
button .bye -text "close" -command "destroy .mes;destroy .bye"
grid .bye -column 4 -row 12 -columnspan 3
}
}

proc Do {x} {
global n counter sum
set a [expr ($x-1)%$n]
set b [expr ($x+1)%$n]
global v
if {!$v($a) && $v($x)  && !$v($b)} {
set v($a) 1
set v($x) 0
set v($b) 1
set counter [expr $counter + 1]
set sum [expr $sum + 1]
} elseif {$v($a) && !$v($x) && $v($b)} {
set v($a) 0
set v($x) 1
set v($b) 0
set counter [expr $counter + 1]
set sum [expr $sum - 1]
}
}

proc Reset {} {
global v counter sum n
for {set i 0} {$i < $n} {incr i} {
set v($i) [expr $i%2]
set counter 0
set sum 14
}
}

proc Dont {x v} {
global n 
set a [expr ($x-1)%$n]
set b [expr $x%$n]
set c [expr ($x+1)%$n]
if {![string index $v $a] && [string index $v $b]  && ![string index $v $c]} {
if {$a < [expr $n - 2]} {
set new [string replace $v $a $c 101]
} elseif {$a == [expr $n - 2]} {
set new [string replace [string replace $v $a $b 10] 0 0 1]
} elseif {$a == [expr $n - 1]} {
set new [string replace [string replace $v $a $a 1] 0 1 01]
}
} elseif {[string index $v $a] && ![string index $v $b]  && [string index $v $c]} {
if {$a < [expr $n - 2]} {
set new [string replace $v $a $c 010]
} elseif {$a == [expr $n - 2]} {
set new [string replace [string replace $v $a $b 01] 0 0 0]
} elseif {$a == [expr $n - 1]} {
set new [string replace [string replace $v $a $a 0] 0 1 10]
}
} else {
set new 0
}
return $new
}

proc Startup {m} {
for {set i 0} {$i < $m} {incr i} {
append out [expr $i%2]
}
return $out
}

proc Sim {} {
    global n wez v eps st
    set break 0
    set new ""
    for {set i 0} {$i < $n} {incr i} {
    append new $v($i)
    }
    while {$break < 10000 && [Weight $new] < 23 } {
	set r [expr int(rand()*$n)]
	if {[Dont $r $new] != 0} {
	if {[Weight [Dont $r $new]] > [Weight $new] || [expr rand()] < $eps} {
	    set new [Dont $r $new]
#	    after 10
	    Do $r
            .b{$r} flash 
	    update idletasks
	    
	}
    }
    
	incr break
	
    }
}

proc Weight {foo} {
global n
set r 0
for {set i 0} {$i < $n} {incr i} {
if {[string index $foo $i] == 1} {
incr r
}
}
return $r
}