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.