I'm not familiar with list compare, so it's possible there's something wrong with the syntax you're using, but the item that I noticed is that you're returning 0 within the loop.

Normally, you'd want to use logic like:

sub test_match_subroutine {
    my ( $item, $possible_matches ) = @_;
    foreach my $test_case ( @$possible_matches ) {
        return 1 if is_a_match($item, $test_case);
    }
    return 0;
}
[download]

Note -- we don't fail until all cases fail ... not when the first item fails.

• calculate MD5 checksum of the arrayref you want to look up
• check if that checksum is present in a hash
• if so, discard the array
• if not, add checksum to hash and add arrayref to array

calculate MD5 checksum of the arrayref you want to look up

Hi Holli,
Can you give example of how to do that? Is there any specific module that does this?


---
neversaint and everlastingly indebted.......

I'm not holli's alterego, but I believe holli would point you to use Digest;, which can calculate (among others) MD5 signatures.

emc

Visit Netlib

swampyankee is correct. Here is some code that shows the principle:

use strict;
use warnings;

use Data::Dumper;
use Digest::MD5 qw(md5);

my %lookup;

my @AoA =
(
  ["a", "b", "c"],
  ["d", "e", "f"],
  ["a", "b", "c"],
  ["g", "h", "i"],
  ["a", "b", "c"],
  ["g", "h", "i"],
);


#Build a lookup hash from AoA, values of the hash will be
#an arrayref to the positions where a given array was found
my $index = 0;

for ( @AoA )
{
    my $k = md5(Dumper($_));
    push @{$lookup{$k}}, $index++;
}

$index = 0;

#test data
my @test =
(
  ["a", "b", "c"],
  ["d", "e", "f"],
  ["g", "h", "i"],
  ["x", "y", "z"],
);

#loop tests
for ( @test )
{
    print "Test ", $index++, ": ", join (", ", @{ref_exists($_)}), "\n
+";
}


#returns the positions or undef when the arrayref is not in AoA
sub ref_exists
{
    return $lookup{md5(Dumper(shift))} || [];
}
[download]

Note that, because I use Data::Dumper for creating the digest, the technique should work for deep structures also, not just for plain arrays of strings.


holli, /regexed monk/

sub different
{
    my ($h1, $h2) = @_;
    return 1 unless keys %$h1 == keys %$h2;
    for (keys %$h1) {
        return 1 unless exists $h2->{$_};
    }
    return 0;
}

sub member {
    my ($a, $aoa) = @_;
    my %as;
    undef @as{@$a};
    for my $x (@$aoa) {
        my %bs;
        undef @bs{@$x};
        return 1 unless different \%as, \%bs;
    }
    return 0;
}
[download]

sub check_if_inst_occur_already {
  my ( $store, $inst_set ) = @_;
  foreach my $ins_already ( @{$store} ) {
    return 1 if is_equivalent($ins_already, $inst_set);
  }
  return 0;
}

sub is_equivalent{
  my ($aa, $bb) = @_;
  return 0 unless @$aa == @$bb;
  for( 0 .. @$aa-1){
    return 0 unless $aa->[$_] eq $bb->[$_];
  }
  return 1;
}
[download]

By "member array ref" of an AoA you can understand two things:

1. The "member array ref" points to the same memory object as the element in the AoA points to.
2. The "member array ref" points to a different memory object which has an identical "printable representation", or other criterion of comparison you may see fit.

From your post, I assume you want (2). Here's an implementation of both (1) an (2) together with a test. Be aware that my implementation of (2) is simple - it relies on stringification by joining with $;, which does not work if the arrays in the AoA are themselves deep data structures and may give incorrect results if you use the value of $; in your subarray values.

#!/usr/bin/perl

use strict;
use warnings;

sub member_as_object {
  my $aref = shift;
  my $AoAref = shift;

  return grep {$aref eq $_} @{$AoAref};
}

sub stringify {
  return join $;, @{(shift)};
}

sub member_as_stringified_value {
  my $astring = stringify(shift);
  my $AoAref = shift;

  return grep {$astring eq stringify($_)} @{$AoAref};
}


# building a test case below

my @AoA = (
       [ 'beethoven', 'berlioz', 'strauss' ],
       [ 'wagner',    'mozart',  'brahms' ],
       [ 'sibelius',  'elgar',   'dvorak' ]
      );

my %arrays = (
        member_obj  =>  $AoA[1],
        member_copy =>  [ @{$AoA[1]} ],
        non_member  =>  [ qw/foo bar baz/ ]
       );

my %compare_subs =
  (
   member_as_object => \&member_as_object,
   member_as_stringified_value => \&member_as_stringified_value
  );

for my $csub (sort keys %compare_subs) {
  for my $array (sort keys %arrays) {
    my $result =
      $compare_subs{$csub}->($arrays{$array}, \@AoA) ? 'true' : 'false
+';

    print "$csub($array) = $result\n";
  }
}
[download]