### Posted to tcl by kbk at Wed Apr 04 19:00:19 GMT 2018view raw

1. # Try to do this as neatly without coros, or with only stackless coros.
2. # Note that the requirement is that the program run in space only proportional
3. # to the tree depth, not the tree size, and in time proportional to the tree size.
4.
5. # some examples of binary trees
6.
7. set tree1 {{a {b {}}} {{c {}} {d {e {}}}}}
8. set tree2 {{{{{} a} b} {{} c}} {{{} d} e}}
9. set tree3 {{{{{} a} x} {{} c}} {{{} d} e}}
10. set tree4 {{{{{} a} b} {{} c}} {{} d}}
11.
12. # coroutine launcher for a tree walker that lists fringe nodes
13.
14. proc walker {tree} {
15. yield [info coroutine]
16. worker \$tree
17. return {}
18. }
19.
20. # Tree walker that visits fringe nodes, left to right
21.
22. proc worker {tree} {
23. if {[llength \$tree] == 0} {
24. return
25. } elseif {[llength \$tree] == 1} {
26. yield \$tree
27. } else {
28. worker [lindex \$tree 0]
29. worker [lindex \$tree 1]
30. }
31. }
32.
33. # Procedure to test whether two trees have the same fringe, in space
34. # proportional only to tree depth and linear time in tree size
35.
36. proc samefringe {tree1 tree2} {
37. coroutine w1 walker \$tree1
38. coroutine w2 walker \$tree2
39. while {[set leaf1 [w1]] eq [set leaf2 [w2]]} {
40. if {\$leaf1 eq {}} {
41. return true
42. }
43. }
44. if {\$leaf1 ne {}} {rename w1 {}}
45. if {\$leaf2 ne {}} {rename w2 {}}
46. return false
47. }
48.
49. # Demonstrate samefringe
50.
51. puts [samefringe \$tree1 \$tree2]
52. puts [samefringe \$tree1 \$tree3]
53. puts [samefringe \$tree1 \$tree4]
54.