Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Looping through arrays : are they equal ?

by ZlR (Chaplain)
on Apr 21, 2011 at 18:47 UTC ( #900691=perlquestion: print w/replies, xml ) Need Help??
ZlR has asked for the wisdom of the Perl Monks concerning the following question:

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

Replies are listed 'Best First'.
Re: Looping through arrays : are they equal ?
by wind (Priest) on Apr 21, 2011 at 19:33 UTC

    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"; } }
      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 !!

Re: Looping through arrays : are they equal ?
by Util (Priest) on Apr 21, 2011 at 19:24 UTC

    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) {...}.

      Correction, the `if` could be reduced if `>= 1`, but not as is.
Re: Looping through arrays : are they equal ?
by kennethk (Abbot) on Apr 21, 2011 at 19:27 UTC
Re: Looping through arrays : are they equal ?
by SimonClinch (Deacon) on Apr 22, 2011 at 15:30 UTC
    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.

    One world, one people

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

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://900691]
Approved by kennethk
help
Chatterbox?
Corion watches from the sidelines. Or rather, from behind, as my system only gets output from that process and my programs adhere strictly to the GIGO design principle.
[erix]: ah, that's nice to hear Corion :)
[Corion]: erix: Yeah, the sad thing is that all I can do is document things, so I can point fingers when the auditors come :-/
[Corion]: "I'm here to open tickets and point fingers. And I'm all out of tickets."
[erix]: didn't Sybase have pretty good auditing? :) (this is a vague memory)
[erix]: (culprits often are upstream of db of course)
[Corion]: Ah, how I missed it. After some years, I revisit slashdot on a click-bait link, and it provides the usual humor instantly: "I didn't know Drupal had rules for sex. It must be a plug-in"
[Corion]: erix: This is not for sybase, but for the input data files, resp. their contents.

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (8)
As of 2017-03-28 08:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Should Pluto Get Its Planethood Back?



    Results (328 votes). Check out past polls.