commit 42f3c6e145a78551ec1618dea65646cd109d577d
Author: JailGamer <jailgamer@gmail.com>
Date:   Thu Oct 28 16:38:14 2021 +0200

    first release

diff --git a/tiny_solver.tcl b/tiny_solver.tcl
new file mode 100644
index 0000000..5edc737
--- /dev/null
+++ b/tiny_solver.tcl
@@ -0,0 +1,441 @@
+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"
+# }
\ No newline at end of file