I have written a Pentomino Solver in tcl/tk.
0 {0 0 0,n,0} {0 1 1,n,2} {0 2 2,n,3} {1 3 5,n,0} ... {10 1 3,i,1} 0: the index of this solution. {0 0 0,n,0}: x=0, y=0, piece 0, normal side, rotate 90x0 degrees. {0 1 1,n,2}: x=0, y=1, piece 1, normal side, rotate 90x2 degrees. : {10 1 3,i,1}: x=10,y=1, piece 3, inverse side, rotate 90x1 degrees.
This is a very primitive implementation without any efficient branch-cut logics: A straight-forward recursion is adopted. Anyway, have fun :-)
# # piece puzzle solver # # by zhuo # # Rev. 0.0. July 14, 2009 - July 17, 2009 first version. # # ###################################################################### # board. width 12, height 5 # pieces # #[0] # ooooo (no inversion) #[1] # oo # ooo #[2] # o o # ooo (no inversion) #[3] # oooo # o #[4] # o # oooo #[5] # ooo # oo #[6] # o # ooo (no inversion) # o #[7] # o # ooo # o #[8] # o # ooo (no rotation, no inversion) # o #[9] # oo # oo # o #[10] # o # ooo # o #[11] # o # o # ooo (no inversion) # # # rotation ok # inversion( upside-down) ok # ##################################################################### ###################################################################### # packages ###################################################################### package require Img 1.3 source "Colors.tcl" console show ###################################################################### # params ###################################################################### set ::boardWidth 12 set ::boardHeight 5 set ::nPieces 12 set ::pieceOrigPatterns { { { 0 0 0 0 0 } } { { 1 1 -1 -1 } { -1 1 1 1 } } { { 2 -1 2 } { 2 2 2 } } { { 3 3 3 3 } { 3 -1 -1 -1 } } { { -1 -1 4 -1 } { 4 4 4 4 } } { { 5 5 5 } { -1 5 5 } } { { 6 -1 -1 } { 6 6 6 } { 6 -1 -1 } } { { 7 -1 -1 } { 7 7 7 } { -1 7 -1 } } { { -1 8 -1 } { 8 8 8 } { -1 8 -1 } } { { 9 9 -1 } { -1 9 9 } { -1 -1 9 } } { { 10 -1 -1 } { 10 10 10 } { -1 -1 10 } } { { -1 -1 11 } { -1 -1 11 } { 11 11 11 } } } set ::pieceRotations { 2 4 4 4 4 4 4 4 1 4 2 4 } set ::pieceHasInversions { 0 1 0 1 1 1 0 1 0 0 1 0 } proc patInvert { srcpat } { set newpat {} for { set i [expr [llength $srcpat]-1]} { $i >= 0 } { incr i -1} { lappend newpat [lindex $srcpat $i] } return $newpat } # get a rotated version of the srcPattern # # [ ] [ ] # [ ] <- [ ] # [ ] # [ ] proc patRotate { src } { set oheight [llength $src] set owidth [llength [lindex $src 0]] set nheight $owidth set nwidth $oheight set npat {} for { set nh [expr $nheight -1] } { $nh >= 0} {incr nh -1} { set nline {} for { set nw 0 } { $nw < $nwidth } {incr nw} { lappend nline [lindex $src $nw $nh] } lappend npat $nline } return $npat } # test of the proc above; looks fine. # puts [patRotate [lindex $::pieceOrigPatterns 7]] ###################################################################### # generate all patterns at the beginning ###################################################################### array set ::piecePatterns { } for { set ip 0 } { $ip < $::nPieces } { incr ip } { # prepare color codes as well! set col [Colors_rgbToColorCode [Colors_hsvToRgb [expr {350.0 * $ip /$::nPieces}] 0.7 0.9]] set pat [lindex $::pieceOrigPatterns $ip] for { set rot 0 } { $rot < [lindex $::pieceRotations $ip] } { incr rot } { set pieceKey [format "%d,n,%d" $ip $rot] set ::piecePatterns($pieceKey) $pat set pat [patRotate $pat] set ::pieceColor($pieceKey) $col } if { [lindex $::pieceHasInversions $ip] } { set pat [patInvert [lindex $::pieceOrigPatterns $ip]] for { set rot 0 } { $rot < [lindex $::pieceRotations $ip] } { incr rot } { set pieceKey [format "%d,i,%d" $ip $rot] set ::piecePatterns($pieceKey) $pat set pat [patRotate $pat] set ::pieceColor($pieceKey) $col } } } ## test dump: #foreach n [lsort [array names ::piecePatterns]] { # puts "$n: $::piecePatterns($n)" #} ###################################################################### # set up display ###################################################################### set ::boardSize 40 canvas .c -width [expr $::boardSize * $::boardWidth] -height [expr $::boardSize * $::boardHeight] pack .c -side top #prepare grids for { set y 0 } { $y < $::boardHeight } { incr y } { for { set x 0 } { $x < $::boardWidth } { incr x } { .c create rectangle 1 1 $::boardSize $::boardSize -fill white -outline gray -tags "$x,$y" .c move "$x,$y" [expr $x * $::boardSize] [expr $y * $::boardSize] } } # show piece at grid x,y proc showPieceAt { pieceKey gx gy } { set y $gy foreach row $::piecePatterns($pieceKey) { set x $gx foreach p $row { if { $p >= 0 } { .c itemconfigure "$x,$y" -fill $::pieceColor($pieceKey) } incr x } incr y } } proc hidePieceAt { pieceKey gx gy } { set y $gy foreach row $::piecePatterns($pieceKey) { set x $gx foreach p $row { if { $p >= 0 } { .c itemconfigure "$x,$y" -fill white } incr x } incr y } } proc setPieceAt { pieceKey gx gy boardImageArray} { upvar $boardImageArray boardImage set y $gy foreach row $::piecePatterns($pieceKey) { set x $gx foreach p $row { if { $p >= 0 } { set boardImage($x,$y) $p } incr x } incr y } } proc clearPieceAt { pieceKey gx gy boardImageArray } { upvar $boardImageArray boardImage set y $gy foreach row $::piecePatterns($pieceKey) { set x $gx foreach p $row { if { $p >= 0 } { set boardImage($x,$y) -1 } incr x } incr y } } proc saveBoardFile { gifname } { image create photo boardsnap -data .c boardsnap write $gifname -format gif image delete boardsnap } ###################################################################### # solver ###################################################################### # pieceUsage: { if0used if1used ... if11used } # piecePos { {x0 y0 pieceKey0} {x1 y1 pieceKey1} ... } # choices: { { x y pieceKey } { x y pieceKey } ... } proc resetBoardImage { boardImageArray } { upvar $boardImageArray boardImage for { set y 0 } { $y < $::boardHeight } { incr y } { for { set x 0 } { $x < $::boardWidth } { incr x } { set boardImage($x,$y) -1 } } } set ::solutionCnt 0 set ::logfname "sollog.txt" proc solve {} { set ::fd [open $::logfname "w"] set pieceUsage { 0 0 0 0 0 0 0 0 0 0 0 0 } set piecePos {} resetBoardImage boardImage solveOneStep $pieceUsage $piecePos boardImage puts "end" puts $::fd "end" close $::fd } proc solveOneStep { pieceUsage piecePos boardImageArray } { upvar $boardImageArray boardImage update set xy [getNextTarget boardImage] # if the board is completely full, return with !, doing nothing. if { $xy == "" } { puts "$::solutionCnt $piecePos" puts $::fd "$::solutionCnt $piecePos" flush $::fd saveBoardFile [format "sol%05d.gif" $::solutionCnt] incr ::solutionCnt return 2 } # list up all the choices at (x,y). give if none found. set choices [generateChoices $xy $pieceUsage boardImage] if { [llength $choices] == 0 } { return 1 } # try each of them foreach c $choices { set x [lindex $c 0] set y [lindex $c 1] set pk [lindex $c 2] scan $pk "%d,%s,%d" pidx inv rot setPieceAt $pk $x $y boardImage showPieceAt $pk $x $y solveOneStep [lreplace $pieceUsage $pidx $pidx 1] [linsert $piecePos end $c] boardImage hidePieceAt $pk $x $y clearPieceAt $pk $x $y boardImage } return 0 } proc getNextTarget { boardImageArray } { upvar $boardImageArray boardImage for { set x 0 } { $x < $::boardWidth } { incr x } { if { $x % 2 == 0 } { for { set y 0 } { $y < $::boardHeight } { incr y } { if { $boardImage($x,$y) == -1 } { return "$x,$y" } } } else { for { set y [expr {$::boardHeight-1}]} { $y >= 0 } { incr y -1 } { if { $boardImage($x,$y) == -1 } { return "$x,$y" } } } } return "" } proc generateChoices { xy pieceUsage boardImageArray } { upvar $boardImageArray boardImage set choices {} set pieceIdx 0 foreach used $pieceUsage { if { $used == 0 } { foreach pieceKey [array names ::piecePatterns -regexp "^$pieceIdx,"] { foreach newChoices [generateChoicesForPieceKey $xy $pieceKey boardImage] { lappend choices $newChoices } } } incr pieceIdx } return $choices } proc generateChoicesForPieceKey { xy pieceKey boardImageArray } { upvar $boardImageArray boardImage scan $xy "%d,%d" x y set pat $::piecePatterns($pieceKey) set ph [llength $pat] set pw [llength [lindex $pat 0]] set beg_ty [expr {$y - $ph + 1}] if { $beg_ty < 0 } { set beg_ty 0 } set end_ty [expr {$::boardHeight - $ph}] if { $end_ty > $y } { set end_ty $y } set beg_tx [expr {$x - $pw + 1}] if { $beg_tx < 0 } { set beg_tx 0 } set end_tx [expr {$::boardWidth - $pw}] if { $end_tx > $x } { set end_tx $x } set newChoices {} for { set ty $beg_ty } { $ty <= $end_ty } { incr ty } { for { set tx $beg_tx } { $tx <= $end_tx } { incr tx } { # speed up: skip if pattern does not cover (x,y) if { [lindex $pat [expr {$y-$ty}] [expr {$x-$tx}]] < 0 } { continue } if { [isPiecePlaceable $tx $ty $pat boardImage] } { lappend newChoices [list $tx $ty $pieceKey] } } } return $newChoices } proc isPiecePlaceable { x y pat boardImageArray } { upvar $boardImageArray boardImage set ty $y foreach row $pat { set tx $x foreach p $row { if { $p >= 0 && $boardImage($tx,$ty) >= 0 } { return 0 } incr tx } incr ty } return 1 } ###################################################################### solve