Sync

Task/Same-Fringe/Clojure/same-fringe-1.clj

@@ -0,0 +1,9 @@
+(defn fringe-seq [branch? children content tree]
+  (letfn [(walk [node]
+            (lazy-seq
+              (if (branch? node)
+                (if (empty? (children node))
+                  (list (content node))
+                  (mapcat walk (children node)))
+                (list node))))]
+    (walk tree)))

Task/Same-Fringe/Clojure/same-fringe-2.clj

@@ -0,0 +1,3 @@
+(defn vfringe-seq [v] (fringe-seq vector? #(remove nil? (rest %)) first v))
+(println (vfringe-seq [10 1 2])) ; (1 2)
+(println (vfringe-seq [10 [1 nil nil] [20 2 nil]])) ; (1 2)

Task/Same-Fringe/Clojure/same-fringe-3.clj

@@ -0,0 +1,8 @@
+(defn seq= [s1 s2]
+  (cond
+    (and (empty? s1) (empty? s2)) true
+    (not= (empty? s1) (empty? s2)) false
+    :else
+    (if (= (first s1) (first s2))
+      (recur (rest s1) (rest s2))
+      false)))

Task/Same-Fringe/Icon/same-fringe.icon

@@ -0,0 +1,30 @@
+procedure main()
+    aTree := [1, [2, [4, [7]], [5]], [3, [6, [8], [9]]]]
+    bTree := [1, [2, [4, [7]], [5]], [3, [6, [8], [9]]]]
+    write("aTree and bTree ",(sameFringe(aTree,bTree),"have")|"don't have",
+          " the same leaves.")
+    cTree := [1, [2, [4, [7]], [5]], [3, [6, [8]]]]
+    dTree := [1, [2, [4, [7]], [5]], [3, [6, [8], [9]]]]
+    write("cTree and dTree ",(sameFringe(cTree,dTree),"have")|"don't have",
+          " the same leaves.")
+end
+
+procedure sameFringe(a,b)
+    return same{genLeaves(a),genLeaves(b)}
+end
+
+procedure same(L)
+   while n1 := @L[1] do {
+      n2 := @L[2] | fail
+      if n1 ~== n2 then fail
+      }
+   return not @L[2]
+end
+
+procedure genLeaves(t)
+    suspend (*(node := preorder(t)) == 1, node[1])
+end
+
+procedure preorder(L)
+    if \L then suspend L | preorder(L[2|3])
+end

Task/Same-Fringe/Perl-6/same-fringe-1.pl6

@@ -2,7 +2,7 @@ sub fringe ($tree) {
     multi sub fringey (Pair $node) { fringey $_ for $node.kv; }
     multi sub fringey ( Any $leaf) { take $leaf; }
 
-    (gather fringey $tree), Cool;
+    gather fringey $tree;
 }
 
-sub samefringe ($a, $b) { all fringe($a) Z=== fringe($b) }
+sub samefringe ($a, $b) { fringe($a) eqv fringe($b) }

Task/Same-Fringe/Perl/same-fringe.pl

@@ -0,0 +1,37 @@
+#!/usr/bin/perl
+use strict;
+
+my @trees = (
+    # 0..2 are same
+    [ 'd', [ 'c', [ 'a', 'b', ], ], ],
+    [ [ 'd', 'c' ], [ 'a', 'b' ] ],
+    [ [ [ 'd', 'c', ], 'a', ], 'b', ],
+    # and this one's different!
+    [ [ [ [ [ [ 'a' ], 'b' ], 'c', ], 'd', ], 'e', ], 'f' ],
+);
+
+for my $tree_idx (1 .. $#trees) {
+    print "tree[",$tree_idx-1,"] vs tree[$tree_idx]: ",
+           cmp_fringe($trees[$tree_idx-1], $trees[$tree_idx]), "\n";
+}
+
+sub cmp_fringe {
+    my $ti1 = get_tree_iterator(shift);
+    my $ti2 = get_tree_iterator(shift);
+    while (1) {
+        my ($L, $R) = ($ti1->(), $ti2->());
+        next if defined($L) and defined($R) and $L eq $R;
+        return "Same" if !defined($L) and !defined($R);
+        return "Different";
+    }
+}
+
+sub get_tree_iterator {
+    my @rtrees = (shift);
+    my $tree;
+    return sub {
+        $tree = pop @rtrees;
+        ($tree, $rtrees[@rtrees]) = @$tree while ref $tree;
+        return $tree;
+    }
+}