Question

我编写了一个脚本，它将以递归方式调用proc，直到实现解决方案。问题是我的愿望窗口同时没有反应。它不会打印我为记录添加的puts语句。我理解脚本在计算中很忙，但为什么不把这些put打印到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]"

Answer 1

您正在使用Wish，这就是您需要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}

现在我可以在执行过程中看到输出。

尝试在第一个update之后添加puts命令：

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，以便在长时间处理过程中锁定人员。有很多不同的方法，但如果只是为了你自己的使用，“只是小心”的方法工作正常。

TCL：在长时间递归计算期间避免超时/无响应的愿望窗口

2 个答案: