Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

How to Test if Two Arrays are Ordered in the Same Way

( #463839=categorized question: print w/ replies, xml ) Need Help??
Contributed by monkfan on Jun 06, 2005 at 05:44 UTC
Q&A  > arrays


Description:

This is an attempt to save a thread in SoPW which I thought can be useful for others.

There are already incredible answers in the thread, so feel free to check in SoPW.
Please don't misunderstand me. I honestly think this can be useful. I don't mean to boost my XP here, or in that thread which I posted.

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
<code>

Answer: How to Test if Two Arrays are Ordered in the Same Way
contributed by jdhedden

Your decision line needs to be:

my $decision = grep($h{$$ar2[$_-1]} > $h{$$ar2[$_]}, 1..$#{$ar2}) +? 0 : 1;
You have to take into account the elements order with respect to each other. In this case, pos1 <= pos2 <= pos3 ...
Answer: How to Test if Two Arrays are Ordered in the Same Way
contributed by monkfan

Ok, this is one the answer given by most revered tlm to me the other day:

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; }
More can be found here. Don't vote my root posting but vote those remarkable answers you will find there.

Please (register and) log in if you wish to add an answer



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others exploiting the Monastery: (13)
    As of 2014-10-22 12:53 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      For retirement, I am banking on:










      Results (118 votes), past polls