TCL:在长期递归计算过程中避免超时/无反应性愿望窗口



我已经编写了一个脚本,该脚本将递归调用Proc,直到达到解决方案为止。问题是我的愿望窗口变得无反应。它没有打印我添加的记录的看台语句。我了解脚本在计算中很忙,但是为什么这些证券没有打印到Stdout?

如何在如此长的递归过程中保持脚本/愿望窗口活着。

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]"    

您正在使用愿望,这就是为什么您需要Tk命令updateupdate 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
    . . .

Windows TK控制台实际上在主线程中的单独的解释器上下文中运行。它具有自己的TK窗口层次结构,但与您的TCL代码共享一个主要事件循环。不幸的是,这意味着,如果您在主解释器中运行TCL代码非常忙(例如,通过进行大量处理(,它将停止处理控制台中的显示显示更新。文本在窗口模型中存在,但是要处理的实际代码作为真实的显示更新在空闲事件中计划的回调中。

修复程序是将updateupdate idletasks放入某个地方的主处理环内。后者足以从puts调用中处理显示更新,但是前者允许您与窗口进行交互(例如,滚动(。不足的一面是,您也可以在主窗口中处理其他事件,并且您要么需要小心作为用户,要么更新GUI,以便在漫长的处理过程中锁定人们。这样做的方法有很多,但是如果仅仅是为了您自己的使用,那么"只需小心"的方法就可以了。

相关内容

  • 没有找到相关文章

最新更新