Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Testing if Two Arrays are Ordered in a Same Way

by monkfan (Curate)
on May 25, 2005 at 04:13 UTC ( #460234=perlquestion: print w/ replies, xml ) Need Help??
monkfan has asked for the wisdom of the Perl Monks concerning the following question:

Hi,
Here I wanted to test if an array is of a _same order_ with another, left array is always be greater/superset or equal to the right one. Here is my current code.
#!/usr/bin/perl -w # The original code here is constructed # thanks to ysth's suggestion use strict; my @AR = qw(a b c); # First Case my @ar = qw(z a b c); # Second Case my @ar2 = qw(b a); my @ar3 = qw(a b); my @ar4 = qw(a b c); my @ar5 = qw(z a b c); print "First case\n"; # L R print test_ordered(\@ar,\@ar2),"\n"; # Answer:False(0) print test_ordered(\@ar,\@ar3),"\n"; # Answer:True(1) print test_ordered(\@ar,\@ar4),"\n"; # Answer:True(1) print test_ordered(\@ar,\@ar5),"\n"; # Answer:True(1) print "Second case\n"; print test_ordered(\@AR,\@ar2),"\n"; # Answer: False(0) print test_ordered(\@AR,\@ar3),"\n"; # Answer: True(1) print test_ordered(\@AR,\@ar4),"\n"; # Answer: True(1) sub test_ordered { #test if two arrays are ordered in same way #assuming no duplicate and left array is always #be greater/superset or equal to the right one # L R my ($ar1,$ar2)= @_; my %h; @h{@$ar1} = (0..$#{$ar1}); my $decision = grep($h{$ar2[$_]} != $_, 0..$#{$ar2}) ? 0 : 1; return $decision; }
Currently the code give correct answer for the Second Case. How can I modify it such that it's also correct for the First Case?
Now it prints:
First Case: Second Case: 0 0 0 1 0 1 1
The desired answer is:
First Case: Second Case: 0 0 1 1 1 1 1
Regards,
Edward

Comment on Testing if Two Arrays are Ordered in a Same Way
Select or Download Code
Re: Testing if Two Arrays are Ordered in a Same Way
by BrowserUk (Pope) on May 25, 2005 at 04:42 UTC

    If all the elements of your arrays are single chars (as in your previous posts) then I think this would do the job. It does for the testcases provided:

    #!/usr/bin/perl -w use strict; my @AR = qw(a b c); # First Case my @ar = qw(z a b c); # Second Case my @ar2 = qw(b a); my @ar3 = qw(a b); my @ar4 = qw(a b c); my @ar5 = qw(z a b c); print "First case\n"; # L R print test_ordered(\@ar,\@ar2),"\n"; # Answer:False(0) print test_ordered(\@ar,\@ar3),"\n"; # Answer:True(1) print test_ordered(\@ar,\@ar4),"\n"; # Answer:True(1) print test_ordered(\@ar,\@ar5),"\n"; # Answer:True(1) print "Second case\n"; print test_ordered(\@AR,\@ar2),"\n"; # Answer: False(0) print test_ordered(\@AR,\@ar3),"\n"; # Answer: True(1) print test_ordered(\@AR,\@ar4),"\n"; # Answer: True(1) sub test_ordered { my( $ar1, $ar2 ) = @_; my $re = join '.*?', @$ar2; $ar1 = join'', @$ar1; return $ar1 =~ $re ? 1 : 0; } __END__ P:\test>460234.pl First case 0 1 1 1 Second case 0 1 1

    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
    "Science is about questioning the status quo. Questioning authority".
    The "good enough" maybe good enough for the now, and perfection maybe unobtainable, but that should not preclude us from striving for perfection, when time, circumstance or desire allow.
Re: Testing if Two Arrays are Ordered in a Same Way
by tlm (Prior) on May 25, 2005 at 04:50 UTC
    sub test_ordered { my ( $ref, $test ) = @_; # $i scans the indices of @$ref; # $matched keeps count of # of elements matched in @$test; my ( $i, $matched ) = ( 0, 0 ); OUTER: for ( @$test ) { while ( $i < @$ref or return 0 ) { if ( $ref->[ $i++ ] eq $_ ) { last OUTER if ++$matched == @$test; last; } } } return 1; }

    Updates: Minor tweaks. Fixed behavior for the empty @$test case (returns 1).

    the lowliest monk

Re: Testing if Two Arrays are Ordered in a Same Way
by ikegami (Pope) on May 25, 2005 at 04:52 UTC

    This works

    sub test_ordered { #test if two arrays are ordered in same way #assuming no duplicate and left array is always #be greater/superset or equal to the right one # L R my ($ar1,$ar2)= @_; my %h; @h{@$ar1} = (0..$#{$ar1}); my $last = -1; foreach (@h{@$ar2}) { return 0 unless $_ >= $last; $last = $_; } return 1; }
Re: Testing if Two Arrays are Ordered in a Same Way
by johnnywang (Priest) on May 25, 2005 at 05:29 UTC
    My algorithm: drop those element from the first array which are not in second, the resulting array should be the same as the second, which can be compared by joining the elements together. (not tested):
    sub test_ordered{ my ($ar1,$ar2)= @_; my %array2; @array2{@{$ar2}} = 1; # a more perlish way? my @array1 = (); foreach (@{$ar1}){ push @array1, $_ if $array2{$_}; } return join(",", @array1) eq join(",",@{$ar2}); }

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://460234]
Approved by BrowserUk
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (7)
As of 2014-08-23 04:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (172 votes), past polls