441 lines
16 KiB
Tcl
441 lines
16 KiB
Tcl
package require crc32
|
|
|
|
set hole01 [list "------" "- -" "- -- -" "- -- -" "- -- -" "- -- -" "-B--H-" "------"]
|
|
#URD
|
|
set hole02 [list " ----- " "--- --" "-H -" "--- -" " -- --" " -B-- " " --- "]
|
|
#ULDRUL
|
|
set hole03 [list " ---- " "-- ----" "- -" "- B -" "- H -" "- -" "-- --" " ------ "]
|
|
#DLURD
|
|
set hole04 [list "---- " "-- ------" "- -" "- ---- -" "- - -" "-- -H - -" " - - - -" " - ---- -" " - B-" " --------"]
|
|
#ULDRDLU
|
|
set hole05 [list "------" "-B--H-" "- H-" "- -- -" "- -- -" "- -" "-B -" "------"]
|
|
#DRU
|
|
set hole06 [list "..----" ".- H-" "- H-" "- ---" "- -" "--- -" "- -" "- ---" "- -" "-B B-" "------"]
|
|
#LURULUR
|
|
set hole07 [list "-----.." "-H ---" "--- H-" "..- ---" "..- -.." "..- -.." "..- -.." ".-- -.." ".-BB-.." ".----.."]
|
|
#URULR
|
|
set hole08 [list "--------" "-BH B-" "- H-" "- -" "- -" "-H -" "-B HB-" "--------"]
|
|
#ULDR
|
|
set hole09 [list "-----." "- H-." "- H-." "- H-." "- ---." "- --.." "- -.." "- -." "-BBB -" "------"]
|
|
#ULUR
|
|
set hole10 [list "..---..." "..-B-..." "---B----" "-H-B--W-" "- - -- -" "- - H- -" "- - -- -" "- -" "------ -" "-H -" "--------"]
|
|
#DRDLU
|
|
set hole11 [list ".---...." ".-H-...." ".- -----" "--B -" "-H -" "-- B-" ".- ---" ".- BH-." ".------."]
|
|
#RULU
|
|
set hole12 [list "..----.." "..-H -.." "--- ---" "-B -" "-B S -" "--- ---" "..-H -.." "..----.."]
|
|
#RDLUL
|
|
set hole13 [list "----..----" "-H-----H--" "-H BBBB H-" "-- WWWW --" ".- WWWW -." ".- WWWW -." "-- WWWW --" "-H BBBB H-" "-H-----H--" "----..----"]
|
|
#LRULUD
|
|
set hole14 [list "------.." "-H --." "- --" "- WBBW-" "- WWBBW-" "- WWWWW-" "-HWW----" "-HW--..." "----...."]
|
|
#ULRULD
|
|
set hole15 [list "..------.." "---H ---" "-H-- -H-" "-H-S -" "- - S -" "- S -" "- S -" "--- ---" "..-BBBB-.." "..------.."]
|
|
#ULURUL
|
|
set hole16 [list "---- ----" "- H- -BW-" "-WB- -H -" "---- ----" " " "---- ----" "- W- -H -" "-BH- -WB-" "---- ----"]
|
|
#ULDR
|
|
set hole17 [list "--------- " "- - " "- - " "- WBBW - " "- WWWW --" "- WWWW H-" "- --" "- -- " "-H------ " "--- "]
|
|
#URDLURDRLD
|
|
set hole18 [list " --- " " ---H-- " " ----B - " "-- - " "-H S -- " "-- S B- " " -B S --" " -- S H-" " - --" " - B---- " " --H--- " " --- "]
|
|
#URLUDLRD
|
|
set hole19 [list "--------" "-H H-" "-H H-" "-- BB --" " -B B- " " -B B- " "-- BB --" "-H H-" "-H H-" "--------"]
|
|
#ULDLR
|
|
set hole20 [list "------- " "- WSW - " "- S S--------" "-S S B--WSBWH-" "- W --S SW -" "-HWSSW-- SWWS-" "--------S SW -" " -WS -" " -------"]
|
|
#LUDLDRDRUU
|
|
set hole21 [list "--------" "- H-" "-- -- --" " - -- - " " -R R- " " - -- - " " -B-- - " "--------"]
|
|
#LULUR
|
|
set hole22 [list "-----------" "-HR R B-" "-- - - - --" "-- - - - --" "-B R RH-" "-----------"]
|
|
#URDRDRDL
|
|
set hole23 [list "---- ---" "- ---- -" "- R -" "-- ---- -" " - - -R-" " -R- - -" " - ---- -" " -HR-B -" "------- -" " ---"]
|
|
#RULULD
|
|
set hole24 [list "..---.." "---H---" "- -" "- RRR -" "--RBR--" "- RRR -" "- -" "--- ---" " --- "]
|
|
#LDLU
|
|
set hole25 [list "---------" "- RRBRW-" "- -------" "- -------" "- HW-" "---------"]
|
|
#LDLDLDRDRDR
|
|
set hole26 [list "----------" "-H--BR--0-" "-1-- -- -" "- -" "----------"]
|
|
#DRULU
|
|
set hole27 [list "-------." "-H1 -." "---- --." "-0-- ---" "- RB-0-" "---BR -" "..- ----" ".-- ----" ".- 1H-" ".-------"]
|
|
#DRULULR
|
|
set hole28 [list " --- " " -0------- " " -R- - - - " "------ - - ---" "-H1H1 1H-" "------1-1-1---" " - - - - " " -B-B-B- " " ------- "]
|
|
#UDLULDLUR
|
|
set hole29 [list "...----..." "...-HH-..." "----11----" "-B S 0-" "-B S 0-" "--- ---" "--- ---" "-W S B-" "-W S B-" "---- ----" "...-HH-..." "...----..."]
|
|
#LURULDD
|
|
set hole30 [list "-------." "-H S W-." "--- ---." "-W S H-." "---1----" ".-0 R-" ".--- ---" "..-R -" "..--- --" "...-BB-." "...----."]
|
|
#URULULUULUR
|
|
set hole31 [list "-----------..." "-RRRR-BBBB-..." "- ----- -..." "- - ----" "--- - ---HH-" "-0000- 1HH-" "--------------"]
|
|
#DLDRDLDRDLDRU
|
|
set hole32 [list " --- " "------W- " "-BRBBBB- " "------ - " " - ---" " --- -H-" " -H- - -" " - - H-" " -H ---" " -- -- " " -H- " " --- "]
|
|
#DRDRDRDLRURDLDLUD
|
|
|
|
|
|
# Tipos de tile
|
|
# -> Grass
|
|
# B -> Ball
|
|
# C -> Ball over Hole in
|
|
# D -> Rock over Hole in
|
|
# H -> Hole
|
|
# I -> Ball in hole
|
|
# J -> Rock over hole
|
|
# W -> Water
|
|
# S -> Sand
|
|
# T -> Ball in Sand disable move
|
|
# U -> Ball in Sand enabled move
|
|
# R -> Rock
|
|
# 0 -> Switch
|
|
# 1 -> Door
|
|
# 2 -> Opened door
|
|
# 3 -> Ball over switch
|
|
# 4 -> Rock over switch
|
|
# 5 -> Ball over opened door
|
|
# 6 -> Rock over opened door
|
|
|
|
|
|
# Convertir una mapa en un vector per a treballar
|
|
proc convertMap { map } {
|
|
set premoves ""
|
|
set j 0
|
|
foreach row $map {
|
|
for { set i 0 } { $i<[string length $row] } { incr i } {
|
|
set state($i,$j) [string range $row $i $i]
|
|
}
|
|
incr j
|
|
}
|
|
set result [list [list "$premoves" [array get state]]]
|
|
return $result
|
|
}
|
|
|
|
# traure un estat de la cua
|
|
proc popState { state } {
|
|
upvar 1 $state st
|
|
set moves [lindex [lindex $st 0] 0]
|
|
set map [lindex [lindex $st 0] 1]
|
|
set st [lreplace $st 0 0]
|
|
return [list $moves $map]
|
|
}
|
|
|
|
# obtindre l'objecte que està en el tile "B= bola, R= bola marron"
|
|
proc objectInTile { tile } {
|
|
set result ""
|
|
switch -- $tile {
|
|
" " -
|
|
"H" -
|
|
"W" -
|
|
"S" -
|
|
"0" -
|
|
"1" -
|
|
"2" { set result "" }
|
|
"B" -
|
|
"C" -
|
|
"I" -
|
|
"T" -
|
|
"U" -
|
|
"3" -
|
|
"5" { set result "B" }
|
|
"D" -
|
|
"J" -
|
|
"R" -
|
|
"4" -
|
|
"6" { set result "R" }
|
|
}
|
|
return $result
|
|
}
|
|
|
|
# Com se queda el tile si se mou l'objecte que hi ha en ell
|
|
proc leaveTile { from_tile } {
|
|
set new_tile ""
|
|
switch -- $from_tile {
|
|
"B" -
|
|
"R" { set new_tile " " }
|
|
"C" -
|
|
"D" { set new_tile "I" }
|
|
"U" { set new_tile "S" }
|
|
"J" { set new_tile "H"}
|
|
"3" -
|
|
"4" { set new_tile "0"}
|
|
"5" -
|
|
"6" { set new_tile "2"}
|
|
}
|
|
return $new_tile
|
|
}
|
|
|
|
# Com se queda el tile si entra un objecte a ell
|
|
proc enterTile {from_tile to_tile} {
|
|
set new_tile ""
|
|
set object [objectInTile $from_tile]
|
|
if { $object=="B" } {
|
|
switch -- $to_tile {
|
|
" " { set new_tile "B" }
|
|
"H" { set new_tile "I" }
|
|
"I" { set new_tile "C" }
|
|
"W" { set new_tile "W" }
|
|
"S" { set new_tile "T" }
|
|
"0" { set new_tile "3" }
|
|
"2" { set new_tile "5"}
|
|
}
|
|
} elseif { $object=="R" } {
|
|
switch -- $to_tile {
|
|
" " { set new_tile "R" }
|
|
"H" { set new_tile "J" }
|
|
"I" { set new_tile "D" }
|
|
"W" { set new_tile "W" }
|
|
#"S" { set new_tile "T" }
|
|
"0" { set new_tile "4" }
|
|
"2" { set new_tile "6"}
|
|
}
|
|
}
|
|
return $new_tile
|
|
}
|
|
|
|
# Es un tile que te un objecte que es pot moure
|
|
proc movableTile { tile } {
|
|
set result 0
|
|
if { $tile=="B" || $tile=="C" || $tile=="U" || $tile=="R" || $tile=="D" ||
|
|
$tile=="J" || $tile=="3" || $tile=="4" || $tile=="5" || $tile=="6" } {
|
|
set result 1
|
|
}
|
|
return $result
|
|
}
|
|
|
|
# Es un tile que no se pot atravesar
|
|
proc isWall { tile } {
|
|
set result 0
|
|
if { $tile=="-" || $tile=="B" || $tile=="R" || $tile=="3" || $tile=="4" ||
|
|
$tile=="1" || $tile=="5" || $tile=="6" || $tile=="U" || $tile=="T" ||
|
|
$tile=="J" || $tile=="D" || $tile=="C" } {
|
|
set result 1
|
|
}
|
|
return $result
|
|
}
|
|
|
|
# Moure l'estat del mapa donat un moviment "move"
|
|
proc changeState { move state } {
|
|
# Segons la direcció se processa el mapa en un sentit concret
|
|
if { $move=="U" } {
|
|
set dmove [list 0 -1]
|
|
set j0 0; set j1 $::MAP_HEIGHT; set dj 1
|
|
set i0 0; set i1 $::MAP_WIDTH; set di 1
|
|
}
|
|
if { $move=="D" } {
|
|
set dmove [list 0 1]
|
|
set j0 [expr $::MAP_HEIGHT-1]; set j1 -1; set dj -1
|
|
set i0 0; set i1 $::MAP_WIDTH; set di 1
|
|
}
|
|
if { $move=="L" } {
|
|
set dmove [list -1 0]
|
|
set j0 0; set j1 $::MAP_HEIGHT; set dj 1
|
|
set i0 0; set i1 $::MAP_WIDTH; set di 1
|
|
}
|
|
if { $move=="R" } {
|
|
set dmove [list 1 0]
|
|
set j0 0; set j1 $::MAP_HEIGHT; set dj 1
|
|
set i0 [expr $::MAP_WIDTH-1]; set i1 -1; set di -1
|
|
}
|
|
|
|
# decodificar l'estat
|
|
set premoves [lindex $state 0]
|
|
set map [lindex $state 1]
|
|
set width $::MAP_WIDTH
|
|
set height $::MAP_HEIGHT
|
|
|
|
# convertir el mapa a vector
|
|
array set arrmap $map
|
|
|
|
# Habilitar el movimente de boles en arena
|
|
foreach {pos tile} [array get arrmap] {
|
|
if { $tile=="T" } { set arrmap($pos) "U" }
|
|
}
|
|
|
|
set nmoves 1
|
|
set total_moves 0
|
|
set iter 0; # Salvaguarda per si se lia dins del bucle
|
|
# Fer moviments fins que res es moga
|
|
# A cada iteració mou cada objecte que es puga al següent tile que li corresponga
|
|
while { $nmoves>0 && $iter<9 } {
|
|
set nmoves 0
|
|
set j $j0
|
|
while { $j!=$j1 } {
|
|
set i $i0
|
|
while { $i!=$i1 } {
|
|
set x $i; set y $j
|
|
set tile $arrmap(${x},${y})
|
|
if { [movableTile $tile]==1 } {
|
|
set test_x [expr $x+[lindex $dmove 0]]
|
|
set test_y [expr $y+[lindex $dmove 1]]
|
|
|
|
if { [isWall $arrmap(${test_x},${test_y})]==1 } {
|
|
# "WALL"
|
|
if { $tile=="U" } { set arrmap(${x},${y}) "T" }
|
|
#set end_move 1
|
|
#set arrmap(${new_x},${new_y}) "B"
|
|
} else {
|
|
set arrmap(${x},${y}) [leaveTile $tile]
|
|
set arrmap(${test_x},${test_y}) [enterTile $tile $arrmap(${test_x},${test_y})]
|
|
incr nmoves
|
|
|
|
# check switches
|
|
set switches 0
|
|
foreach {pos tile} [array get arrmap] { if { $tile=="0" } { incr switches } }
|
|
|
|
if { $switches==0 } {
|
|
# open doors
|
|
foreach {pos tile} [array get arrmap] {
|
|
if { $tile=="1" } { set arrmap($pos) "2" }
|
|
}
|
|
} else {
|
|
# close doors
|
|
foreach {pos tile} [array get arrmap] {
|
|
if { $tile=="2" } { set arrmap($pos) "1" }
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
set i [expr $i+$di]
|
|
}
|
|
set j [expr $j+$dj]
|
|
}
|
|
set total_moves [expr $total_moves+$nmoves]
|
|
incr iter
|
|
}
|
|
|
|
if { $total_moves==0 } {
|
|
# Si no s'ha fet cap moviment se descarta l'estat
|
|
set result [list ]
|
|
} else {
|
|
set result [list "${premoves}${move}" [array get arrmap]]
|
|
# Comprobar si ja s'ha processat un estat igual anteriorment
|
|
set seen [llength $::STATES_SEEN]
|
|
addLeaf $result
|
|
if { $seen==[llength $::STATES_SEEN] } { set result [list ] }
|
|
}
|
|
return $result
|
|
}
|
|
|
|
# comprobar si queda algun forat sense bola
|
|
proc checkHoles { state } {
|
|
set premoves [lindex $state 0]
|
|
set map [lindex $state 1]
|
|
set found 0
|
|
# H -> Hole
|
|
# J -> Rock over hole
|
|
foreach {pos tile} $map {
|
|
if { $tile=="H" || $tile=="J" } {
|
|
set found 1
|
|
break
|
|
}
|
|
}
|
|
return $found
|
|
}
|
|
|
|
# pintar en pantalla un estat
|
|
proc drawState { state } {
|
|
set premoves [lindex $state 0]
|
|
puts "$premoves"
|
|
array set map [lindex $state 1]
|
|
for { set j 0 } { $j<$::MAP_HEIGHT } { incr j } {
|
|
set row ""
|
|
for { set i 0 } { $i<$::MAP_WIDTH } { incr i } {
|
|
set tile $map(${i},${j})
|
|
set row "${row}${tile}"
|
|
}
|
|
puts $row
|
|
}
|
|
puts "+++++++++++++++++++++++++++++++++++++++"
|
|
}
|
|
|
|
# afegir a la llista d'estats processats
|
|
# cada estat se convertix a un crc32
|
|
proc addLeaf { state } {
|
|
set data [list ]
|
|
array set map [lindex $state 1]
|
|
for { set j 0 } { $j<$::MAP_HEIGHT } { incr j } {
|
|
set row ""
|
|
for { set i 0 } { $i<$::MAP_WIDTH } { incr i } {
|
|
set tile $map(${i},${j})
|
|
set row "${row}${tile}"
|
|
}
|
|
lappend data $row
|
|
}
|
|
lappend ::STATES_SEEN [::crc::crc32 $data]
|
|
set ::STATES_SEEN [lsort -unique $::STATES_SEEN]
|
|
}
|
|
|
|
# buscar solució per a un mapa
|
|
proc solveMap { map } {
|
|
set states [convertMap $map]
|
|
set nmoves 0
|
|
set found 0
|
|
set newstates [list ]
|
|
set solution "NOT FOUND"
|
|
set MAX_PAR 21
|
|
set ::MAP_WIDTH [string length [lindex $map 0]]
|
|
set ::MAP_HEIGHT [llength $map]
|
|
set moves [list U D L R]
|
|
set ::STATES_SEEN [list ]
|
|
|
|
while { $found==0 && $nmoves<$MAX_PAR && [llength $states]>0} {
|
|
set state [popState states]
|
|
addLeaf $state
|
|
foreach move $moves {
|
|
set newstate [changeState $move $state]
|
|
if { $newstate!="" } {
|
|
lappend newstates $newstate
|
|
set nmoves [string length [lindex $newstate 0 0]]
|
|
if { [checkHoles $newstate]==0 } {
|
|
set found 1
|
|
set solution [lindex $newstate 0 0]
|
|
break
|
|
}
|
|
}
|
|
}
|
|
if { $found==0 && [llength $states]==0 } {
|
|
set states $newstates
|
|
set newstates [list ]
|
|
}
|
|
}
|
|
return $solution
|
|
}
|
|
|
|
# mostrar els estats per a un mapa donada una solució "moves_list"
|
|
proc solveMap2 { map moves_list } {
|
|
set states [convertMap $map]
|
|
set nmoves 0
|
|
set found 0
|
|
set newstates [list ]
|
|
set solution "NOT FOUND"
|
|
set MAX_PAR 21
|
|
set ::MAP_WIDTH [string length [lindex $map 0]]
|
|
set ::MAP_HEIGHT [llength $map]
|
|
#set moves [list U D L R]
|
|
set ::STATES_SEEN [list ]
|
|
|
|
foreach moves $moves_list {
|
|
set state [popState states]
|
|
foreach move $moves {
|
|
set newstate [changeState $move $state]
|
|
if { $newstate!="" } {
|
|
drawState $newstate
|
|
update idletasks
|
|
lappend newstates $newstate
|
|
set nmoves [string length [lindex $newstate 0 0]]
|
|
if { [checkHoles $newstate]==0 } {
|
|
set found 1
|
|
set solution [lindex $newstate 0 0]
|
|
break
|
|
}
|
|
}
|
|
}
|
|
if { $found==0 && [llength $states]==0 } {
|
|
set states $newstates
|
|
set newstates [list ]
|
|
}
|
|
}
|
|
return $solution
|
|
}
|
|
|
|
# # Resoldre un mapa
|
|
# solveMap $hole01
|
|
|
|
# # Resoldre tots el mapes
|
|
# for {set i 1 } { $i<=32 } { incr i } {
|
|
# set moves [solveMap [subst $[subst hole[format %02d $i]]]]
|
|
# puts "[format %02d $i]\t[string length $moves]\t$moves"
|
|
# } |