Looping through arrays : are they equal ?

[ZlR]

Hello Perl Pros,

Here i am once again with a desperate attempt to sort my way through weird system configs with Perl.

At this point i have a hash where the values are a list of references to arrays. It's not really interesting what's inside, but maybe that structure is not the best one for my problem, or maybe you're just curious, so : the keys are unique adresses and each list is a bunch of devices mapped to it. I need to make sure that every device is in every list, that is that all these list are equals.

It should be easy, but i find myself doing this in an ugly way.

Here's what my hash looks like :

$VAR1 = {
          'Ad1' => [
                                  '0A78',
                                  '0A9E',
                                  '0AB9',
                                  '0AC0',
                                  
                                ],
          'Ad2' => [
                                  '0A78',
                                  '0A9E',
                                  '0AB9',
                                  '0AC0',
                                                                      
+          ]
        };

It could be that there is only one key, or more than 2. Also, in the end, i'm looping through a structure to build this hash, but let's forget that.

Here's what i do :

#!perl
use strict ; 
use warnings ; 
my $refcomp= {
          'Ad1' => [
                                  '0A78',
                                  '0A9E',
                                  '0AB9',
                                  '0AC0',
                                  
                                ],
          'Ad2' => [
                                  '0A78',
                                  '0A9E',
                                  '0AB9',
                                  '0AC0',
                                                                      
+          ]
        };

my %comp =%$refcomp ;  # my code uses a hash, not a ref, so ...

my %found ; 
if (scalar keys %comp > 1 ) {
    for my $adress (keys %comp) {
        for my $dev ( @{$comp{$adress}} ) { $found{$dev}++ } 
    }    
}
    
my %uniq ; 
for my $it (values %found) { $uniq{$it}++ } ; 

if ( scalar keys %uniq > 1 ) { 
    print "ERR : Problem in device list\n"  ; 
}

Anyone has a nicer way ? Thanks !

zlr

[wind]

I would code your error checking in a way that gave you meaningful error messages:

use strict; 
use warnings; 

my $refcomp = {
    'Ad1' => [qw(0A78 0A9E 0AB9 0AC0)],
    'Ad2' => [qw(0A78 0A9E 0AB9 0AC0)],
};

my %devs;
for my $key (keys %$refcomp) {
    for (@{$refcomp->{$key}}) {
        $devs{$_}{$key}++;
    }
}

while (my ($dev, $keys) = each %devs) {
    if (my @notfound = sort grep {! $keys->{$_}} keys %$refcomp) {
        warn "$dev not found in: " . join(',', @notfound) . "\n";
    }
}

[ZlR]

Thanks wind, this really saved the day :) I must say i copypasted it shamelessy into my script, given the deadlines i had ...

Now that i look at it, i see a couple of great things :

- the structure of %devs and the way it's built from %comp

- the way you "each" through %dev : $keys is a hash ref, (with the adresses of a device as keys). I need to 'each' more, when i have refs as values !

So, now, the grep. It's over the keys of refcomp, so $_ is an adress. Hence, if $keys->{$_} is not defined, it means that this device we are eaching on is missing for that adress. keys %comp has all adresses but keys %$keys only has the adress of a specific device.

Honestly, i would never have found that myself, the way it works for any number of adresses by 'reversing' the hash and looking at it from the device ... it's brilliant :D
It's also a very consistent way of looking at this specific system conf giving me a complete 'for sure' list of errors. Thanks !!

[Util]

This code provides details of where the problem occurs:

my %comp = (
    'Ad1' => [ qw( 0A78 0A9E 0AB9 0AC0 ) ],
    'Ad2' => [ qw( 0A78 0A9E 0AB9 0AC0 ) ],
);

my %device;
my @locations = sort keys %comp;
for my $location (@locations) {
    for my $dev_name ( @{ $comp{$location} } ) {
        $device{$dev_name}{$location}++;
    }
}

my $expected_locations = join ',', @locations;
for my $dev_name ( sort keys %device ) {
    my $actual_locations = join ',', sort keys %{$device{$dev_name}};
    next if $expected_locations eq $actual_locations;
    print "ERR: '$dev_name' only found in '$actual_locations'\n";
}

By the way, if ( scalar keys %comp > 1 ) {...} can be reduced to if (%comp) {...}.

[Util]

Correction, the `if` could be reduced if `>= 1`, but not as is.

[kennethk]

I don't think your code works to spec. You are only checking if the lists are the same length, not if the content is identical. For that, you need something like what you find in perlfaq4's How do I compute the difference of two arrays? How do I compute the intersection of two arrays? or How do I test whether two arrays or hashes are equal?.

As a side note, both times you use scalar in your code it is a no-op - if necessarily enforces scalar context.

[anonymized user 468275]

YAADA (yet another another Dumper approach)

#!perl
use strict ; 
use warnings ; 
use Data::Dumper;

my $refcomp= {
          'Ad1' => [
                                  '0A78',
                                  '0A9E',
                                  '0AB9',
                                  '0AC0',
                                  
                                ],
          'Ad2' => [
                                  '0A78',
                                  '0A9E',
                                  '0AB9',
                                  '0AC0',
                                                                      
+          ]
        };
# sort the arrays if not already all in order 
if ( "sort needed" eq "sort needed" ) {
    while ( my ( $k, $v ) = each %$refcomp ) {
        $refcomp -> { $k } = \( sort @$v );
    }
}

# the test
my $lastref = '';
for my $curref ( values %$refcomp )
    if ( $lastref ) {
        Dumper( $lastref ) eq Dumper( $curref )
          or die "non-unique device list detected";
    }
    $lastref = $curref;
}

Update: if the sort is needed the test can be moved into the while loop that does the sort and the final for loop removed.

[ZlR]

that's way over my head for now, but thanks !!