Posted to tcl by kbk at Wed Apr 04 19:00:19 GMT 2018view raw
- # 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]