Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

Re: Challenge: Perl 5: lazy sameFringe()?

by hdb (Prior)
on Jun 30, 2013 at 10:31 UTC ( #1041568=note: print w/replies, xml ) Need Help??


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

Very nice exercise!

use strict; use warnings; sub make_iterator { my $s = shift; my @stack = (); return sub { while(defined $s) { if( !ref $s ) { my $n = $s; $s = pop @stack; return $n; # leaf & back up the t +ree } if( ref $s->[0] ) { push @stack, $s->[1]; $s = $s->[0]; # down & and memorize othe +r branch } else { my $n = $s->[0]; $s = $s->[1]; return $n; # leaf & down the ot +her branch } } return undef; } } sub sameFringe { my ($i1, $i2) = map { make_iterator( $_ ) } @_; while( my $n = $i1->() ) { return 0 if $n ne $i2->(); } return defined( $i2->() ) ? 0 : 1; } my @trees = ( [ [ 1, [ [2, [4, 7] ], 5 ] ], [3, [6, [8, 9] ] ] ], [ [ 1, [ [2, [4, 7] ], 5 ] ], [3, [6, [8, 9] ] ] ], [ [ 1, [ [ [2, 4], 7], 5 ] ], [3, [6, [8, 9] ] ] ], [ [ 1, [ [2, [4, 7] ], 5 ] ], [3, [6, [8, [9, 0 ] ] ] ] ] +, [ [ 1, [ [0, [4, 7] ], 5 ] ], [3, [6, [8, 9] ] ] ], ); print sameFringe( $trees[0], $_ )?"Same\n":"Different\n" for @trees; my $a = [ 1, [ 2, [ 3, [ 4, 5 ] ] ] ]; my $b = [ 1, [ [ 2, 3 ], [ 4, 5 ] ] ]; my $c = [ [ [ [ 1, 2 ], 3 ], 4 ], 5 ]; print sameFringe( $a, $a )?"Same\n":"Different\n"; print sameFringe( $a, $b )?"Same\n":"Different\n"; print sameFringe( $a, $c )?"Same\n":"Different\n"; my $x = [ 1, [ 2, [ 3, [ 4, [ 5, 6 ] ] ] ] ]; my $y = [ 0, [ [ 2, 3 ], [ 4, 5 ] ] ]; my $z = [ 1, [ 2, [ [ 4, 3 ], 5 ] ] ]; print sameFringe( $a, $x )?"Same\n":"Different\n"; print sameFringe( $a, $y )?"Same\n":"Different\n"; print sameFringe( $a, $z )?"Same\n":"Different\n";

Replies are listed 'Best First'.
Re^2: Challenge: Perl 5: lazy sameFringe()?
by LanX (Chancellor) on Jun 30, 2013 at 11:49 UTC
    I like the idea of just storing the next element but IMHO your algorithm can't handle sub-arrays of size >2 and the iterator stops.

    my $a = [ 1, [ 2, [ 3, [ 4, 5 ] ] ] ]; my $d = [ 1, 2, 3, 4, 5 ]; print sameFringe( $a, $d )?"Same\n":"Different\n"; __END__ Use of uninitialized value in string ne ... Different

    update

    oops!!! I just realized that the task is restricted to binary trees! =)

    (how boring ;)

    Cheers Rolf

    ( addicted to the Perl Programming Language)

Re^2: Challenge: Perl 5: lazy sameFringe()?
by BrowserUk (Pope) on Jun 30, 2013 at 12:35 UTC

    Nice++ A solution that actually matches the spec :)


    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.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1041568]
help
Chatterbox?
[Corion]: You'll have to look somewhere esoteric for that. Maybe some tied variable or special dualvar can also trigger that. But it's certainly not a common occurrence
[Corion]: And on 5.20, the following also outputs no find:perl -wle 'for my $x ("\x{2000}".."\ x{1fffff}") { if( $x && ! length $x ) { warn qq(<$x>); warn length $x; die } }'
[Corion]: (this time on Unix)
[hippo]: Understood. I'll have to go through the code and see if it's doing anything fancy with ties, dual-vars or non-scalars. In the end, it's probably a bug though.
[Corion]: Aaah - you should be able to do this with overload, but I would hit somebody really hard if they constructed objects that are true but the empty string, and you not knowing about the domain knowledge where this makes sense
[Eily]: you could tie a variable into not having the same value each time, if you like to make people who try to debug your code facepalm
[Corion]: perl -wle 'package o; use overload q("") => sub {warn "str"; ""}, bool => sub{warn "bool"; 1}; package main; my $o={}; bless $o => o; print "Yay" if ($o && !length($o))'
[Corion]: But people writing such code should document the objects they construct and why it makes sense for an object to be invisible as string while being true in a boolean context

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (14)
As of 2017-07-27 13:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    I came, I saw, I ...
























    Results (413 votes). Check out past polls.