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]