TCL：在長遞歸計算中避免超時/無響應願望窗口

Question

我寫了一個腳本，它將遞歸調用proc，直到達到解決方案。問題是我的願望窗口正在變得沒有反應，同時。它不打印我爲記錄添加的puts語句。我知道腳本在計算中很忙，但爲什麼這些輸入不會打印到標準輸出？

如何在如此長的遞歸過程調用期間保持腳本/希望窗口活着。這裏是完整的腳本。

namespace eval chainReactionGlobal { 
    #variable state [list 0 0 0 0 0 0 0 0 0] 
    variable pos  [list 0 1 2 3 4 5 6 7 8] 
    variable posMax [list 1 2 1 2 3 2 1 2 1] 
    variable burstPos [list {1 3} {0 2 4} {1 5} {0 4 6} {1 3 5 7} {2 4 8} {3 7} {4 6 8} {5 7}] 
    variable players [list A B C] 
    variable boxLen 3 
    variable boxWidth 3 
} 

proc ShowGraphicalState {state} { 
    set length $chainReactionGlobal::boxLen 
    set width $chainReactionGlobal::boxWidth 
    puts "\n" 
    puts "--------------------" 
    puts -nonewline "\| [lindex $state 0][string repeat " " [expr 4-[string length [lindex $state 0]]]]\|" 
    puts -nonewline "\| [lindex $state 1][string repeat " " [expr 4-[string length [lindex $state 1]]]]\|" 
    puts -nonewline "\| [lindex $state 2][string repeat " " [expr 4-[string length [lindex $state 2]]]]\|" 
    puts "\n--------------------" 
    puts -nonewline "\| [lindex $state 3][string repeat " " [expr 4-[string length [lindex $state 3]]]]\|" 
    puts -nonewline "\| [lindex $state 4][string repeat " " [expr 4-[string length [lindex $state 4]]]]\|" 
    puts -nonewline "\| [lindex $state 5][string repeat " " [expr 4-[string length [lindex $state 5]]]]\|" 
    puts "\n--------------------" 
    puts -nonewline "\| [lindex $state 6][string repeat " " [expr 4-[string length [lindex $state 6]]]]\|" 
    puts -nonewline "\| [lindex $state 7][string repeat " " [expr 4-[string length [lindex $state 7]]]]\|" 
    puts -nonewline "\| [lindex $state 8][string repeat " " [expr 4-[string length [lindex $state 8]]]]\|" 
    puts "\n--------------------" 
} 

proc GetNextPlayer {currentPlayer} { 
    set currIdx [lsearch $chainReactionGlobal::players $currentPlayer] 
    if {[expr $currIdx+1]<[llength $chainReactionGlobal::players ]} { 
     return [lindex $chainReactionGlobal::players [expr $currIdx+1]] 
    } else { 
     return [lindex $chainReactionGlobal::players 0] 
    }  
} 

# ------------------------------------------------------------------------ 
# This function will take input of a stable state and current player, will 
# return list of possible unstable state the current player can make. 
# ------------------------------------------------------------------------ 
proc GetPossibleStateMatrix {stableState currentPlayer} { 
    array set stateList {} 

    foreach position $chainReactionGlobal::pos { 

     set localState $stableState 
     set currentPosValue [lindex $localState $position] 
     if {$currentPosValue=="0"} { 
      lset localState $position [string repeat $currentPlayer 1] 
     set stateList($position) $localState 
     } elseif {[regexp -all $currentPlayer $currentPosValue]>0} { 
      lset localState $position $currentPosValue$currentPlayer 
      set stateList($position) $localState 
     } 


    } 

    return [array get stateList] 
} 



proc GetStabilizedState {unstableState impactPosList} { 
    set isStable 0 
    set affectedPosList {} 
    while {!$isStable} { 
     foreach position $impactPosList { 
      set posValue [lindex $unstableState $position] 
      if { $posValue=="0"} { 
        set posLength 0 
      } else { 
       set posLength [string length $posValue] 
      } 
      set posMaxLength [lindex $chainReactionGlobal::posMax $position] 

      if {($posLength>$posMaxLength)} { 
       if {[expr $posLength-$posMaxLength-1] > 0} { 
        lset unstableState $position [string repeat [string range $posValue 0 0] [expr [expr $posLength-$posMaxLength]-1]] 
       } else { 
        lset unstableState $position "0" 
       } 

       foreach affectedPos [lindex $chainReactionGlobal::burstPos $position] { 
        set affectedPosValue [lindex $unstableState $affectedPos] 
        if { $affectedPosValue =="0"} { 
         set affectedPosValueLength 0 
        } else { 
         set affectedPosValueLength [string length $affectedPosValue] 
        } 
        set affectedPosMaxLength [lindex $chainReactionGlobal::posMax $affectedPos] 

        if {[expr $affectedPosValueLength+1]>$affectedPosMaxLength } { 
         if {[lsearch $affectedPosList $affectedPos ] ==-1} { 
          lappend affectedPosList $affectedPos 
         } 
        } 
        lset unstableState $affectedPos [string repeat [string range $posValue 0 0] [expr 1+$affectedPosValueLength]]  
       } 
      } 
     } 

     set isStable 1 
     foreach position $chainReactionGlobal::pos { 
      set posValue [lindex $unstableState $position] 
     if { $posValue=="0"} { 
       set posLength 0 
     } else { 
      set posLength [string length $posValue] 
     } 
     set posMaxLength [lindex $chainReactionGlobal::posMax $position] 
      if {($posLength>$posMaxLength) && ($posValue!="0")} { 
       set isStable 0 
      } 
     } 

     if {$isStable==1} { 
      return $unstableState 
     } 
     set impactPosList $affectedPosList 
    } 

} 


proc IsImmediateWin {state currentPlayer} { 
    foreach elem $state { 
     if {$elem==0} { 
      continue 
     } elseif {[regexp $currentPlayer $elem]} { 
      continue 
     } else { 
      return 0 
     } 
    } 
    return 1 
} 

    proc GetWinRatio {state myPlayer currentPlayer {test 0}} { 

     puts "test $test state $state myPlayer $myPlayer currentPlayer $currentPlayer" 

     set loss 0 
     set win 0 
     set possibleStateList [GetPossibleStateMatrix $state $currentPlayer] 
     array set possibleStateArr $possibleStateList 
     # puts possibleStateList$possibleStateList 
     foreach possiblePos [lsort [array names possibleStateArr]] { 
      set possibleState $possibleStateArr($possiblePos) 
      puts "possibleState ----> $possibleState       possiblePos $possiblePos" 
      set stableState [GetStabilizedState $possibleState $possiblePos] 
      puts "stableState ----> $stableState" 


      if {[IsImmediateWin $stableState $currentPlayer]} { 
       if {$currentPlayer==$myPlayer } { 
        incr win 
       } else { 
        incr loss 
       } 
      } else { 
      puts "not immediate win" 

       set result [GetWinRatio $stableState $myPlayer [GetNextPlayer $currentPlayer] [expr $test+1] ] 
       # set result "0:0" 
       set winRes [lindex [split $result ":"] 0] 
       set lossRes [lindex [split $result ":"] 1] 

       incr win $winRes 
       incr loss $lossRes 
      } 
      # puts "state [ShowGraphicalState $stableState] wins:$win loss:$loss" 

     } 
     return ${win}:${loss} 
    } 
    puts "[GetWinRatio [list A CC A A B B A B C] A A]"  

Answer 1

您使用的願望，那就是爲什麼你需要一個Tk命令update或update idletasks。在控制檯中使用tclsh時，不需要此命令。

由於功能GetPossibleStateMatrix不存在，我無法測試您的代碼。 這樣所以，我測試代碼：

for {set i 0} {$i < 10000} {incr i} {puts $i} 

是的，沒有輸出，直到執行結束。所以，我已經添加update命令：

for {set i 0} {$i < 10000} {incr i} {puts $i; update} 

現在我可以看到在執行過程中的輸出。

試試你的第一puts後添加update命令：

proc GetWinRatio {state myPlayer currentPlayer {test 0}} { 

    puts "test $test state $state myPlayer $myPlayer currentPlayer $currentPlayer" 
    update 
    . . . 

Answer 2

在Windows控制檯Tk的實際上是在主線程單獨解釋上下文中運行。它有自己的Tk窗口層次結構，但與Tcl代碼共享主事件循環。不幸的是，這意味着如果您讓主解釋器中運行的Tcl代碼非常繁忙（例如，通過執行大量處理），則停止在控制檯中處理顯示更新。文本出現在窗口模型中，但實際顯示更新所處理的代碼位於空閒事件中計劃的回調中。

修復方法是將update或update idletasks放在主處理循環內某處。後者足以處理來自puts調用的顯示更新，但前者允許您與窗口交互（例如，滾動它）。不利的一面是你可以在你的主窗口中處理其他事件，並且你或者需要小心地作爲用戶或者更新你的GUI，以便在長時間處理過程中將人員鎖定。有很多不同的方法可以做到這一點，但如果只是爲了您自己的用途，「小心」的方法很好。