in reply to Challenge: Perl 5: lazy sameFringe()?

This is my solution. As I said above, I think it is less elegant than others published above, but I follow Roboticus's recommendation to publish it nonetheless.

#!/usr/bin/perl use strict; use warnings; my $tree1 = [1, [2, [4, [7]], [5]], [3, [6, [8], [9]]]]; my $tree2 = [1, [2, [4, [7]], [5]], [3, [6, [8], [9]]]]; my $tree3 = [1, [2, [4, [7]], [5]], [3, [6, [9], [8]]]]; my $next_el1 = create_iterator($tree1); my $next_el2 = create_iterator($tree3); my $match = 1; while (1) { my $left = $next_el1->(); my $right = $next_el2->(); no warnings 'uninitialized'; print $left, " ", $right, "\n"; unless ($left eq $right) {$match = 0 ; last} ; last unless defined $left; } if ($match) { print "The trees match \n"; } else { print "The trees don't match \n"; } sub create_iterator { my $ref = shift; my @ref_list; return sub { while (ref $ref eq 'ARRAY') { push @ref_list, @$ref; $ref = shift @ref_list; } my $leaf = $ref; $ref = shift @ref_list; return $leaf; } }

Results comparing tree1 and tree3:

$ perl fringe.pl 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 9 the trees don't match

And comparing tree1 and tree2:

$ perl fringe.pl 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 The trees match

Replies are listed 'Best First'.
Re^2: Challenge: Perl 5: lazy sameFringe()?
by Laurent_R (Canon) on Jul 01, 2013 at 09:41 UTC

    OK, BrowserUK, here we go with a sameFringe function and the test data copied from your posted solution.

    Note that I had to make a small change in my closure (unshift instead of push on the @ref_list array), because my original code did not compare $a and $c correctly (the leaves were appearing in opposite order).

    #!/usr/bin/perl use strict; use warnings; my $a = [ 1, [ 2, [ 3, [ 4, 5 ] ] ] ]; my $b = [ 1, [ [ 2, 3 ], [ 4, 5 ] ] ]; my $c = [ [ [ [ 1, 2 ], 3 ], 4 ], 5 ]; sameFringe( $a, $a ); sameFringe( $a, $b ); sameFringe( $a, $c ); my $x = [ 1, [ 2, [ 3, [ 4, [ 5, 6 ] ] ] ] ]; my $y = [ 0, [ [ 2, 3 ], [ 4, 5 ] ] ]; my $z = [ 1, [ 2, [ [ 4, 3 ], 5 ] ] ]; sameFringe( $a, $x ); sameFringe( $a, $y ); sameFringe( $a, $z ); sub sameFringe { my $next_el1 = create_iterator(shift); my $next_el2 = create_iterator(shift); my $match = 1; while (1) { my $left = $next_el1->(); my $right = $next_el2->(); no warnings 'uninitialized'; print $left, " ", $right, "\n"; unless ($left eq $right) {$match = 0 ; last} ; last unless defined $left; } $match ? print "the trees match\n": print "the trees don't match\n +"; } sub create_iterator { my $ref = shift; my @ref_list; return sub { while (ref $ref eq 'ARRAY') { unshift @ref_list, @$ref; $ref = shift @ref_list; } my $leaf = $ref; $ref = shift @ref_list; return $leaf; } }

    The following is the output:

    >perl fringe.pl 1 1 2 2 3 3 4 4 5 5 the trees match 1 1 2 2 3 3 4 4 5 5 the trees match 1 1 2 2 3 3 4 4 5 5 the trees match 1 1 2 2 3 3 4 4 5 5 6 the trees don't match 1 0 the trees don't match 1 1 2 2 3 4 the trees don't match
Re^2: Challenge: Perl 5: lazy sameFringe()?
by BrowserUk (Patriarch) on Jul 01, 2013 at 05:22 UTC

    Laurent_R++ Another solution that works and (almost) meets the specs.

    It would be easier to compare with other attempts if you wrapped your algorithm up in a sameFringe() subroutine -- same args and return -- as is used in the linked article.

    It is also a good idea to test using the same tests as they use. They have been quite carefully designed (or arrived at) to test several particular edge cases.


    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.