Same fringe: Difference between revisions
Walterpachl (talk | contribs) m (REXX moved to proper place) |
Walterpachl (talk | contribs) (REXX Version 2 not using father node) |
||
Line 522: | Line 522: | ||
=={{header|REXX}}== |
=={{header|REXX}}== |
||
===Version 1 father node === |
|||
<lang REXX>/* REXX *************************************************************** |
<lang REXX>/* REXX *************************************************************** |
||
* Same Fringe |
* Same Fringe |
||
Line 709: | Line 712: | ||
First difference H <> * |
First difference H <> * |
||
</pre> |
</pre> |
||
===Version 2 without using father node === |
|||
/lang rexx>/* REXX *************************************************************** |
|||
* Same Fringe |
|||
= 1 A A |
|||
= / \ / \ / \ |
|||
= / \ / \ / \ |
|||
= / \ / \ / \ |
|||
= 2 3 B C B C |
|||
= / \ / / \ / / \ / |
|||
= 4 5 6 D E F D E F |
|||
= / / \ / / \ / / \ |
|||
= 7 8 9 G H I G * I |
|||
= |
|||
* 23.08.2012 Walter Pachl derived from |
|||
* http://rosettacode.org/wiki/Tree_traversal |
|||
* Tree A: A B D G E C F H I |
|||
* Tree B: A B D G E C F * I |
|||
**********************************************************************/ |
|||
node.=0 |
|||
Call mktree 'A' |
|||
Call mktree 'B' |
|||
sideboard.=0 |
|||
za=root.a; leafa=node.a.za.0name |
|||
zb=root.b; leafb=node.b.zb.0name |
|||
Do i=1 To 20 Until za=0 & zb=0 |
|||
If leafa=leafb Then Do |
|||
Say leafa '=' leafb |
|||
Parse Value get_next(za,'A') with za leafa |
|||
Parse Value get_next(zb,'B') with zb leafb |
|||
End |
|||
Else Do |
|||
Select |
|||
When za=0 Then Say leafb 'exceeds tree A' |
|||
When zb=0 Then Say leafa 'exceeds tree B' |
|||
Otherwise Say leafa '<>' leafb |
|||
End |
|||
Leave |
|||
Exit |
|||
End |
|||
End |
|||
exit |
|||
get_next: Procedure Expose node. sideboard. |
|||
Parse Arg za,t |
|||
Select |
|||
When node.t.za.0left<>0 Then Do |
|||
If node.t.za.0rite<>0 Then Do |
|||
z=sideboard.t.0+1 |
|||
sideboard.t.z=node.t.za.0rite |
|||
sideboard.t.0=z |
|||
End |
|||
za=node.t.za.0left |
|||
End |
|||
When node.t.za.0rite<>0 Then Do |
|||
za=node.t.za.0rite |
|||
End |
|||
Otherwise Do |
|||
z=sideboard.t.0 |
|||
za=sideboard.t.z |
|||
z=z-1 |
|||
sideboard.t.0=z |
|||
End |
|||
End |
|||
Return za node.t.za.0name |
|||
mknode: Procedure Expose node. |
|||
/********************************************************************** |
|||
* create a new node |
|||
**********************************************************************/ |
|||
Parse Arg name,t |
|||
z=node.t.0+1 |
|||
node.t.z.0name=name |
|||
node.t.z.0father=0 |
|||
node.t.z.0left =0 |
|||
node.t.z.0rite =0 |
|||
node.t.0=z |
|||
Return z /* number of the node just created */ |
|||
attleft: Procedure Expose node. |
|||
/********************************************************************** |
|||
* make son the left son of father |
|||
**********************************************************************/ |
|||
Parse Arg son,father,t |
|||
node.t.son.0father=father |
|||
z=node.t.father.0left |
|||
If z<>0 Then Do |
|||
node.t.z.0father=son |
|||
node.t.son.0left=z |
|||
End |
|||
node.t.father.0left=son |
|||
Return |
|||
attrite: Procedure Expose node. |
|||
/********************************************************************** |
|||
* make son the right son of father |
|||
**********************************************************************/ |
|||
Parse Arg son,father,t |
|||
node.t.son.0father=father |
|||
z=node.t.father.0rite |
|||
If z<>0 Then Do |
|||
node.t.z.0father=son |
|||
node.t.son.0rite=z |
|||
End |
|||
node.t.father.0rite=son |
|||
le=node.t.father.0left |
|||
If le>0 Then |
|||
node.t.le.0brother=node.t.father.0rite |
|||
Return |
|||
mktree: Procedure Expose node. root. |
|||
/********************************************************************** |
|||
* build the tree according to the task |
|||
**********************************************************************/ |
|||
Parse Arg t |
|||
If t='A' Then Do |
|||
a=mknode('A',t); root.t=a |
|||
b=mknode('B',t); Call attleft b,a,t |
|||
c=mknode('C',t); Call attrite c,a,t |
|||
d=mknode('D',t); Call attleft d,b,t |
|||
e=mknode('E',t); Call attrite e,b,t |
|||
f=mknode('F',t); Call attleft f,c,t |
|||
g=mknode('G',t); Call attleft g,d,t |
|||
h=mknode('H',t); Call attleft h,f,t |
|||
i=mknode('I',t); Call attrite i,f,t |
|||
End |
|||
Else Do |
|||
a=mknode('A',t); root.t=a |
|||
b=mknode('B',t); Call attleft b,a,t |
|||
c=mknode('C',t); Call attrite c,a,t |
|||
d=mknode('D',t); Call attleft d,b,t |
|||
e=mknode('E',t); Call attrite e,b,t |
|||
f=mknode('F',t); Call attleft f,c,t |
|||
g=mknode('G',t); Call attleft g,d,t |
|||
h=mknode('*',t); Call attleft h,f,t |
|||
i=mknode('I',t); Call attrite i,f,t |
|||
End |
|||
Return</lang> |
|||
Output is the same as for Version 1 |
|||
=={{header|Tcl}}== |
=={{header|Tcl}}== |
Revision as of 13:03, 23 August 2012
Write a routine that will compare the leaves ("fringe") of two binary trees to determine whether they are the same list of leaves when visited left-to-right. The structure or balance of the trees does not matter; only the number, order, and value of the leaves is important.
Any solution is allowed here, but many computer scientists will consider it inelegant to collect either fringe in its entirety before starting to collect the other one. In fact, this problem is usually proposed in various forums as a way to show off various forms of concurrency (tree-rotation algorithms have also been used to get around the need to collect one tree first). Thinking of it a slightly different way, an elegant solution is one that can perform the minimum amount of work to falsify the equivalence of the fringes when they differ somewhere in the middle, short-circuiting the unnecessary additional traversals and comparisons.
Any representation of a binary tree is allowed, as long as the nodes are orderable, and only downward links are used (for example, you may not use parent or sibling pointers to avoid recursion).
C
With rudimentary coroutine support based on ucontext. I don't know if it will compile on anything other than GCC. <lang c>#include <stdio.h>
- include <stdlib.h>
- include <ucontext.h>
typedef struct { ucontext_t caller, callee; char stack[8192]; void *in, *out; } co_t;
co_t * co_new(void(*f)(), void *data) { co_t * c = malloc(sizeof(*c)); getcontext(&c->callee); c->in = data;
c->callee.uc_stack.ss_sp = c->stack; c->callee.uc_stack.ss_size = sizeof(c->stack); c->callee.uc_link = &c->caller; makecontext(&c->callee, f, 1, (int)c);
return c; }
void co_del(co_t *c) { free(c); }
inline void co_yield(co_t *c, void *data) { c->out = data; swapcontext(&c->callee, &c->caller); }
inline void * co_collect(co_t *c) { c->out = 0; swapcontext(&c->caller, &c->callee); return c->out; }
// end of coroutine stuff
typedef struct node node; struct node { int v; node *left, *right; };
node *newnode(int v) { node *n = malloc(sizeof(node)); n->left = n->right = 0; n->v = v; return n; }
void tree_insert(node **root, node *n) { while (*root) root = ((*root)->v > n->v) ? &(*root)->left : &(*root)->right; *root = n; }
void tree_trav(int x) { co_t *c = (co_t *) x;
void trav(node *root) { if (!root) return; trav(root->left); co_yield(c, root); trav(root->right); }
trav(c->in); }
int tree_eq(node *t1, node *t2) { co_t *c1 = co_new(tree_trav, t1); co_t *c2 = co_new(tree_trav, t2);
node *p = 0, *q = 0; do { p = co_collect(c1); q = co_collect(c2); } while (p && q && (p->v == q->v));
co_del(c1); co_del(c2); return !p && !q; }
int main() { int x[] = { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, -1 }; int y[] = { 2, 5, 7, 1, 9, 0, 6, 4, 8, 3, -1 }; int z[] = { 0, 1, 2, 3, 4, 5, 6, 8, 9, -1 };
node *t1 = 0, *t2 = 0, *t3 = 0;
void mktree(int *buf, node **root) { int i; for (i = 0; buf[i] >= 0; i++) tree_insert(root, newnode(buf[i])); }
mktree(x, &t1); // ordered binary tree, result of traversing mktree(y, &t2); // should be independent of insertion, so t1 == t2 mktree(z, &t3);
printf("t1 == t2: %s\n", tree_eq(t1, t2) ? "yes" : "no"); printf("t1 == t3: %s\n", tree_eq(t1, t3) ? "yes" : "no");
return 0; }</lang>
D
This version is quite long because it tries to be reliable. The code contains contracts, unit tests, annotations, and so on. <lang d>import std.array: empty; import std.algorithm: equal;
// Replace with an efficient stack when available in Phobos.
struct Stack(T) {
private T[] data;
public @property bool empty() const pure nothrow { return data.empty; }
// Can't be const if T isn't a value or const. public @property T head() const pure nothrow in { assert(!data.empty); } body { return data[$ - 1]; }
public void push(T x) pure nothrow { data ~= x; }
public void pop() pure nothrow in { assert(!data.empty); } body { data.length--; }
}
struct BinaryTreeNode(T) {
T data; BinaryTreeNode* left, right;
this(T x, BinaryTreeNode* l=null, BinaryTreeNode* r=null) pure nothrow { this.data = x; this.left = l; this.right = r; }
}
struct Fringe(T) {
alias const(BinaryTreeNode!T)* BT; private Stack!BT stack;
pure nothrow invariant() { assert(stack.empty || isLeaf(stack.head)); }
public this(BT t) pure nothrow { if (t != null) { stack.push(t); if (!isLeaf(t)) { // Here invariant() doesn't hold. // invariant() isn't called for private methods. nextLeaf(); } } }
public @property bool empty() const pure nothrow { return stack.empty; }
public @property T front() const pure nothrow in { assert(!stack.empty && stack.head != null); } body { return stack.head.data; }
public void popFront() pure nothrow in { assert(!stack.empty); } body { stack.pop(); if (!empty()) nextLeaf(); }
private static bool isLeaf(in BT t) pure nothrow { return t != null && t.left == null && t.right == null; }
private void nextLeaf() pure nothrow in { assert(!stack.empty); } body { auto t = stack.head;
while (!stack.empty && !isLeaf(t)) { stack.pop(); if (t.right != null) stack.push(t.right); if (t.left != null) stack.push(t.left); t = stack.head; } }
}
bool sameFringe(T)(in BinaryTreeNode!T* t1, in BinaryTreeNode!T* t2)
pure nothrow {
return Fringe!T(t1).equal(Fringe!T(t2));
}
unittest {
alias BinaryTreeNode!int N;
static N* n(in int x, N* l=null, N* r=null) pure nothrow { return new N(x, l, r); }
{ N* t; assert(sameFringe(t, t)); }
{ const t1 = n(10); const t2 = n(10); assert(sameFringe(t1, t2)); }
{ const t1 = n(10); const t2 = n(20); assert(!sameFringe(t1, t2)); }
{ const t1 = n(10, n(20)); const t2 = n(30, n(20)); assert(sameFringe(t1, t2)); }
{ const t1 = n(10, n(20)); const t2 = n(10, n(30)); assert(!sameFringe(t1, t2)); }
{ const t1 = n(10, n(20), n(30)); const t2 = n(5, n(20), n(30)); assert(sameFringe(t1, t2)); }
{ const t1 = n(10, n(20), n(30)); const t2 = n(5, n(20), n(35)); assert(!sameFringe(t1, t2)); }
{ const t1 = n(10, n(20, n(30))); const t2 = n(1, n(2, n(30))); assert(sameFringe(t1, t2)); }
{ const t1 = n(10, n(20, n(30, n(40), n(50)))); const t2 = n(1, n(2, n(3, n(40), n(50)))); assert(sameFringe(t1, t2)); }
{ const t1 = n(10, n(20, n(30, n(40), n(50)))); const t2 = n(1, n(2, n(3, n(40), n(51)))); assert(!sameFringe(t1, t2)); }
}
void main() {
import std.stdio; alias BinaryTreeNode!int N;
static N* n(in int x, N* l=null, N* r=null) pure nothrow { return new N(x, l, r); }
const t1 = n(10, n(20, n(30, n(40), n(50)))); writeln("fringe(t1): ", Fringe!int(t1));
const t2 = n(1, n(2, n(3, n(40), n(50)))); writeln("fringe(t2): ", Fringe!int(t2));
const t3 = n(1, n(2, n(3, n(40), n(51)))); writeln("fringe(t3): ", Fringe!int(t3));
writeln("sameFringe(t1, t2): ", sameFringe(t1, t2)); writeln("sameFringe(t1, t3): ", sameFringe(t1, t3));
}</lang>
- Output:
fringe(t1): [40, 50] fringe(t2): [40, 50] fringe(t3): [40, 51] sameFringe(t1, t2): true sameFringe(t1, t3): false
Haskell
Since Haskell is lazy, simply getting the fringes and comparing them for equality will do. It will only do as much as work as necessary and will stop at the first difference.
To get the fringe, we can simply use the solution for Flatten a list, slightly modified for a binary tree instead of a general tree: <lang haskell>data Tree a = Leaf a | Node (Tree a) (Tree a)
deriving (Show, Eq)
fringe :: Tree a -> [a] fringe (Leaf x) = [x] fringe (Node n1 n2) = fringe n1 ++ fringe n2
sameFringe :: (Eq a) => Tree a -> Tree a -> Bool sameFringe t1 t2 = fringe t1 == fringe t2
main = do
let a = Node (Leaf 1) (Node (Leaf 2) (Node (Leaf 3) (Node (Leaf 4) (Leaf 5)))) b = Node (Leaf 1) (Node (Node (Leaf 2) (Leaf 3)) (Node (Leaf 4) (Leaf 5))) c = Node (Node (Node (Node (Leaf 1) (Leaf 2)) (Leaf 3)) (Leaf 4)) (Leaf 5) print $ sameFringe a a print $ sameFringe a b print $ sameFringe a c
let x = Node (Leaf 1) (Node (Leaf 2) (Node (Leaf 3) (Node (Leaf 4) (Node (Leaf 5) (Leaf 6))))) y = Node (Leaf 0) (Node (Node (Leaf 2) (Leaf 3)) (Node (Leaf 4) (Leaf 5))) z = Node (Leaf 1) (Node (Leaf 2) (Node (Node (Leaf 4) (Leaf 3)) (Leaf 5))) print $ sameFringe a x print $ sameFringe a y print $ sameFringe a z</lang>
- Output:
True True True False False False
J
<lang J>sameFringe=: -:&([: ; <S:0)</lang>
Note that the time/space optimizations here can change with the language implementation, but current implementations make no effort to treat trees efficiently.
That said, note also that binary trees tend to be a poor data structure choice in J. First, they shift the focus form "what needs to be done" to (in minute detail) "how to do it". This typically means that (for example) combining operations into batches becomes difficult. And, typically, we can find other strategies (some of which have analogies to trees) to achieve the desired efficiencies.
Anyways, here's a recursive routine to convert a flat list into a binary tree:
<lang J>list2tree=: (<.@-:@# ({. ,&<&list2tree}. ) ])^:(1<#)</lang>
And, here are two differently structured trees which represent the same underlying data:
<lang J>bp=: list2tree p: i.11 ubp=: p:L:0] 10;~list2tree i.10</lang>
And, here's our original operation in action (1 {:: ubp
is a subtree of ubp which omits a leaf node):
<lang J> ubp sameFringe bp 1
bp sameFringe 1 {:: ubp
0</lang>
Perl 6
Unlike in Perl 5, where => is just a synonym for comma, in Perl 6 it creates a true Pair object. So here we use Pair objects for our "cons" cells, just as if we were doing this in Lisp. We use the gather/take construct to harvest the leaves lazily as the elements are visited with a standard recursive algorithm, using multiple dispatch to differentiate nodes from leaves. The === value equivalence is applied to the two lists in parallel via the Z ("zip") metaoperator. The all junctional predicate can theoretically short-circuit if any of its arguments are false, though current implementations tend to process in large enough batches that a strictly lazy solution is not guaranteed. <lang perl6>sub samefringe($a,$b) { all fringe($a) Z=== fringe($b) }
sub fringe ($tree) { gather fringeˊ($tree), take Any } multi fringeˊ (Pair $node) { fringeˊ $node.key; fringeˊ $node.value; } multi fringeˊ (Any $leaf) { take $leaf; }</lang> Testing: <lang perl6>my $a = 1 => 2 => 3 => 4 => 5 => 6 => 7 => 8; my $b = 1 => (( 2 => 3 ) => (4 => (5 => ((6 => 7) => 8)))); my $c = (((1 => 2) => 3) => 4) => 5 => 6 => 7 => 8;
my $x = 1 => 2 => 3 => 4 => 5 => 6 => 7 => 8 => 9; my $y = 0 => 2 => 3 => 4 => 5 => 6 => 7 => 8; my $z = 1 => 2 => (4 => 3) => 5 => 6 => 7 => 8;
say so samefringe $a, $a; say so samefringe $a, $b; say so samefringe $a, $c;
say not samefringe $a, $x; say not samefringe $a, $y; say not samefringe $a, $z;</lang>
- Output:
True True True True True True
PicoLisp
This uses coroutines to traverse the trees, so it works only in the 64-bit version. <lang PicoLisp>(de nextLeaf (Rt Tree)
(co Rt (recur (Tree) (when Tree (recurse (cadr Tree)) (yield (car Tree)) (recurse (cddr Tree)) ) ) ) )
(de cmpTrees (Tree1 Tree2)
(prog1 (use (Node1 Node2) (loop (setq Node1 (nextLeaf "rt1" Tree1) Node2 (nextLeaf "rt2" Tree2) ) (T (nor Node1 Node2) T) (NIL (= Node1 Node2)) ) ) (co "rt1") (co "rt2") ) )</lang>
Test: <lang PicoLisp>: (balance '*Tree1 (range 1 7)) -> NIL
- (for N (5 4 6 3 7 1 2) (idx '*Tree2 N T))
-> NIL
- (view *Tree1 T)
7 6 5
4
3 2 1
-> NIL
- (view *Tree2 T)
7 6
5
4 3 2 1
-> NIL
- (cmpTrees *Tree1 *Tree2)
-> T</lang>
Python
This solution visits lazily the two trees in lock step like in the Perl 6 example, and stops at the first miss-match. <lang python>try:
from itertools import zip_longest as izip_longest # Python 3.x
except:
from itertools import izip_longest # Python 2.6+
def fringe(tree):
"""Yield tree members L-to-R depth first, as if stored in a binary tree""" for node1 in tree: if isinstance(node1, tuple): for node2 in fringe(node1): yield node2 else: yield node1
def same_fringe(tree1, tree2):
return all(node1 == node2 for node1, node2 in izip_longest(fringe(tree1), fringe(tree2)))
if __name__ == '__main__':
a = 1, 2, 3, 4, 5, 6, 7, 8 b = 1, (( 2, 3 ), (4, (5, ((6, 7), 8)))) c = (((1, 2), 3), 4), 5, 6, 7, 8
x = 1, 2, 3, 4, 5, 6, 7, 8, 9 y = 0, 2, 3, 4, 5, 6, 7, 8 z = 1, 2, (4, 3), 5, 6, 7, 8
assert same_fringe(a, a) assert same_fringe(a, b) assert same_fringe(a, c)
assert not same_fringe(a, x) assert not same_fringe(a, y) assert not same_fringe(a, z)</lang>
- Output:
There is no output, which signifies success.
REXX
Version 1 father node
<lang REXX>/* REXX ***************************************************************
- Same Fringe
- 1 A A
- / \ / \ / \
- / \ / \ / \
- / \ / \ / \
- 2 3 B C B C
- / \ / / \ / / \ /
- 4 5 6 D E F D E F
- / / \ / / \ / / \
- 7 8 9 G H I G * I
- 23.08.2012 Walter Pachl derived from
- http://rosettacode.org/wiki/Tree_traversal
- Tree A: A B D G E C F H I
- Tree B: A B D G E C F * I
- /
debug=0 node.=0 lvl=0
Call mktree 'A' Call mktree 'B'
done.=0 za=root.a; leafa=node.a.za.0name zb=root.a; leafb=node.b.zb.0name done.a.za=1 done.b.zb=1 Do i=1 To 12
if leafa=leafb Then Do If leafa=0 Then Do Say 'Fringes are equal' Leave End Say leafa '=' leafb Do j=1 To 12 Until done.a.za=0 za=go_next(za,'A'); leafa=node.a.za.0name End done.a.za=1 Do j=1 To 12 Until done.b.zb=0 zb=go_next(zb,'B'); leafb=node.b.zb.0name End done.b.zb=1 End Else Do Select When leafa=0 Then Say leafb 'exceeds leaves in tree A' When leafb=0 Then Say leafa 'exceeds leaves in tree B' Otherwise Say 'First difference' leafa '<>' leafb End Leave End End
Exit
note:
/**********************************************************************
- add the node to the preorder list unless it's already there
- add the node to the level list
- /
Parse Arg z,t If z<>0 &, /* it's a node */ done.z=0 Then Do /* not yet done */ wl.t=wl.t z /* add it to the preorder list*/ ll.lvl=ll.lvl z /* add it to the level list */ done.z=1 /* remember it's done */ leafl=leafl node.t.z.0name End Return
go_next: Procedure Expose node. lvl /**********************************************************************
- find the next node to visit in the treewalk
- /
next=0 Parse arg z,t If node.t.z.0left<>0 Then Do /* there is a left son */ If node.t.z.0left.done=0 Then Do /* we have not visited it */ next=node.t.z.0left /* so we go there */ node.t.z.0left.done=1 /* note we were here */ lvl=lvl+1 /* increase the level */ End End If next=0 Then Do /* not moved yet */ If node.t.z.0rite<>0 Then Do /* there is a right son */ If node.t.z.0rite.done=0 Then Do /* we have not visited it */ next=node.t.z.0rite /* so we go there */ node.t.z.0rite.done=1 /* note we were here */ lvl=lvl+1 /* increase the level */ End End End If next=0 Then Do /* not moved yet */ next=node.t.z.0father /* go to the father */ lvl=lvl-1 /* decrease the level */ End Return next /* that's the next node */ /* or zero if we are done */
mknode: Procedure Expose node. /**********************************************************************
- create a new node
- /
Parse Arg name,t z=node.t.0+1 node.t.z.0name=name node.t.z.0father=0 node.t.z.0left =0 node.t.z.0rite =0 node.t.0=z Return z /* number of the node just created */
attleft: Procedure Expose node. /**********************************************************************
- make son the left son of father
- /
Parse Arg son,father,t node.t.son.0father=father z=node.t.father.0left If z<>0 Then Do node.t.z.0father=son node.t.son.0left=z End node.t.father.0left=son Return
attrite: Procedure Expose node. /**********************************************************************
- make son the right son of father
- /
Parse Arg son,father,t node.t.son.0father=father z=node.t.father.0rite If z<>0 Then Do node.t.z.0father=son node.t.son.0rite=z End node.t.father.0rite=son le=node.t.father.0left If le>0 Then node.t.le.0brother=node.t.father.0rite Return
mktree: Procedure Expose node. root. /**********************************************************************
- build the tree according to the task
- /
Parse Arg t If t='A' Then Do a=mknode('A',t); root.t=a b=mknode('B',t); Call attleft b,a,t c=mknode('C',t); Call attrite c,a,t d=mknode('D',t); Call attleft d,b,t e=mknode('E',t); Call attrite e,b,t f=mknode('F',t); Call attleft f,c,t g=mknode('G',t); Call attleft g,d,t h=mknode('H',t); Call attleft h,f,t i=mknode('I',t); Call attrite i,f,t End Else Do a=mknode('A',t); root.t=a b=mknode('B',t); Call attleft b,a,t c=mknode('C',t); Call attrite c,a,t d=mknode('D',t); Call attleft d,b,t e=mknode('E',t); Call attrite e,b,t f=mknode('F',t); Call attleft f,c,t g=mknode('G',t); Call attleft g,d,t h=mknode('*',t); Call attleft h,f,t i=mknode('I',t); Call attrite i,f,t End Return</lang>
Output:
A = A B = B D = D G = G E = E C = C F = F First difference H <> *
Version 2 without using father node
/lang rexx>/* REXX ***************************************************************
- Same Fringe
= 1 A A = / \ / \ / \ = / \ / \ / \ = / \ / \ / \ = 2 3 B C B C = / \ / / \ / / \ / = 4 5 6 D E F D E F = / / \ / / \ / / \ = 7 8 9 G H I G * I =
- 23.08.2012 Walter Pachl derived from
- http://rosettacode.org/wiki/Tree_traversal
- Tree A: A B D G E C F H I
- Tree B: A B D G E C F * I
- /
node.=0
Call mktree 'A' Call mktree 'B'
sideboard.=0
za=root.a; leafa=node.a.za.0name zb=root.b; leafb=node.b.zb.0name Do i=1 To 20 Until za=0 & zb=0
If leafa=leafb Then Do Say leafa '=' leafb Parse Value get_next(za,'A') with za leafa Parse Value get_next(zb,'B') with zb leafb End Else Do Select When za=0 Then Say leafb 'exceeds tree A' When zb=0 Then Say leafa 'exceeds tree B' Otherwise Say leafa '<>' leafb End Leave Exit End End
exit
get_next: Procedure Expose node. sideboard.
Parse Arg za,t Select When node.t.za.0left<>0 Then Do If node.t.za.0rite<>0 Then Do z=sideboard.t.0+1 sideboard.t.z=node.t.za.0rite sideboard.t.0=z End za=node.t.za.0left End When node.t.za.0rite<>0 Then Do za=node.t.za.0rite End Otherwise Do z=sideboard.t.0 za=sideboard.t.z z=z-1 sideboard.t.0=z End End Return za node.t.za.0name
mknode: Procedure Expose node. /**********************************************************************
- create a new node
- /
Parse Arg name,t z=node.t.0+1 node.t.z.0name=name node.t.z.0father=0 node.t.z.0left =0 node.t.z.0rite =0 node.t.0=z Return z /* number of the node just created */
attleft: Procedure Expose node. /**********************************************************************
- make son the left son of father
- /
Parse Arg son,father,t node.t.son.0father=father z=node.t.father.0left If z<>0 Then Do node.t.z.0father=son node.t.son.0left=z End node.t.father.0left=son Return
attrite: Procedure Expose node. /**********************************************************************
- make son the right son of father
- /
Parse Arg son,father,t node.t.son.0father=father z=node.t.father.0rite If z<>0 Then Do node.t.z.0father=son node.t.son.0rite=z End node.t.father.0rite=son le=node.t.father.0left If le>0 Then node.t.le.0brother=node.t.father.0rite Return
mktree: Procedure Expose node. root. /**********************************************************************
- build the tree according to the task
- /
Parse Arg t If t='A' Then Do a=mknode('A',t); root.t=a b=mknode('B',t); Call attleft b,a,t c=mknode('C',t); Call attrite c,a,t d=mknode('D',t); Call attleft d,b,t e=mknode('E',t); Call attrite e,b,t f=mknode('F',t); Call attleft f,c,t g=mknode('G',t); Call attleft g,d,t h=mknode('H',t); Call attleft h,f,t i=mknode('I',t); Call attrite i,f,t End Else Do a=mknode('A',t); root.t=a b=mknode('B',t); Call attleft b,a,t c=mknode('C',t); Call attrite c,a,t d=mknode('D',t); Call attleft d,b,t e=mknode('E',t); Call attrite e,b,t f=mknode('F',t); Call attleft f,c,t g=mknode('G',t); Call attleft g,d,t h=mknode('*',t); Call attleft h,f,t i=mknode('I',t); Call attrite i,f,t End Return</lang>
Output is the same as for Version 1
Tcl
<lang tcl>package require Tcl 8.6 package require struct::tree
- A wrapper round a coroutine for iterating over the leaves of a tree in order
proc leafiterator {tree} {
coroutine coro[incr ::coroutines] apply {tree {
yield [info coroutine] $tree walk [$tree rootname] node { if {[$tree isleaf $node]} { yield $node } } yieldto break
}} $tree
}
- Compare two trees for equality of their leaf node names
proc samefringe {tree1 tree2} {
set c1 [leafiterator $tree1] set c2 [leafiterator $tree2] try {
while 1 { if {[set l1 [$c1]] ne [set l2 [$c2]]} { puts "$l1 != $l2"; # Just so we can see where we failed return 0 } } return 1
} finally {
rename $c1 {} rename $c2 {}
}
}</lang> Demonstrating: <lang tcl># Make some trees to compare... struct::tree t1 deserialize {
root {} {} a 0 {} d 3 {} e 3 {} b 0 {} c 0 {}
} struct::tree t2 deserialize {
root {} {} a 0 {} d 3 {} e 3 {} b 0 {} cc 0 {}
}
- Print the boolean result of doing the comparison
puts [samefringe t1 t2]</lang>
- Output:
c != cc 0