Posted to tcl by kbk at Wed Apr 04 19:00:19 GMT 2018view pretty
# Try to do this as neatly without coros, or with only stackless coros. # Note that the requirement is that the program run in space only proportional # to the tree depth, not the tree size, and in time proportional to the tree size. # some examples of binary trees set tree1 {{a {b {}}} {{c {}} {d {e {}}}}} set tree2 {{{{{} a} b} {{} c}} {{{} d} e}} set tree3 {{{{{} a} x} {{} c}} {{{} d} e}} set tree4 {{{{{} a} b} {{} c}} {{} d}} # coroutine launcher for a tree walker that lists fringe nodes proc walker {tree} { yield [info coroutine] worker $tree return {} } # Tree walker that visits fringe nodes, left to right proc worker {tree} { if {[llength $tree] == 0} { return } elseif {[llength $tree] == 1} { yield $tree } else { worker [lindex $tree 0] worker [lindex $tree 1] } } # Procedure to test whether two trees have the same fringe, in space # proportional only to tree depth and linear time in tree size proc samefringe {tree1 tree2} { coroutine w1 walker $tree1 coroutine w2 walker $tree2 while {[set leaf1 [w1]] eq [set leaf2 [w2]]} { if {$leaf1 eq {}} { return true } } if {$leaf1 ne {}} {rename w1 {}} if {$leaf2 ne {}} {rename w2 {}} return false } # Demonstrate samefringe puts [samefringe $tree1 $tree2] puts [samefringe $tree1 $tree3] puts [samefringe $tree1 $tree4]