anniyan has asked for the wisdom of the Perl Monks concerning the following question:

hi monks, i have two arrays namely @a, @b.

@a=(a, b, c, d, e, f);
@b=(a, b, c);

[download]

In the above array @a wont change throughout the program. Wheras @b may change in the program.

The question is i want to compare both arrays, ie the order of @b elements should be same as @a. Number of elements is not important, only the order should be same. if @b = (c, b, a) then it should return the order is not correct.

I searched methods in List::Compare::Functional, but there is no such method. I can compare this manually with for loops, but i want to know, is there any module to perform this task.

update: If @b = (b, c, d), it is also wrong, because here the order is correct with @a, but a is not there in @b, so it is error, ie it should check from the beginning of @a

Regards,
Anniyan
(CREATED in HELL by DEVIL to s|EVILS|GOODS|g in WORLD)

Replies are listed 'Best First'.
Re: List Compare
by borisz (Canon) on Oct 21, 2005 at 14:58 UTC 
    my @a = (qw/a b c d e f/);
my @b = (qw/a b d/);

print comp( \@a, \@b );

sub comp {
  my ( $aref, $bref ) = @_;
  for ( 0 .. $#$bref ) {
    return if ( not exists( $aref->[$_] ) or $aref->[$_] ne $bref->[$_
+] );
  }
  return 1;
}

    [download]
    Boris
[reply]
[d/l]
Re: List Compare
by BrowserUk (Patriarch) on Oct 21, 2005 at 14:51 UTC

    I'm not sure that 'leftSubset' is the best name, but it should work for any type of values. Though, if you want '2' to compare equal to '2.0', you'll need to tweak it.

    It takes a references to the two arrays, the master first, the variable array second, and returns true false. 

    #! perl -slw
use strict;
use List::Util qw[ first ];

sub leftSubset{
    local $^W;
    my( $major, $minor) = @_;
    return @{$minor} == first{
        $major->[ $_ ] ne $minor->[$_]
    } 0 .. @{$minor}
}

my @a = 'a' .. 'f';

print "\n@$_\n is left subset of \n@a: ",
    leftSubset( \@a, $_ ) ? 'YES' : 'NO'
    for ['a'..'c'], ['b'..'d'],[qw[a a b c]],[ reverse 'a'..'c'];;

__END__
P:\test>junk2

a b c
 is left subset of
a b c d e f: YES

b c d
 is left subset of
a b c d e f: NO

a a b c
 is left subset of
a b c d e f: NO

c b a
 is left subset of
a b c d e f: NO

    [download]
    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".
    In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
Re: List Compare
by dragonchild (Archbishop) on Oct 21, 2005 at 14:26 UTC
    Assuming you're working with just strings, something like the following would work: 
    my @a = 'a' .. 'c';
my @b = 'a' .. 'f';

my $compare = do {
    my $temp = join '.*?', @a;
    qr/$temp/;
};

sub compare {
    my @b = @_;

    my $temp = join '', @b;
    return $temp =~ $compare;
}

    [download]
    My criteria for good software:
    1. Does it work?
    2. Can someone else come in, make a change, and be reasonably certain no bugs were introduced?
[reply]
[d/l]
      You beat me to it!! I had it the other way round though as per the OPs example. The joined @a is only calculated once and then matched against the regex made from joining @b with .*? 
      my @a= qw (a b c d e f);
my @b= qw (a b c);

my $joined_a = join '', @a;
my $joined_b = join '.*?', @b;

print "yes!\n" if $joined_a =~ /$joined_b/;

      [download]

      But I guess there are no prizes for coming second...

[reply]
[d/l]

      This... uh... doesn't meet your first criteria for good software. (And it didn't even before he updated his spec.)

      Set @b = qw( a foobar c ) to see it fail.

      You might get away with something like that by including some "\0"s in your join but I certainly would not recommend it. Even before he added the additional constraint that there could be no missing elements, this would be easily solved with a single loop.

      -sauoq
"My two cents aren't worth a dime.";
[reply]
[d/l]
[select]
Re: List Compare
by sauoq (Abbot) on Oct 21, 2005 at 19:45 UTC
    I can compare this manually with for loops, but i want to know, is there any module to perform this task.

    I don't think a module is required for this. The straight forward solution is probably best. It doesn't require "loops" (plural), just one. Iterate through the indices of your short array and compare with the elements at the same indices in the large array. 

    sub is_left_slice {
    my ($some, $all) = @_;
    
    $some->[$_] eq $all->[$_] or return 0 for 0 .. $#$some;
    
    return 1;
}

    [download]

    -sauoq
"My two cents aren't worth a dime.";
[reply]
[d/l]
Re: List Compare
by Roy Johnson (Monsignor) on Oct 21, 2005 at 20:55 UTC
    Here's a Lispy version (which modifies the arrays): 
    my @a=qw(a b c d e f);
my @b=qw(a b c);

sub head_eq(\@\@) {
    my ($long, $short) = @_;
    @$short == 0 or (@$long and shift @$long eq shift @$short and &hea
+d_eq) 
}

print "Equal!\n" if head_eq(@a, @b);

    [download]
    Caution: Contents may have been coded under pressure.
[reply]
[d/l]
Re: List Compare
by Moron (Curate) on Oct 21, 2005 at 15:37 UTC
    The pitfall that is hard to avoid when using the join-to-form-a-regexp solution is that, for example:
    @b = (ab, c);

    [download]
    is probably not construable (depending on your exact view of the requirement) as being an ordered subset of:
    @a = (a, bc, d);

    [download]
    My first reaction was therefore to use the standard join( $;, array ) approach ($; is a non-printable field separator often used for this purpose), while mulling over the possibility that the data might be binary and so accidentally contain a byte equal to $; (it's the ascii of decimal 19 and reassigning $; would just move the problem to a different false-positive), the following non-regexp approach drifted into my head - it does at least do about the minnimum necessary while being safe from the above join-delimitation problem:
    sub isOrderedSublist{
    my ( $aref, $bref ) = @_; # references to arrays
    my @a = @$aref; # major - copy so we can safely destroy
    my @b = @$bref; # minor
    my $firstMatched = 0;
    while( not Empty( \@a ) ) {
        if ( $a[0] eq $b[0] ) {
            $firstMatched = 1;
            shift @b;
        else {
            $firstMatched and last;
        }
        shift @a;
    }
    return Empty( \@b ); # success if failure eliminated
}

sub Empty{
    my $aref = shift;
    return( not ( $#$aref + 1 ) );
}

    [download]
    update: factorised to reduce a couple of lines

    -M

    Free your mind

[reply]
[d/l]
[select]
Re: List Compare
by blazar (Canon) on Oct 21, 2005 at 14:24 UTC
    IIUC: 
    #!/usr/bin/perl -l

use strict;
use warnings;

{
    my @a=qw/a b c d e f/;
    my %order;
    for (0..$#a) {
        $order{ $a[$_] } = $_ + 1;
    }

    sub idx { $order{$_[0]} || 0 }
    sub order {
        sort { idx($a) <=> idx($b) } @_;
    }
}

$,=$";
print +(order qw/f d b/);

__END__

    [download]
    (optimized for clarity rather than for performance)

    Update: I hadn't "UC"... (see Re^2: List Compare). Still this code is not that bad after all. Maybe he could try to adapt it to his needs -- I just don't have time to do so now.

[reply]
[d/l]

      Hello blazar, Read the question properly, OP has asked:

      I can compare this manually with for loops, but i want to know, is there any module to perform this task.

      Another think, Read the update part:

      If @b = (b, c, d), it is also wrong, because here the order is correct with @a, but a is not there in @b, so it is error, ie it should check from the beginning of @a

      Eventhen your reply is WRONG

[reply]

Back to Seekers of Perl Wisdom