Posted to tcl by aspect at Thu Nov 19 04:16:19 GMT 2015view pretty
proc fixpoint {varName script} { upvar 1 $varName arg while {[set res [uplevel 1 $script]] ne $arg} { set arg $res } return $res } proc dfs {cmdPrefix seed} { set stack [list $seed] set result {} while {[llength $stack]} { set stack [lassign $stack seed] lappend result $seed set stack [linsert $stack 0 {*}[uplevel 1 $cmdPrefix [list $seed]]] } return $result } # ^^ -- not used in this example, but relevant variations on [bfs] -- ^^ proc bfs {varName script} { upvar 1 $varName seed set queue [list $seed] set result {} while {[llength $queue]} { set queue [lassign $queue seed] lappend result $seed lappend queue {*}[uplevel 1 $script] } } set arclist { a b a p b m b c c d d e e f f q f g } foreach {from to} $arclist { dict lappend arcs $from $to } proc findpath {arcs from to} { set path [list $from] set good {} bfs {path} { set node [lindex $path end] if {[dict exists $arcs $node]} { lmap next [dict get $arcs $node] { if {$next in $to} { lappend good [list {*}$path $next] } list {*}$path $next } } } return $good } puts [findpath $arcs a {k l g}]