'''[http://en.wikipedia.org/wiki/Knight%27s_Tour%|%The Knight's Tour]''' is a Computer Science problem that involves calculating a path for the Knight in chess such that it travels to every square on the chess board once only. ** Reference ** [http://en.wikipedia.org/wiki/Knight%27s_Tour%|%Wikipedia] ** Description ** [NEM]: Here's what it looks like on [MacOS X]: [http://www.cs.nott.ac.uk/~nem/kt.png] ====== # Copyright (C) 2008 Pat Thoyts # # Calculate a Knight's tour of a chessboard. # # This uses Warnsdorff's rule to calculate the next square each # time. This specifies that the next square should be the one that # has the least number of available moves. # # Using this rule it is possible to get to a position where # there are no squares available to move into. In this implementation # this occurs when the starting square is d6. # # To solve this fault an enhancement to the rule is that if we # have a choice of squares with an equal score, we should choose # the one nearest the edge of the board. # # If the call to the Edgemost function is commented out you can see # this occur. # # You can drag the knight to a specific square to start if you wish. # If you let it repeat then it will choose random start positions # for each new tour. package require Tk 8.5 # Return a list of accessible squares from a given square proc ValidMoves {square} { set moves {} foreach pair {{-1 -2} {-2 -1} {-2 1} {-1 2} {1 2} {2 1} {2 -1} {1 -2}} { set col [expr {($square % 8) + [lindex $pair 0]}] set row [expr {($square / 8) + [lindex $pair 1]}] if {$row > -1 && $row < 8 && $col > -1 && $col < 8} { lappend moves [expr {$row * 8 + $col}] } } return $moves } # Return the number of available moves for this square proc CheckSquare {square} { variable visited set moves 0 foreach test [ValidMoves $square] { if {[lsearch -exact -integer $visited $test] == -1} { incr moves } } return $moves } # Select the next square to move to. Returns -1 if there are no available # squares remaining that we can move to. proc Next {square} { variable visited set minimum 9 set nextSquare -1 foreach testSquare [ValidMoves $square] { if {[lsearch -exact -integer $visited $testSquare] == -1} { set count [CheckSquare $testSquare] if {$count < $minimum} { set minimum $count set nextSquare $testSquare } elseif {$count == $minimum} { set nextSquare [Edgemost $nextSquare $testSquare] } } } return $nextSquare } # Select the square nearest the edge of the board proc Edgemost {a b} { set colA [expr {3-int(abs(3.5-($a%8)))}] set colB [expr {3-int(abs(3.5-($b%8)))}] set rowA [expr {3-int(abs(3.5-($a/8)))}] set rowB [expr {3-int(abs(3.5-($b/8)))}] return [expr {($colA * $rowA) < ($colB * $rowB) ? $a : $b}] } # Display a square number as a standard chess square notation. proc N {square} { return [format %c%d [expr {97 + $square % 8}] \ [expr {$square / 8 + 1}]] } # Perform a Knight's move and schedule the next move. proc MovePiece {dlg last square} { variable visited variable delay variable continuous $dlg.f.txt insert end "[llength $visited]. [N $last] .. [N $square]\n" {} $dlg.f.txt see end $dlg.f.c itemconfigure [expr {1+$last}] -state normal -outline black $dlg.f.c itemconfigure [expr {1+$square}] -state normal -outline red $dlg.f.c coords knight [lrange [$dlg.f.c coords [expr {1+$square}]] 0 1] lappend visited $square set next [Next $square] if {$next ne -1} { variable aid [after $delay [list MovePiece $dlg $square $next]] } else { $dlg.b1 configure -state normal if {[llength $visited] == 64} { variable initial if {$initial == $square} { $dlg.f.txt insert end "Closed tour!" } else { $dlg.f.txt insert end "Success\n" {} if {$continuous} { after [expr {$delay * 2}] [namespace code \ [list Tour $dlg [expr {int(rand() * 64)}]]] } } } else { $dlg.f.txt insert end "FAILED!\n" {} } } } # Begin a new tour of the board given a random start position proc Tour {dlg {square {}}} { variable visited {} $dlg.f.txt delete 1.0 end $dlg.b1 configure -state disabled for {set n 0} {$n < 64} {incr n} { $dlg.f.c itemconfigure $n -state disabled -outline black } if {$square eq {}} { set square [expr {[$dlg.f.c find closest \ {*}[$dlg.f.c coords knight] 0 65]-1}] } variable initial $square after idle [list MovePiece $dlg $initial $initial] } proc Stop {} { variable aid catch {after cancel $aid} } proc Exit {dlg} { Stop destroy $dlg } proc SetDelay {new} { variable delay [expr {int($new)}] } proc DragStart {w x y} { $w dtag selected $w addtag selected withtag current variable dragging [list $x $y] } proc DragMotion {w x y} { variable dragging if {[info exists dragging]} { $w move selected [expr {$x - [lindex $dragging 0]}] \ [expr {$y - [lindex $dragging 1]}] variable dragging [list $x $y] } } proc DragEnd {w x y} { set square [$w find closest $x $y 0 65] $w coords selected [lrange [$w coords $square] 0 1] $w dtag selected variable dragging ; unset dragging } proc CreateGUI {} { catch {destroy .knightstour} set dlg [toplevel .knightstour] wm title $dlg "Knights tour" wm withdraw $dlg set f [ttk::frame $dlg.f] set c [canvas $f.c -width 240 -height 240] text $f.txt -width 10 -height 1 -background white \ -yscrollcommand [list $f.vs set] -font {Arial 8} ttk::scrollbar $f.vs -command [list $f.txt yview] variable delay 600 variable continuous 0 ttk::label $dlg.ls -text Speed ttk::scale $dlg.sc -from 8 -to 2000 -command [list SetDelay] \ -variable [namespace which -variable delay] ttk::checkbutton $dlg.cc -text Repeat \ -variable [namespace which -variable continuous] ttk::button $dlg.b1 -text Start -command [list Tour $dlg] ttk::button $dlg.b2 -text Exit -command [list Exit $dlg] set square 0 for {set row 7} {$row != -1} {incr row -1} { for {set col 0} {$col < 8} {incr col} { if {(($col & 1) ^ ($row & 1))} { set fill tan3 ; set dfill tan4 } else { set fill bisque ; set dfill bisque3 } set coords [list [expr {$col * 30 + 3}] [expr {$row * 30 + 3}] \ [expr {$col * 30 + 29}] [expr {$row * 30 + 29}]] $c create rectangle $coords -fill $fill -disabledfill $dfill \ -width 2 -state disabled } } catch {eval font create KnightFont -size -24} $c create text 0 0 -font KnightFont -text "\u265e" \ -anchor nw -tags knight -fill black -activefill "#600000" $c coords knight [lrange [$c coords [expr {1 + int(rand() * 64)}]] 0 1] $c bind knight [namespace code [list DragStart %W %x %y]] $c bind knight [namespace code [list DragMotion %W %x %y]] $c bind knight [namespace code [list DragEnd %W %x %y]] grid $c $f.txt $f.vs -sticky news grid rowconfigure $f 0 -weight 1 grid columnconfigure $f 1 -weight 1 grid $f - - - - - -sticky news set things [list $dlg.ls $dlg.sc $dlg.cc $dlg.b1] if {![info exists ::widgetDemo]} { lappend things $dlg.b2 [ttk::sizegrip $dlg.sg] } grid {*}$things -sticky e if {[info exists ::widgetDemo]} { grid [addSeeDismiss $dlg.buttons $dlg] - - - - - -sticky ew } grid rowconfigure $dlg 0 -weight 1 grid columnconfigure $dlg 0 -weight 1 bind $dlg {console show} bind $dlg [list $dlg.b1 invoke] bind $dlg [list $dlg.b2 invoke] bind $dlg [namespace code [list Stop]] wm protocol $dlg WM_DELETE_WINDOW [namespace code [list Exit $dlg]] wm deiconify $dlg tkwait window $dlg } if {!$tcl_interactive} { if {![winfo exists .knightstour]} { if {![info exists widgetDemo]} { wm withdraw . } set r [catch [linsert $argv 0 CreateGUI] err] if {$r} { tk_messageBox -icon error -title "Error" -message $err } if {![info exists widgetDemo]} { exit $r } } } ====== ---- [Duoas] Brilliant! However, that Knight Font is non-standard... at least not on a Mac? Where did you get it? [NEM] On my Mac it's using the Geneva font. I don't know whether that is standard or has been installed by some other app (e.g. iWorks). <> algorithm | Games | Example] | AI