Re: Array name with a Variable

[mr_mischief]

in reply to Array name with a Variable

Don't use symbolic references. Use regular references instead.

Your exact spec and your example program don't quite cooperate with one another, but this should get you closer:

Update: This code is buggy so I've put it in a readmore (not trying to hide that I make mistakes, after all). See Re^3: Array name with a Variable for the corrected code. The declaration of the hashes here is in the wrong scope and they weren't getting emptied properly.

use strict;
use warnings;

my @array1 = qw( c d e );
my @array2 = qw( e f g h );
my @array3 = qw( a b d );
my @array4 = qw( s g h j k l );

open my $out, '>', 'output' or die "Cannot open: $!\n";

foreach my $a1 ( \@array1, \@array2, \@array3, \@array4 ) {
    my ( %union, %intersect ) = ( (), () );
    foreach my $a2 ( \@array1, \@array2, \@array3, \@array4 ) {
        foreach my $item1 ( @$a1 ) {
            foreach my $item2 ( @$a2 ) {
                # print "item1: $item1\nitem2: $item2\n";
                $union{$item1}++;
                $union{$item2}++;
                if ( $item1 eq $item2 ) {
                    $intersect{$item1}++;
                }
            }
        }
        my @intersect = sort keys %intersect;
        print $out "@intersect\n"; #prints intersecting words
        print $out scalar @intersect . "\n";
    }
}

close $out or die "Error closing output; $!\n";

If you don't want the intersection of an array and itself, there's an easy way to do that with flow control for the loops. You might also want to look into Set::Scalar or other CPAN modules that have done much of the work for you.

[chromatic]

my ( %union, %intersect ) = ( (), () );

That seems a little extravagant. Do you often have problems with freshly-declared hashes not being empty?

[mr_mischief]

No, I don't have that problem. It is superfluous. For some reason I was in the mindset that the example of how to assign to more than one variable might be useful to the OP, but I should've done that with @array1 through @array4 if I wanted to make that point I guess.

[chromatic]

A fair point. It was a strange construct I've never seen before, and I wondered at the motivation.

[godevars]

I do actually want to keep the intersection of the array to itself. I also tried this in my script and ran into an issue. I then tried it against the basic example to see if I can follow the steps. The output is as follows:

c d e
3
c d e
3
c d e
3
c d e
3
e
1
e f g h
4
e f g h
4
e f g h
4
d
1
....

I thought it would be more like this:

cde
3
e
1
d
1

0
e
1
....

I thought it would compare @array1 to @arrays1 - 4 then compare @array2 to @arrays1 - 4 and so forth. I think I am just not following the loops. Thanks-

[mr_mischief]

Actually, I think I have a bug. Let me look a little closer. Yes, I have a bug. I moved the declaration of the variables into the wrong scope. This should work a little better.

use strict;
use warnings;

my @array1 = qw( c d e );
my @array2 = qw( e f g h );
my @array3 = qw( a b d );
my @array4 = qw( s g h j k l );

open my $out, '>', 'output' or die "Cannot open: $!\n";

foreach my $a1 ( \@array1, \@array2, \@array3, \@array4 ) {
    foreach my $a2 ( \@array1, \@array2, \@array3, \@array4 ) {
        my ( %union, %intersect );
        foreach my $item1 ( @$a1 ) {
            foreach my $item2 ( @$a2 ) {
                # print "item1: $item1\nitem2: $item2\n";
                $union{$item1}++;
                $union{$item2}++;
                if ( $item1 eq $item2 ) {
                    $intersect{$item1}++;
                }
            }
        }
        my @intersect = sort keys %intersect;
        print $out "@intersect\n"; #prints intersecting words
        print $out scalar @intersect . "\n";
    }
}

close $out or die "Error closing output; $!\n";

[Anonymous Monk]

[estrawser@bast1 test]$ cat arr
#!/usr/bin/perl

for($i=0;$i<5;$i++){
push (@$i, "foo bar $i");
print "@$i ";
}
print "\n";

for($x=0;$x<5;$x++){
print "@$x ";
}
print "\n";

[estrawser@bast1 test]$ ./arr
foo bar 0 foo bar 1 foo bar 2 foo bar 3 foo bar 4 
foo bar 0 foo bar 1 foo bar 2 foo bar 3 foo bar 4