Version 6 of Knight's Tour

Updated 2008-03-01 14:35:22 by Duoas

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. See the Wikipedia page for some more details on this problem [L1 ].

NEM: Here's what it looks like on MacOS X:

http://www.cs.nott.ac.uk/~nem/kt.png

 # Copyright (C) 2008 Pat Thoyts <[email protected]>
 #
 #        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 <ButtonPress-1> [namespace code [list DragStart %W %x %y]]
     $c bind knight <Motion> [namespace code [list DragMotion %W %x %y]]
     $c bind knight <ButtonRelease-1> [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 <Control-F2> {console show}
     bind $dlg <Return> [list $dlg.b1 invoke]
     bind $dlg <Escape> [list $dlg.b2 invoke]
     bind $dlg <Destroy> [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?


enter categories here